From 182393f4f798c2ca212e2eba190e9a181f9787d8 Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Wed, 31 Oct 2007 09:59:16 +0000 Subject: [PATCH] re PR fortran/33897 (Incorrect host association in module) 2007-10-31 Paul Thomas 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 PR fortran/33897 * gfortran.dg/contained_3.f90: New. From-SVN: r129795 --- gcc/fortran/ChangeLog | 8 ++++ gcc/fortran/decl.c | 4 +- gcc/fortran/parse.c | 25 +++++++++--- gcc/testsuite/ChangeLog | 5 +++ gcc/testsuite/gfortran.dg/contained_3.f90 | 50 +++++++++++++++++++++++ 5 files changed, 85 insertions(+), 7 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/contained_3.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index c7c99bf4532..61c75bec6a4 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2007-10-31 Paul Thomas + + 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 PR fortran/33596 diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 0ecb0080c25..dacfe4a318a 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 f357c7a6523..f60ea9a0057 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 94925829892..59ae5ef3d10 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2007-10-31 Paul Thomas + + PR fortran/33897 + * gfortran.dg/contained_3.f90: New. + 2007-10-31 Christian Bruel 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 00000000000..5ae41597c03 --- /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 +! +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" } } -- 2.30.2