[patch,gfortran] Fix PR17917 - module equivalences (redux)

[Paul Thomas <paulthomas2 at wanadoo dot fr>]

:ADDPATCH <fortran>:

This version of the fix for module equivalences builds upon the patch 
posted in http://gcc.gnu.org/ml/fortran/2005-06/msg00307.html

This time it works correctly.  The multiple local equivalences have gone 
and are replaced by single external equivalences.

The patch consists of four elements:

(i) The new functions in module.c have been ported from g95. write_equiv 
has been modified to attach a name to each module equivalence. I have 
chosen <module_name>_equiv<number>. Is there a better way of doing this 
to ensure uniqueness?
(ii) trans-decl.c has been modified to prevent equivalenced symbols that 
have a backend_decl from being caught by the internal error in 
gfc_create_module_variable.
(iii) The module equivalences have a name, which triggers the creation 
of a gfc_common_header. This, when passed to create common, ensures that 
the equivalences are treated in the same way as common blocks; ie. they 
become external and public.
(iv) gfc_equiv has the module field added in gfortran.h

The test case tests the equivalences are transmitted between procedures, 
that renamed equivalence symbols are dealt with and that common block 
equivalences are not broken by the patch.  I have tested that the loader 
does the right thing when the module and the subroutine foo are compiled 
separately from the main program; ie. that the equivalences really are 
external.  Is there some way to do this in the testsuite?

Bubblestrapped and regtested on FC3/Athlon 1700.

OK for mainline and 4.0?

Paul T


2005-08-08 Paul Thomas <pault@gcc.gnu.org>

PR fortran/17917
* module.c (load_equiv): New function ported from g95.
(read_module): Call load_equiv.
(write_equiv): New function ported from g95. Correct
string referencing for gfc functions. Give module
equivalences a unique name.
(write_module): Call write_equiv.
* trans_decl.c (gfc_create_module_variable): Return for
equivalenced symbols with existing backend declaration.
* trans-common.c (finish_equivalences): Provide the call
to create_common with a gfc_common_header so that
module equivalences are made external, rather than local.
* gfortran.h (gfc_equiv): Add field for the equivalence
name.


2005-08-08 Paul Thomas <pault@gcc.gnu.org>

PR fortran/17917
* gfortran.dg/module_equivalence_1.f90: New.


Index: gcc/gcc/fortran/module.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/module.c,v
retrieving revision 1.34
diff -c -3 -p -r1.34 module.c
*** gcc/gcc/fortran/module.c	25 Jun 2005 00:40:35 -0000	1.34
--- gcc/gcc/fortran/module.c	8 Aug 2005 18:49:11 -0000
*************** Software Foundation, 51 Franklin Street,
*** 47,52 ****
--- 47,55 ----
     ( ( <common name> <symbol> <saved flag>)
       ...
     )
+ 
+    ( equivalence list )
+ 
     ( <Symbol Number (in no particular order)>
       <True name of symbol>
       <Module name of symbol>
*************** load_commons(void)
*** 2920,2925 ****
--- 2923,2970 ----
    mio_rparen();
  }
  
+ /* load_equiv()-- Load equivalences. */
+ 
+ static void
+ load_equiv(void)
+ {
+   gfc_equiv *head, *tail, *end;
+ 
+   mio_lparen();
+ 
+   end = gfc_current_ns->equiv;
+   while(end != NULL && end->next != NULL)
+     end = end->next;
+ 
+   while(peek_atom() != ATOM_RPAREN) {
+     mio_lparen();
+     head = tail = NULL;
+ 
+     while(peek_atom() != ATOM_RPAREN)
+       {
+ 	if (head == NULL)
+ 	  head = tail = gfc_get_equiv();
+ 	else
+ 	  {
+ 	    tail->eq = gfc_get_equiv();
+ 	    tail = tail->eq;
+ 	  }
+ 
+ 	mio_pool_string(&tail->module);
+ 	mio_expr(&tail->expr);
+       }
+ 
+     if (end == NULL)
+       gfc_current_ns->equiv = head;
+     else
+       end->next = head;
+ 
+     end = head;
+     mio_rparen();
+   }
+ 
+   mio_rparen();
+ }
  
  /* Recursive function to traverse the pointer_info tree and load a
     needed symbol.  We return nonzero if we load a symbol and stop the
*************** read_module (void)
*** 3032,3037 ****
--- 3077,3085 ----
    get_module_locus (&user_operators);
    skip_list ();
    skip_list ();
+ 
+   /* Skip commons and equivalences for now.  */
+   skip_list ();
    skip_list ();
  
    mio_lparen ();
*************** read_module (void)
*** 3170,3175 ****
--- 3218,3224 ----
    load_generic_interfaces ();
  
    load_commons ();
