re PR fortran/40629 (Host association problem)

2008-07-09  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/40629
	* resolve.c (check_host_association):  Use the existing
	accessible symtree and treat function expressions with
	symbols that have procedure flavor.

2008-07-09  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/40629
	* gfortran.dg/host_assoc_function_9.f90: New test.

From-SVN: r149422

gcc/fortran/ChangeLog

+2008-07-09  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/40629
+	* resolve.c (check_host_association):  Use the existing
+	accessible symtree and treat function expressions with
+	symbols that have procedure flavor.
+
 2009-07-09  Janus Weil  <janus@gcc.gnu.org>
 
 	PR fortran/40646

gcc/fortran/resolve.c

@@ -4402,11 +4402,12 @@ check_host_association (gfc_expr *e)
 	      gfc_free (e->shape);
 	    }
 
-	  /* Give the symbol a symtree in the right place!  */
-	  gfc_get_sym_tree (sym->name, gfc_current_ns, &st, false);
-	  st->n.sym = sym;
+	  /* Give the expression the right symtree!  */
+	  gfc_find_sym_tree (e->symtree->name, NULL, 1, &st);
+	  gcc_assert (st != NULL);
 
-	  if (old_sym->attr.flavor == FL_PROCEDURE)
+	  if (old_sym->attr.flavor == FL_PROCEDURE
+		|| e->expr_type == EXPR_FUNCTION)
   	    {
 	      /* Original was function so point to the new symbol, since
 		 the actual argument list is already attached to the

gcc/testsuite/ChangeLog

+2008-07-09  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/40629
+	* gfortran.dg/host_assoc_function_9.f90: New test.
+
 2009-07-09  Janus Weil  <janus@gcc.gnu.org>
 
 	PR fortran/40646

gcc/testsuite/gfortran.dg/host_assoc_function_9.f90

+! { dg-do run }
+! Tests the fix for the bug PR40629, in which the reference to 'x'
+! in 'upper' wrongly host-associated with the symbol 'x' at module
+! leve rather than the function.
+!
+! Contributed by Philippe Marguinaud  <philippe.marguinaud@meteo.fr>
+!
+MODULE m
+  REAL :: x = 0
+CONTAINS
+  subroutine s
+    call upper
+    call lower
+  CONTAINS
+    SUBROUTINE upper
+     y = x(3,1)
+     if (int(y) .ne. 3) call abort
+    END SUBROUTINE
+    FUNCTION x(n, m)
+       x = m*n
+    END FUNCTION
+    SUBROUTINE lower
+     y = x(2,1)
+     if (int(y) .ne. 2) call abort
+    END SUBROUTINE
+  END SUBROUTINE
+END MODULE
+
+  use m
+  call s
+end
+! { dg-final { cleanup-modules "m" } }
+