summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--gcc/fortran/ChangeLog7
-rw-r--r--gcc/fortran/resolve.c19
-rw-r--r--gcc/testsuite/ChangeLog5
-rw-r--r--gcc/testsuite/gfortran.dg/equiv_pure.f9052
4 files changed, 80 insertions, 3 deletions
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 <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 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 <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 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