re PR fortran/82796 (Private+equivalence in used module breaks compilation of pure...

2017-11-01  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-11-01  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/82796
	* gfortran.dg/equiv_pure.f90: New test.

From-SVN: r254410

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 1e5211109595ff3dd61daa5777964e07d591202f..ae8a9faa478ce92572a4c8b7adf1e8b1c29a3a3c 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2017-11-01  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-11-03  Paul Thomas  <pault@gcc.gnu.org>
 
        Backport from 7-branch

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index c3cc161ad9a7af25d6426de028a31324b075c3fa..41d1e6af44ffb2fce279a776c6ef427bde7a73c8 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -15375,9 +15375,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 85087554b63d5cad0a79f235aebd51be909c30e7..4b8b8e6c1cb5f6e670b510ead3c70075182af317 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2017-11-01  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+       PR fortran/82796
+       * gfortran.dg/equiv_pure.f90: New test.
+
 2017-11-03  Paul Thomas  <pault@gcc.gnu.org>
 
        Backport from 7-branch

diff --git a/gcc/testsuite/gfortran.dg/equiv_pure.f90 b/gcc/testsuite/gfortran.dg/equiv_pure.f90
new file mode 100644 (file)
index 0000000..0520279
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/equiv_pure.f90
@@ -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