[Patch, gfortran] PR22304 - gfortran silently changes values in equivalencedvariables

[Paul Thomas <paulthomas2 at wanadoo dot fr>]

:ADDPATCH <fortran>:

This patch, is a development of Mike Albert's. It considerably 
simplifies the original code and allows it to cope correctly with all 
legal variants of the equivalence statement.

The problem arose when the symbol that owned a common segment did not 
appear first in an equivalence pair.  The first member, which could be 
from the local scope, did not get marked as used and so got hit again, 
when local equivalences were dealt with.  This produced a union, in the 
local scope, that was different to the union for the common/equivalence 
block.

Equivalence groups with three or more members were being being 
re-associated by finish_equivalences, in the correct place, even though 
find_equivalences failed, sometimes to find one of the members; eg. for 
a group (a, b, owner), b would not be found. The patch simplifies the 
business by marking all the members of a group at the same time. (Thanks 
to Thomas Koenig to alerting me to my lack of understanding of this point.)

A blow-by-blow analysis:

(i) Translate_common calls add_equivalences, which calls 
find_equivalences. At present, this only marks, as_used, the equivalence 
partners that appear in the chain linked to the quivalence group; ie. 
the root member is quietly ignored, if it is not the segment owner.
(ii) Later, finish_equivalences does the same again. This time it 
creates local unions for all equivalence variables that are not used; 
ie. those that are declared in the local scope.
(iii) Thus, where this happens, references in this scope point to the 
local union, rather than the common block.
(iv) The fix acts on step (i) by marking all the partners in the local 
scope, as_used. It does this by cycling through each equivalence group 
looking for the segment owner.  Once this is identified,, it cycles 
through this group again, adding the members to the common block and 
marking them as_used.

Bubblestrapped and regtested on FC3/Athlon 1700.

OK for mainline and 4.0?

Paul T


2005-08-17  Paul Thomas  <pault@gcc.gnu.org>
	    Mike Albert  <albertm@uphs.upenn.edu>

	PR fortran/22304
	* trans-common.c (find_equivalences): Ensure that all members
	in common block equivalences are marked as used. This prevents
	the subsequent call to this function from making local unions.


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

	PR fortran/22304
	* gfortran.dg/common_equivalence_1.f: New.


====================================================================


*** gcc/gcc/fortran/trans-common.c	2005-08-06 14:56:18.000000000 +0200
--- /gcc-4.1/gcc/gcc/fortran/trans-common.c	2005-08-16 18:29:43.000000000 +0200
*************** add_condition (segment_info *f, gfc_equi
*** 665,710 ****
  
  
  /* Given a segment element, search through the equivalence lists for unused
!    conditions that involve the symbol.  Add these rules to the segment.  Only
!    checks for rules involving the first symbol in the equivalence set.  */
!  
  static bool
  find_equivalence (segment_info *n)
  {
!   gfc_equiv *e1, *e2, *eq, *other;
    bool found;
!  
    found = FALSE;
    for (e1 = n->sym->ns->equiv; e1; e1 = e1->next)
      {
!       other = NULL;
!       for (e2 = e1->eq; e2; e2 = e2->eq)
! 	{
! 	  if (e2->used)
! 	    continue;
  
! 	  if (e1->expr->symtree->n.sym == n->sym)
! 	    {
! 	      eq = e1;
! 	      other = e2;
! 	    }
! 	  else if (e2->expr->symtree->n.sym == n->sym)
  	    {
  	      eq = e2;
! 	      other = e1;
  	    }
! 	  else
! 	    eq = NULL;
! 	  
! 	  if (eq)
  	    {
! 	      add_condition (n, eq, other);
! 	      eq->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.  */
- 	      if (eq == e2)
- 		break;
  	    }
  	}
      }
--- 665,709 ----
  
  
  /* Given a segment element, search through the equivalence lists for unused
!    conditions that involve the symbol.  Add these rules to the segment.  */
! 
  static bool
  find_equivalence (segment_info *n)
  {
!   gfc_equiv *e1, *e2, *eq;
    bool found;
! 
    found = FALSE;
+ 
    for (e1 = n->sym->ns->equiv; e1; e1 = e1->next)
      {
!       eq = NULL;
  
!       /* Search the equivalence list, including the root (first) element
!          for the symbol that owns the segment.  */
!       for (e2 = e1; e2; e2 = e2->eq)
! 	{
! 	  if (!e2->used && e2->expr->symtree->n.sym == n->sym)
  	    {
  	      eq = e2;
! 	      break;
  	    }
! 	}
! 
!       /* Go to the next root element.  */
!       if (eq == NULL)
! 	continue;
! 
!       eq->used = 1;
! 
!       /* Now traverse the equivalence list matching the offsets.  */
!       for (e2 = e1; e2; e2 = e2->eq)
! 	{
! 	  if (!e2->used && e2 != eq)
  	    {
! 	      add_condition (n, eq, e2);
! 	      e2->used = 1;
  	      found = TRUE;
  	    }
  	}
      }


=========================================

c { dg-do run }
c This program tests the fix for PR22304.
c
c provided by Paul Thomas - pault@gcc.gnu.org
c
      integer a(2), b, c
      COMMON /foo/ a
      EQUIVALENCE (a(1), b), (c, a(2))
      a(1) = 101
      a(2) = 102
      call bar ()
      END

      subroutine bar ()
      integer a(2), b, c, d
      COMMON /foo/ a
      EQUIVALENCE (a(1), b), (c, a(2))
      if (b.ne.101) call abort ()
      if (c.ne.102) call abort ()
      END