From 9cfdd48417dce7d29a410510d2fb0e9b74b66878 Mon Sep 17 00:00:00 2001 From: "Steven G. Kargl" Date: Sat, 4 Nov 2017 00:34:40 +0000 Subject: [PATCH] re PR fortran/82796 (Private+equivalence in used module breaks compilation of pure function) 2017-11-01 Steven G. Kargl PR fortran/82796 * resolve.c (resolve_equivalence): An entity in a common block within a module cannot appear in an equivalence statement if the entity is with a pure procedure. 2017-11-01 Steven G. Kargl PR fortran/82796 * gfortran.dg/equiv_pure.f90: New test. From-SVN: r254403 --- gcc/fortran/ChangeLog | 7 ++++ gcc/fortran/resolve.c | 19 +++++++-- gcc/testsuite/ChangeLog | 5 +++ gcc/testsuite/gfortran.dg/equiv_pure.f90 | 52 ++++++++++++++++++++++++ 4 files changed, 80 insertions(+), 3 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/equiv_pure.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 4677cec8fda..f653267b8e6 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2017-11-03 Steven G. Kargl + + PR fortran/82796 + * resolve.c (resolve_equivalence): An entity in a common block within + a module cannot appear in an equivalence statement if the entity is + with a pure procedure. + 2017-10-31 Jim Wilson * parse.c (unexpected_eof): Call gcc_unreachable before return. diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 104c02f96bb..40c1cd3c96f 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -15936,9 +15936,22 @@ resolve_equivalence (gfc_equiv *eq) && sym->ns->proc_name->attr.pure && sym->attr.in_common) { - gfc_error ("Common block member %qs at %L cannot be an EQUIVALENCE " - "object in the pure procedure %qs", - sym->name, &e->where, sym->ns->proc_name->name); + /* Need to check for symbols that may have entered the pure + procedure via a USE statement. */ + bool saw_sym = false; + if (sym->ns->use_stmts) + { + gfc_use_rename *r; + for (r = sym->ns->use_stmts->rename; r; r = r->next) + if (strcmp(r->use_name, sym->name) == 0) saw_sym = true; + } + else + saw_sym = true; + + if (saw_sym) + gfc_error ("COMMON block member %qs at %L cannot be an " + "EQUIVALENCE object in the pure procedure %qs", + sym->name, &e->where, sym->ns->proc_name->name); break; } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 0a08fe2ed5c..87500b7ecee 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2017-11-03 Steven G. Kargl + + PR fortran/82796 + * gfortran.dg/equiv_pure.f90: New test. + 2017-11-03 Jeff Law PR target/82823 diff --git a/gcc/testsuite/gfortran.dg/equiv_pure.f90 b/gcc/testsuite/gfortran.dg/equiv_pure.f90 new file mode 100644 index 00000000000..5b0ce419d2a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/equiv_pure.f90 @@ -0,0 +1,52 @@ +! { dg-do compile } +! PR fortran/82796 +! Code contributed by ripero84 at gmail dot com +module eq + implicit none + integer :: n1, n2 + integer, dimension(2) :: a + equivalence (a(1), n1) + equivalence (a(2), n2) + common /a/ a +end module eq + +module m + use eq + implicit none + type, public :: t + integer :: i + end type t +end module m + +module p + implicit none + contains + pure integer function d(h) + use m + implicit none + integer, intent(in) :: h + d = h + end function +end module p + +module q + implicit none + contains + pure integer function d(h) + use m, only : t + implicit none + integer, intent(in) :: h + d = h + end function +end module q + +module r + implicit none + contains + pure integer function d(h) + use m, only : a ! { dg-error "cannot be an EQUIVALENCE object" } + implicit none + integer, intent(in) :: h + d = h + end function +end module r -- 2.30.2