[patch,Fortran] PR 41777 - fix attribute usage for generics

[Tobias Burnus <burnus at net-b dot de>]

There seem to be multiple issues with generic functions as at
several places the generic symbols attributes (expr->symtree->n.sym)
and not the one of the specific (expr->value.functions.esym) is used.

The attached patch fixes some of those problems, but more remain as
the PR shows; in particular, the program in comment 0 of the PR
still does not work.

With regards to wrong-code, the issue is mostly whether the address
of the pointer or of the pointer target is used.

Bootstrapped and regtested on x86-64-linux.
OK for the trunk? What do you think about 4.4/4.3 backports?

Tobias

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.

Index: gcc/fortran/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c	(revision 153642)
+++ gcc/fortran/trans-expr.c	(working copy)
@@ -2870,8 +2870,11 @@ gfc_conv_procedure_call (gfc_se * se, gf
 		   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, gf
     }
 
   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);
Index: gcc/fortran/check.c
===================================================================
--- gcc/fortran/check.c	(revision 153642)
+++ gcc/fortran/check.c	(working copy)
@@ -599,10 +599,8 @@ gfc_check_associated (gfc_expr *pointer,
 
   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,
   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 "
Index: gcc/testsuite/gfortran.dg/associated_target_3.f90
===================================================================
--- gcc/testsuite/gfortran.dg/associated_target_3.f90	(revision 0)
+++ gcc/testsuite/gfortran.dg/associated_target_3.f90	(revision 0)
@@ -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" } }