The attached patch fixes a regression where gfortran was
issuing an error for an entity in a common block within
a module when it appears in equivalence, and the entity
*is not* use associated in a pure subprogram. OK to
commit?
2017-11-01 Steven G. Kargl <ka...@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-11-01 Steven G. Kargl <ka...@gcc.gnu.org>
PR fortran/82796
* gfortran.dg/equiv_pure.f90: New test.
--
Steve
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c (revision 254241)
+++ gcc/fortran/resolve.c (working copy)
@@ -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;
}
Index: gcc/testsuite/gfortran.dg/equiv_pure.f90
===================================================================
--- gcc/testsuite/gfortran.dg/equiv_pure.f90 (nonexistent)
+++ gcc/testsuite/gfortran.dg/equiv_pure.f90 (working copy)
@@ -0,0 +1,50 @@
+! { dg-do compile }
+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
