re PR fortran/33233 (Parent and contained procedure: Wrongly treated as generic proce...

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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 24dfe5ef4c5dba48cf71e04102bd4d895c6fc5c0..3a736539789baf6cf550e02861445d131643039d 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+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>
 

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index f16fe281772b085c7153a296e1b374f493691ea2..dffa76e0cff20dd11147f3f74584257fb13aa95c 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/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;

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 86885ee334510478e711caf0704ed49ea498b167..cbda26de31e884f71f4fcaf00a68ec7ad02a8476 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+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

diff --git a/gcc/testsuite/gfortran.dg/host_assoc_function_1.f90 b/gcc/testsuite/gfortran.dg/host_assoc_function_1.f90
index 019fc617be14f6e21b38ae6b9c659cdf4d870b42..f80f97a27ab5b996b13207e16825388402c9e2fc 100644 (file)
--- a/gcc/testsuite/gfortran.dg/host_assoc_function_1.f90
+++ b/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

diff --git a/gcc/testsuite/gfortran.dg/host_assoc_function_3.f90 b/gcc/testsuite/gfortran.dg/host_assoc_function_3.f90
new file mode 100644 (file)
index 0000000..a83fa17
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/host_assoc_function_3.f90
@@ -0,0 +1,27 @@
+! { 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" } }