2009-10-29 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-29  Tobias Burnus  <burnus@net-b.de>

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

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@153706 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 68747bc..323bd43 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2009-10-29  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-29  Janne Blomqvist  <jb@gcc.gnu.org>
 
        PR fortran/41860

diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 171eeaa..9b6f8ea 100644 (file)
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -599,10 +599,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
@@ -624,10 +622,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 "

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index da442ed..7eddbd4 100644 (file)
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -2870,8 +2870,11 @@ gfc_conv_procedure_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 = gfc_build_addr_expr (NULL_TREE, parmse.expr);
@@ -4368,8 +4371,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);

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index b8f2dcf..1255e8f 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2009-10-29  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/41777
+       gfortran.dg/associated_target_3.f90: New testcase.
+
 2009-10-29  Rafael Avila de Espindola  <espindola@google.com>
 
        * gfortran.dg/lto/pr41764_0.f: New.

diff --git a/gcc/testsuite/gfortran.dg/associated_target_3.f90 b/gcc/testsuite/gfortran.dg/associated_target_3.f90
new file mode 100644 (file)
index 0000000..e6a1d0f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/associated_target_3.f90
@@ -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" } }