------- Comment #4 from pault at gcc dot gnu dot org 2007-05-29 10:39 -------
The patch below works and regtests OK. I am trying to devise a safe method of
gettting rid of the redundant symbols if none of the equivalence members is
USEd. If I cannot see something by tonight, I will submit anyway.
Paul
Index: gcc/fortran/module.c
===================================================================
--- gcc/fortran/module.c (révision 125056)
+++ gcc/fortran/module.c (copie de travail)
@@ -189,7 +189,7 @@ static gfc_use_rename *gfc_rename_list;
static pointer_info *pi_root;
static int symbol_number; /* Counter for assigning symbol numbers */
-/* Tells mio_expr_ref not to load unused equivalence members. */
+/* Tells mio_expr_ref to make symbols for unused equivalence members. */
static bool in_load_equiv;
@@ -1501,10 +1501,10 @@ mio_internal_string (char *string)
typedef enum
{ AB_ALLOCATABLE, AB_DIMENSION, AB_EXTERNAL, AB_INTRINSIC, AB_OPTIONAL,
AB_POINTER, AB_SAVE, AB_TARGET, AB_DUMMY, AB_RESULT, AB_DATA,
- AB_IN_NAMELIST, AB_IN_COMMON, AB_FUNCTION, AB_SUBROUTINE, AB_SEQUENCE,
- AB_ELEMENTAL, AB_PURE, AB_RECURSIVE, AB_GENERIC, AB_ALWAYS_EXPLICIT,
- AB_CRAY_POINTER, AB_CRAY_POINTEE, AB_THREADPRIVATE, AB_ALLOC_COMP,
- AB_VALUE, AB_VOLATILE, AB_PROTECTED
+ AB_IN_NAMELIST, AB_IN_EQUIVALENCE, AB_IN_COMMON, AB_FUNCTION,
+ AB_SUBROUTINE, AB_SEQUENCE, AB_ELEMENTAL, AB_PURE, AB_RECURSIVE,
+ AB_GENERIC, AB_ALWAYS_EXPLICIT, AB_CRAY_POINTER, AB_CRAY_POINTEE,
+ AB_THREADPRIVATE, AB_ALLOC_COMP, AB_VALUE, AB_VOLATILE, AB_PROTECTED
}
ab_attribute;
@@ -1525,6 +1525,7 @@ static const mstring attr_bits[] =
minit ("RESULT", AB_RESULT),
minit ("DATA", AB_DATA),
minit ("IN_NAMELIST", AB_IN_NAMELIST),
+ minit ("IN_EQUIVALENCE", AB_IN_EQUIVALENCE),
minit ("IN_COMMON", AB_IN_COMMON),
minit ("FUNCTION", AB_FUNCTION),
minit ("SUBROUTINE", AB_SUBROUTINE),
@@ -1610,6 +1611,8 @@ mio_symbol_attribute (symbol_attribute *
MIO_NAME (ab_attribute) (AB_DATA, attr_bits);
if (attr->in_namelist)
MIO_NAME (ab_attribute) (AB_IN_NAMELIST, attr_bits);
+ if (attr->in_equivalence)
+ MIO_NAME (ab_attribute) (AB_IN_EQUIVALENCE, attr_bits);
if (attr->in_common)
MIO_NAME (ab_attribute) (AB_IN_COMMON, attr_bits);
@@ -1700,6 +1703,9 @@ mio_symbol_attribute (symbol_attribute *
case AB_IN_NAMELIST:
attr->in_namelist = 1;
break;
+ case AB_IN_EQUIVALENCE:
+ attr->in_equivalence = 1;
+ break;
case AB_IN_COMMON:
attr->in_common = 1;
break;
@@ -2234,9 +2240,25 @@ mio_symtree_ref (gfc_symtree **stp)
require_atom (ATOM_INTEGER);
p = get_integer (atom_int);
- /* An unused equivalence member; bail out. */
+ /* An unused equivalence member; make a symbol and a symtree
+ for it. */
if (in_load_equiv && p->u.rsym.symtree == NULL)
- return;
+ {
+ /* Since this is not used, it must have a unique name. */
+ p->u.rsym.symtree = get_unique_symtree (gfc_current_ns);
+
+ /* Make the symbol. */
+ if (p->u.rsym.sym == NULL)
+ {
+ p->u.rsym.sym = gfc_new_symbol (p->u.rsym.true_name,
+ gfc_current_ns);
+ p->u.rsym.sym->module = gfc_get_string (p->u.rsym.module);
+ }
+
+ p->u.rsym.symtree->n.sym = p->u.rsym.sym;
+ p->u.rsym.symtree->n.sym->refs++;
+ p->u.rsym.referenced = 1;
+ }
if (p->type == P_UNKNOWN)
p->type = P_SYMBOL;
@@ -3206,13 +3228,13 @@ load_equiv (void)
mio_expr (&tail->expr);
}
- /* Unused variables have no symtree. */
- unused = false;
+ /* Unused equivalence members have a unique name. */
+ unused = true;
for (eq = head; eq; eq = eq->eq)
{
- if (!eq->expr->symtree)
+ if (!check_unique_name (eq->expr->symtree->name))
{
- unused = true;
+ unused = false;
break;
}
}
Index: gcc/testsuite/gfortran.dg/module_equivalence_3.f90
===================================================================
--- gcc/testsuite/gfortran.dg/module_equivalence_3.f90 (révision 0)
+++ gcc/testsuite/gfortran.dg/module_equivalence_3.f90 (révision 0)
@@ -0,0 +1,38 @@
+! { dg-do run }
+! This checks the fix for PR32103 in which not using one member
+! of an equivalence group would cause all memory of the equivalence
+! to be lost and subsequent incorrect referencing of the remaining
+! members.
+!
+! Contributed by Toon Moene <[EMAIL PROTECTED]>
+!
+module aap
+ real :: a(5) = (/1.0,2.0,3.0,4.0,5.0/)
+ real :: b(3)
+ real :: d(5) = (/1.0,2.0,3.0,4.0,5.0/)
+ equivalence (a(3),b(1))
+end module aap
+
+ use aap, only : b
+ call foo
+ call bar
+ call foobar
+contains
+ subroutine foo
+ use aap, only : c=>b
+ if (any(c .ne. b)) call abort ()
+ end subroutine
+ subroutine bar
+ use aap, only : a
+ if (any(a(3:5) .ne. b)) call abort ()
+ end subroutine
+
+! Make sure that bad things do not happen if we do not USE a or b.
+
+ subroutine foobar
+ use aap, only : d
+ if (any(d(3:5) .ne. b)) call abort ()
+ end subroutine
+end
+
+! { dg-final { cleanup-modules "aap" } }
--
http://gcc.gnu.org/bugzilla/show_bug.cgi?id=32103
