OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/41777 (Wrong-code with POINTER-returning GENERIC function) 

2009-10-30  Tobias Burnus  <burnus@net-b.de>

        PR fortran/41777
        * trans-expr.c
        * (gfc_conv_procedure_call,gfc_conv_expr_reference):
        Use for generic EXPR_FUNCTION the attributes of the specific
        function.

2009-10-30  Tobias Burnus  <burnus@net-b.de>

        PR fortran/41777
        gfortran.dg/associated_target_3.f90: New testcase.

From-SVN: r153756
This commit is contained in:
Tobias Burnus 2009-10-30 16:18:09 +01:00 committed by Tobias Burnus
parent 086537862e
commit b5a0520c21
5 changed files with 62 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
gcc/fortran/ChangeLog
View File

@ -1,3 +1,10 @@
2009-10-30 Tobias Burnus <burnus@net-b.de>
PR fortran/41777
* trans-expr.c (gfc_conv_procedure_call,gfc_conv_expr_reference):
Use for generic EXPR_FUNCTION the attributes of the specific
function.
2009-10-19 Tobias Burnus <burnus@net-b.de>
Steven G. Kargl <kargl@gcc.gnu.org>

12
gcc/fortran/check.c
View File

@ -596,10 +596,8 @@ gfc_check_associated (gfc_expr *pointer, gfc_expr *target)
where = &pointer->where;
if (pointer->expr_type == EXPR_VARIABLE)
attr1 = gfc_variable_attr (pointer, NULL);
else if (pointer->expr_type == EXPR_FUNCTION)
attr1 = pointer->symtree->n.sym->attr;
if (pointer->expr_type == EXPR_VARIABLE || pointer->expr_type == EXPR_FUNCTION)
attr1 = gfc_expr_attr (pointer);
else if (pointer->expr_type == EXPR_NULL)
goto null_arg;
else
@ -621,10 +619,8 @@ gfc_check_associated (gfc_expr *pointer, gfc_expr *target)
if (target->expr_type == EXPR_NULL)
goto null_arg;
if (target->expr_type == EXPR_VARIABLE)
attr2 = gfc_variable_attr (target, NULL);
else if (target->expr_type == EXPR_FUNCTION)
attr2 = target->symtree->n.sym->attr;
if (target->expr_type == EXPR_VARIABLE || target->expr_type == EXPR_FUNCTION)
attr2 = gfc_expr_attr (target);
else
{
gfc_error ("'%s' argument of '%s' intrinsic at %L must be a pointer "

15
gcc/fortran/trans-expr.c
View File

@ -2620,8 +2620,11 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
through arg->name. */
conv_arglist_function (&parmse, arg->expr, arg->name);
else if ((e->expr_type == EXPR_FUNCTION)
&& e->symtree->n.sym->attr.pointer
&& fsym && fsym->attr.target)
&& ((e->value.function.esym
&& e->value.function.esym->result->attr.pointer)
|| (!e->value.function.esym
&& e->symtree->n.sym->attr.pointer))
&& fsym && fsym->attr.target)
{
gfc_conv_expr (&parmse, e);
parmse.expr = build_fold_addr_expr (parmse.expr);
@ -3948,8 +3951,12 @@ gfc_conv_expr_reference (gfc_se * se, gfc_expr * expr)
}
if (expr->expr_type == EXPR_FUNCTION
&& expr->symtree->n.sym->attr.pointer
&& !expr->symtree->n.sym->attr.dimension)
&& ((expr->value.function.esym
&& expr->value.function.esym->result->attr.pointer
&& !expr->value.function.esym->result->attr.dimension)
|| (!expr->value.function.esym
&& expr->symtree->n.sym->attr.pointer
&& !expr->symtree->n.sym->attr.dimension)))
{
se->want_pointer = 1;
gfc_conv_expr (se, expr);

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2009-10-30 Tobias Burnus <burnus@net-b.de>
PR fortran/41777
gfortran.dg/associated_target_3.f90: New testcase.
2009-10-28 Jakub Jelinek <jakub@redhat.com>
PR target/41762

35
gcc/testsuite/gfortran.dg/associated_target_3.f90 Normal file
View File

@ -0,0 +1,35 @@
! { dg-do run }
!
! PR fortran/41777
!
module m
type t2
integer :: i
end type t2
interface f
module procedure f2
end interface f
contains
function f2(a)
type(t2), pointer :: f2,a
f2 => a
end function f2
end module m
use m
implicit none
type(t2), pointer :: a
allocate(a)
if (.not. associated(a,f(a))) call abort()
call cmpPtr(a,f2(a))
call cmpPtr(a,f(a))
deallocate(a)
contains
subroutine cmpPtr(a,b)
type(t2), pointer :: a,b
! print *, associated(a,b)
if (.not. associated (a, b)) call abort()
end subroutine cmpPtr
end
! { dg-final { cleanup-modules "m" } }