+   load_equiv();
  
    /* At this point, we read those symbols that are needed but haven't
       been loaded yet.  If one symbol requires another, the other gets
*************** write_common (gfc_symtree *st)
*** 3258,3263 ****
--- 3307,3337 ----
    mio_rparen();
  }
  
+ /* Write equivalences to the module.  */
+ 
+ static void
+ write_equiv(void)
+ {
+   gfc_equiv *eq, *e;
+   int num;
+ 
+   num = 0;
+   for(eq=gfc_current_ns->equiv; eq; eq=eq->next)
+     {
+       mio_lparen();
+ 
+       for(e=eq; e; e=e->eq)
+ 	{
+ 	  if (e->module == NULL)
+ 	    e->module = gfc_get_string("%s_equiv%d", module_name, num);
+ 	  mio_allocated_string(e->module);
+ 	  mio_expr(&e->expr);
+ 	}
+ 
+       num++;
+       mio_rparen();
+     }
+ }
  
  /* Write a symbol to the module.  */
  
*************** write_module (void)
*** 3449,3454 ****
--- 3523,3533 ----
    write_char ('\n');
    write_char ('\n');
  
+   mio_lparen();
+   write_equiv();
+   mio_rparen();
+   write_char('\n');  write_char('\n');
+ 
    /* Write symbol information.  First we traverse all symbols in the
       primary namespace, writing those that need to be written.
       Sometimes writing one symbol will cause another to need to be

Index: gcc/gcc/fortran/trans-decl.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/trans-decl.c,v
retrieving revision 1.65
diff -c -3 -p -r1.65 trans-decl.c
*** gcc/gcc/fortran/trans-decl.c	5 Aug 2005 20:37:06 -0000	1.65
--- gcc/gcc/fortran/trans-decl.c	8 Aug 2005 18:49:39 -0000
*************** gfc_create_module_variable (gfc_symbol *
*** 2148,2153 ****
--- 2148,2157 ----
    if (sym->attr.use_assoc || sym->attr.in_common)
      return;
  
+   /* Equivalenced variables arrive here after creation.  */
+   if (sym->backend_decl && sym->equiv_built)
+       return;
+ 
    if (sym->backend_decl)
      internal_error ("backend decl for module variable %s already exists",
  		    sym->name);

Index: gcc/gcc/fortran/trans-common.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/trans-common.c,v
retrieving revision 1.29
diff -c -3 -p -r1.29 trans-common.c
*** gcc/gcc/fortran/trans-common.c	20 Jul 2005 01:19:32 -0000	1.29
--- gcc/gcc/fortran/trans-common.c	8 Aug 2005 18:50:01 -0000
*************** find_equivalence (segment_info *n)
*** 700,705 ****
--- 700,706 ----
  	    {
  	      add_condition (n, eq, other);
  	      eq->used = 1;
+ 	      other->used = 1;
  	      found = TRUE;
  	      /* If this symbol is the first in the chain we may find other
  		 matches. Otherwise we can skip to the next equivalence.  */
*************** finish_equivalences (gfc_namespace *ns)
*** 893,898 ****
--- 894,900 ----
  {
    gfc_equiv *z, *y;
    gfc_symbol *sym;
+   gfc_common_head * c;
    HOST_WIDE_INT offset;
    unsigned HOST_WIDE_INT align;
    bool dummy;
*************** finish_equivalences (gfc_namespace *ns)
*** 916,923 ****
  
  	apply_segment_offset (current_segment, offset);
  
! 	/* Create the decl.  */
!         create_common (NULL, current_segment, true);
          break;
        }
  }
--- 918,940 ----
  
  	apply_segment_offset (current_segment, offset);
  
! 	/* Create the decl. If this is a module equivalence, it has a unique
! 	   name, pointed to by z->module. This is written to a common_header
! 	   to push create_common into using build_common_decl, so that the
! 	   equivalence appears as an external symbol. Otherwise, a local
! 	   declaration is built using build_equiv_decl.*/
! 	if (z->module)
! 	  {
! 	    c = gfc_get_common_head ();
! 	    /* We've lost the real location, so use the location of the
! 	     enclosing procedure.  */
! 	    c->where = ns->proc_name->declared_at;
! 	    strcpy (c->name, z->module);
! 	  }
! 	else
! 	  c = NULL;
! 
!         create_common (c, current_segment, true);
          break;
        }
  }

Index: gcc/gcc/fortran/gfortran.h
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/gfortran.h,v
retrieving revision 1.76
diff -c -3 -p -r1.76 gfortran.h
*** gcc/gcc/fortran/gfortran.h	14 Jul 2005 10:12:16 -0000	1.76
--- gcc/gcc/fortran/gfortran.h	8 Aug 2005 18:50:27 -0000
*************** typedef struct gfc_equiv
*** 1189,1194 ****
--- 1189,1195 ----
  {
    struct gfc_equiv *next, *eq;
    gfc_expr *expr;
+   const char *module;
    int used;
  }
  gfc_equiv;

! { dg-do run }
! This tests the fix for PR17917, where equivalences were not being
! written to and read back from modules.
!
! Contributed by Paul Thomas  pault@gcc.gnu.org
!
module test_equiv !Bug 17917
  common /my_common/ d
  real    a(2),b(4),c(4), d(8)
  equivalence (a(1),b(2)), (c(1),d(5))
end module test_equiv

subroutine foo ()
  use test_equiv, z=>b
  if (any (d(5:8)/=z)) call abort ()
end subroutine foo

program module_equiv
  use test_equiv
  b = 99.0_4
  a = 999.0_4
  c = (/99.0_4, 999.0_4, 999.0_4, 99.0_4/)
  call foo ()
end program module_equiv