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

[Paul Thomas <paulthomas2 at wanadoo dot fr>]

The simple one liner has evolved a bit!  Thank you to FX for spotting 
that I had forgotten equivalences with more than two symbols.

The enclosed patch fixes the problem and regtests OK on FC3/Athlon.

:ADDPATCH <fortran>:

Paul T

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

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


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

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


Patch and test case appear below.

OK for mainline and 4.0?

Paul T

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	9 Aug 2005 18:02:10 -0000
*************** add_condition (segment_info *f, gfc_equi
*** 665,672 ****
  
  
  /* 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)
--- 665,671 ----
  
  
  /* 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)
*************** find_equivalence (segment_info *n)
*** 678,710 ****
    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;
  	    }
  	}
      }
--- 677,711 ----
    for (e1 = n->sym->ns->equiv; e1; e1 = e1->next)
      {
        other = NULL;
+       eq = NULL;
+ 
        for (e2 = e1->eq; e2; e2 = e2->eq)
  	{
  	  if (e2->used)
  	    continue;
  
! 	  if (eq)
! 	    other = e2;
! 	  else
  	    {
! 	      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;
! 		 }
  	    }
! 
  	  if (eq)
  	    {
  	      add_condition (n, eq, other);
  	      eq->used = 1;
+ 	      other->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, d
      COMMON /foo/ a
      EQUIVALENCE (a(1),b), (c,a(2),d)
      b = 101
      c = 102
      call bar ()
      END

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