re PR fortran/33233 (Parent and contained procedure: Wrongly treated as generic procedures)

2007-10-18  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/33233
	* resolve.c (check_host_association): Check singly contained
	namespaces and start search for symbol in current namespace.

2007-10-18  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/33233
	* gfortran.dg/host_assoc_function_1.f90: Correct references.
	* gfortran.dg/host_assoc_function_3.f90: New test.

From-SVN: r129437

gcc/fortran/ChangeLog

 2007-10-18  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/33233
+	* resolve.c (check_host_association): Check singly contained
+	namespaces and start search for symbol in current namespace.
+
+2007-10-18  Paul Thomas  <pault@gcc.gnu.org>
 	    Dominique d'Humieres  <dominiq@lps.ens.fr>
 
 	PR fortran/33733

gcc/fortran/resolve.c

@@ -4014,11 +4014,12 @@ check_host_association (gfc_expr *e)
     return retval;
 
   if (gfc_current_ns->parent
-	&& gfc_current_ns->parent->parent
 	&& old_sym->ns != gfc_current_ns)
     {
-      gfc_find_symbol (old_sym->name, gfc_current_ns->parent, 1, &sym);
-      if (sym && old_sym != sym && sym->attr.flavor == FL_PROCEDURE)
+      gfc_find_symbol (old_sym->name, gfc_current_ns, 1, &sym);
+      if (sym && old_sym != sym
+	      && sym->attr.flavor == FL_PROCEDURE
+	      && sym->attr.contained)
 	{
 	  temp_locus = gfc_current_locus;
 	  gfc_current_locus = e->where;

gcc/testsuite/ChangeLog

 2007-10-18  Paul Thomas  <pault@gcc.gnu.org>
 
+	PR fortran/33233
+	* gfortran.dg/host_assoc_function_1.f90: Correct references.
+	* gfortran.dg/host_assoc_function_3.f90: New test.
+
+2007-10-18  Paul Thomas  <pault@gcc.gnu.org>
+
 	PR fortran/33733
 	* gfortran.dg/transfer_simplify_6.f90: New test.
 

gcc/testsuite/gfortran.dg/host_assoc_function_1.f90

@@ -19,8 +19,8 @@ MODULE m
   end interface
 CONTAINS
   SUBROUTINE s
-    if (x(2) .ne. 2.5) call abort ()
-    if (z(3) .ne. real (3)**3) call abort ()
+    if (x(2, 3) .ne. real (2)**3) call abort ()
+    if (z(3, 3) .ne. real (3)**3) call abort ()
     CALL inner
   CONTAINS
     SUBROUTINE inner

gcc/testsuite/gfortran.dg/host_assoc_function_3.f90

+! { dg-do run }
+! Tests the fix for the bug PR33233, in which the reference to 'x'
+! in 'inner' wrongly host-associated with the variable 'x' rather
+! than the function.
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+!
+MODULE m
+  REAL :: x(3) = (/ 1.5, 2.5, 3.5 /)
+CONTAINS
+  SUBROUTINE s
+    if (x(2) .eq. 2.5) call abort ()
+  CONTAINS
+    FUNCTION x(n, m)
+      integer, optional :: m
+      if (present(m)) then
+        x = REAL(n)**m
+      else
+        x = 0.0
+      end if
+    END FUNCTION
+  END SUBROUTINE s
+END MODULE m
+  use m
+  call s
+end
+! { dg-final { cleanup-modules "m" } }