diff options
Diffstat (limited to 'gcc')
-rw-r--r-- | gcc/fortran/ChangeLog | 7 | ||||
-rw-r--r-- | gcc/fortran/resolve.c | 19 | ||||
-rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/equiv_pure.f90 | 52 |
4 files changed, 80 insertions, 3 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 4677cec..f653267 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2017-11-03 Steven G. Kargl <kargl@gcc.gnu.org> + + 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 <wilson@tuliptree.org> * parse.c (unexpected_eof): Call gcc_unreachable before return. diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 104c02f..40c1cd3 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 0a08fe2..87500b7 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2017-11-03 Steven G. Kargl <kargl@gcc.gnu.org> + + PR fortran/82796 + * gfortran.dg/equiv_pure.f90: New test. + 2017-11-03 Jeff Law <law@redhat.com> 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 0000000..5b0ce41 --- /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 |