From: Paul Thomas <pault@gcc.gnu.org>
Date: Thu, 18 Oct 2007 12:48:37 +0000 (+0000)
Subject: re PR fortran/33233 (Parent and contained procedure: Wrongly treated as generic proce... 
X-Git-Tag: releases/gcc-4.3.0~1963
X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=a944c79a88afb91706e4b29db4224981fe0c91eb;p=thirdparty%2Fgcc.git

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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 24dfe5ef4c5d..3a736539789b 100644
--- 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 f16fe281772b..dffa76e0cff2 100644
--- 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 86885ee33451..cbda26de31e8 100644
--- 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 019fc617be14..f80f97a27ab5 100644
--- 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
index 000000000000..a83fa1738af5
--- /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" } }