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: r254403

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 4677cec..f653267 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
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