From: Paul Thomas <pault@gcc.gnu.org>
Date: Thu, 9 Jul 2009 16:48:50 +0000 (+0000)
Subject: re PR fortran/40629 (Host association problem)
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=1aafbf99427843b553de817302453bf126592553;p=gcc.git

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
---

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index ceabd6053ba..5b1ed772829 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+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
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index e3aba1a1af2..9b091ad0162 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -4402,12 +4402,13 @@ 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
 		 expression. */
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 6dc33931754..e04e25e8753 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+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
diff --git a/gcc/testsuite/gfortran.dg/host_assoc_function_9.f90 b/gcc/testsuite/gfortran.dg/host_assoc_function_9.f90
new file mode 100644
index 00000000000..58cae435fb6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/host_assoc_function_9.f90
@@ -0,0 +1,33 @@
+! { 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" } }
+