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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index c7c99bf4532963b07a9240a98f93d72b5fe30ae2..61c75bec6a43489be81847fde2a9b16e5bbee3fa 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 0ecb0080c25b66785d549686b18f2edf075245c0..dacfe4a318ab8745e5ed57a06a2cc57ef3f7937a 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 f357c7a65237a3c3f3b57bc199dea112287e6a61..f60ea9a0057ef5a51d91d83bf2849c86b4c7930f 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 949258298925745169ef32dbc8a9b224d2a240d1..59ae5ef3d10fc312dc08e65dea579858dd6fdce5 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" } }