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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@129795 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index c7c99bf..61c75be 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
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" } }