[Bug fortran/32103] Module with equivalence draws "unsatisfied reference"

["pault at gcc dot gnu dot org" <gcc-bugzilla at gcc dot gnu dot org>]

------- 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 <toon@moene.indiv.nluug.nl> 
+!
+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