re PR fortran/33897 (Incorrect host association in module)

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

        PR fortran/33897
        * decl.c (gfc_match_entry): Do not make ENTRY name
        global for contained procedures.
        * parse.c (gfc_fixup_sibling_symbols): Fix code for
        determining whether a procedure is external.

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

        PR fortran/33897
        * gfortran.dg/contained_3.f90: New.

From-SVN: r129795

5 files changed, 85 insertions, 7 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index c7c99bf..61c75be 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+2007-10-31  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/33897
+	* decl.c (gfc_match_entry): Do not make ENTRY name
+	global for contained procedures.
+	* parse.c (gfc_fixup_sibling_symbols): Fix code for
+	determining whether a procedure is external.
+
 2007-10-30  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
 
 	PR fortran/33596
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 0ecb008..dacfe4a 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -4396,7 +4396,7 @@ gfc_match_entry (void)
   if (state == COMP_SUBROUTINE)
     {
       /* An entry in a subroutine.  */
-      if (!add_global_entry (name, 1))
+      if (!gfc_current_ns->parent && !add_global_entry (name, 1))
 	return MATCH_ERROR;
 
       m = gfc_match_formal_arglist (entry, 0, 1);
@@ -4418,7 +4418,7 @@ gfc_match_entry (void)
 	    ENTRY f() RESULT (r)
 	 can't be written as
 	    ENTRY f RESULT (r).  */
-      if (!add_global_entry (name, 0))
+      if (!gfc_current_ns->parent && !add_global_entry (name, 0))
 	return MATCH_ERROR;
 
       old_loc = gfc_current_locus;
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index f357c7a..f60ea9a 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -2858,11 +2858,26 @@ gfc_fixup_sibling_symbols (gfc_symbol *sym, gfc_namespace *siblings)
 	continue;
 
       old_sym = st->n.sym;
-      if ((old_sym->attr.flavor == FL_PROCEDURE
-	   || old_sym->ts.type == BT_UNKNOWN)
-	  && old_sym->ns == ns
-	  && !old_sym->attr.contained
-	  && old_sym->attr.flavor != FL_NAMELIST)
+      if (old_sym->ns == ns
+	    && !old_sym->attr.contained
+
+	    /* By 14.6.1.3, host association should be excluded
+	       for the following.  */
+	    && !(old_sym->attr.external
+		  || (old_sym->ts.type != BT_UNKNOWN
+			&& !old_sym->attr.implicit_type)
+		  || old_sym->attr.flavor == FL_PARAMETER
+		  || old_sym->attr.in_common
+		  || old_sym->attr.in_equivalence
+		  || old_sym->attr.data
+		  || old_sym->attr.dummy
+		  || old_sym->attr.result
+		  || old_sym->attr.dimension
+		  || old_sym->attr.allocatable
+		  || old_sym->attr.intrinsic
+		  || old_sym->attr.generic
+		  || old_sym->attr.flavor == FL_NAMELIST
+		  || old_sym->attr.proc == PROC_ST_FUNCTION))
 	{
 	  /* Replace it with the symbol from the parent namespace.  */
 	  st->n.sym = sym;
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 9492582..59ae5ef 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2007-10-31  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/33897
+	* gfortran.dg/contained_3.f90: New.
+
 2007-10-31  Christian Bruel  <christian.bruel@st.com>
 
 	PR c++/19531
diff --git a/gcc/testsuite/gfortran.dg/contained_3.f90 b/gcc/testsuite/gfortran.dg/contained_3.f90
new file mode 100644
index 0000000..5ae4159
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/contained_3.f90
@@ -0,0 +1,50 @@
+! { dg-do run }
+! Tests the fix for PR33897, in which gfortran missed that the
+! declaration of 'setbd' in 'nxtstg2' made it external.  Also
+! the ENTRY 'setbd' would conflict with the external 'setbd'.
+!
+! Contributed by Michael Richmond <michael.a.richmond@nasa.gov>
+!
+MODULE ksbin1_aux_mod
+ CONTAINS
+  SUBROUTINE nxtstg1()
+    INTEGER :: i
+    i = setbd()  ! available by host association.
+    if (setbd () .ne. 99 ) call abort ()
+  END SUBROUTINE nxtstg1
+
+  SUBROUTINE nxtstg2()
+    INTEGER :: i
+    integer :: setbd  ! makes it external.
+    i = setbd()       ! this is the PR
+    if (setbd () .ne. 42 ) call abort ()
+  END SUBROUTINE nxtstg2
+
+  FUNCTION binden()
+    INTEGER :: binden
+    INTEGER :: setbd
+    binden = 0
+  ENTRY setbd()
+    setbd = 99
+  END FUNCTION binden
+END MODULE ksbin1_aux_mod
+
+PROGRAM test
+  USE ksbin1_aux_mod, only : nxtstg1, nxtstg2
+  integer setbd ! setbd is external, since not use assoc.
+  CALL nxtstg1()
+  CALL nxtstg2()
+  if (setbd () .ne. 42 ) call abort ()
+  call foo
+contains
+  subroutine foo
+    USE ksbin1_aux_mod ! module setbd is available
+    if (setbd () .ne. 99 ) call abort ()
+  end subroutine
+END PROGRAM test
+
+INTEGER FUNCTION setbd()
+  setbd=42
+END FUNCTION setbd
+
+! { dg-final { cleanup-modules "ksbin1_aux_mod" } }