Re: [Patch, fortran] PR29786 - [4.1/4.2/4.3 Regression] Initialization of overlapping variables: Not implemented

[Paul Thomas <paulthomas2 at wanadoo dot fr>]

Brooks,
> This seems to rely on the s->offset values being in ascending order; 
> otherwise there will be false positives.  Can we rely on this?
trans-common.c(add_segments) makes this so.  We can rely on it.
> > +  /* Now absorb all the initializer data into a single vector,
> > +     whilst checking for overlapping, unequal values.  */
> > +  data = (unsigned char*)alloca ((size_t)length);
>
> For large arrays, the data array could be quite large.  Do we really 
> want to use alloca to put it on the stack?
I reverted to gfc_getmem
> > +  memset (data, '\0', (size_t)length);
>
> I think this line should have a TODO comment above it, noting that it 
> may need to be changed (or at least looked at) when -finit-local-zero 
> sorts of options are implemented to provide values other than zero.
Done
> [...]
> > +  known_align = 0;
> > +  if (known_align == 0 || known_align > BIGGEST_ALIGNMENT)
> > +    known_align = BIGGEST_ALIGNMENT;
>
> This if-statement is always true, because of the preceeding line.  
> What did you really mean here?  :)
known_align = BIGGEST_ALIGNMENT;
> [...]
> > +  for (i = 0; i < (int)len; i++)
> > +    {
> > +      if (data[i] && (check[i] != data[i]))
> > +    {
> > +      gfc_error ("Overlapping unequal initializers in EQUIVALENCE "
> > +             "at %L", &e->where);
> > +      return 0;
> > +    }
> > +    }
>
> This will, of course, fail to detect the overlapping unequal 
> initializers if the first one is initializing things to zero.
Corrected using a check array.
> IMO, it's probably okay to go ahead and commit this with this flaw, 
> but if you do, please file a PR about it and add a TODO comment to the 
> code. Also, please assign the PR to me unless you think you'll have 
> time to fix it.  :)
Not needed - is fixed; as are the corresponding derived type problems.
> > +      len = len + gfc_merge_initializers (ts, c->expr, &data[len],
> > +                          length - len);
> > +
> > +      gcc_assert (len <= length);
>
> This assert is IMO unnecessary, since it can be seen solely from 
> analysis of this function that it will always be true.
Removed.
> > +  subroutine int4_int4
> > +      integer(4)         NUNITS(4)
> > +      integer(4)         o
> > +      equivalence (o,nunits(3))
>
> "o" seems like a singularly poor choice for a variable name, and 
> "NUNITS" looks like it should mean something but it doesn't.  Could 
> these perhaps be A and B instead?
Done.

In addition, equiv_7.f90 now includes the derived type example that 
Tobias provided.

The new patch is attached and will be committed, just as soon as 
regtesting is done- this is a bit of a formality because the code path 
is so specialized:)

Cheers

Paul

2007-06-11 Paul Thomas <pault@gcc.gnu.org>

   PR fortran/29786
   PR fortran/30875
   * trans-common.c (get_init_field): New function.
   (create_common): Call get_init_field for overlapping
   initializers in equivalence blocks.
   * resolve.c (resolve_equivalence_derived, resolve_equivalence):
   Remove constraints on initializers in equivalence blocks.
   * target-memory.c (expr_to_char, gfc_merge_initializers):
   New functions.
   (encode_derived): Add the bit offset to the byte offset to get
   the total offset to the field.
   * target-memory.h : Add prototype for gfc_merge_initializers.


2007-06-11 Paul Thomas <pault@gcc.gnu.org>

   PR fortran/29786
   * gfortran.dg/equiv_7.f90: New test.
   * gfortran.dg/equiv_constraint_7.f90: Change error message.


   PR fortran/30875
   * gfortran.dg/equiv_constraint_5.f90: Correct code and error.



Index: gcc/fortran/trans-common.c
===================================================================
*** gcc/fortran/trans-common.c	(revision 125599)
--- gcc/fortran/trans-common.c	(working copy)
*************** Software Foundation, 51 Franklin Street,
*** 106,111 ****
--- 106,112 ----
  #include "trans.h"
  #include "trans-types.h"
  #include "trans-const.h"
+ #include "target-memory.h"
  
  
  /* Holds a single variable in an equivalence set.  */
*************** build_common_decl (gfc_common_head *com,
*** 413,418 ****
--- 414,523 ----
  }
  
  
+ /* Return a field that is the size of the union, if an equivalence has
+    overlapping initializers.  Merge the initializers into a single
+    initializer for this new field, then free the old ones.  */ 
+ 
+ static tree
+ get_init_field (segment_info *head, tree union_type, tree *field_init,
+ 		record_layout_info rli)
+ {
+   segment_info *s;
+   HOST_WIDE_INT length = 0;
+   HOST_WIDE_INT offset = 0;
+   unsigned HOST_WIDE_INT known_align, desired_align;
+   bool overlap = false;
+   tree tmp, field;
+   tree init;
+   unsigned char *data, *chk;
+   VEC(constructor_elt,gc) *v = NULL;
+ 
+   tree type = unsigned_char_type_node;
+   int i;
+ 
+   /* Obtain the size of the union and check if there are any overlapping
+      initializers.  */
+   for (s = head; s; s = s->next)
+     {
+       HOST_WIDE_INT slen = s->offset + s->length;
+       if (s->sym->value)
+ 	{
+ 	  if (s->offset < offset)
+             overlap = true;
+ 	  offset = slen;
+ 	}
+       length = length < slen ? slen : length;
+     }
+ 
+   if (!overlap)
+     return NULL_TREE;
+ 
+   /* Now absorb all the initializer data into a single vector,
+      whilst checking for overlapping, unequal values.  */
+   data = (unsigned char*)gfc_getmem ((size_t)length);
+   chk = (unsigned char*)gfc_getmem ((size_t)length);
+ 
+   /* TODO - change this when default initialization is implemented.  */
+   memset (data, '\0', (size_t)length);
+   memset (chk, '\0', (size_t)length);
+   for (s = head; s; s = s->next)
+     if (s->sym->value)
+       gfc_merge_initializers (s->sym->ts, s->sym->value,
+ 			      &data[s->offset],
+ 			      &chk[s->offset],
+ 			     (size_t)s->length);
+   
+   for (i = 0; i < length; i++)
+     CONSTRUCTOR_APPEND_ELT (v, NULL, build_int_cst (type, data[i]));
+ 
+   gfc_free (data);
+   gfc_free (chk);
+ 
+   /* Build a char[length] array to hold the initializers.  Much of what
+      follows is borrowed from build_field, above.  */
+ 
+   tmp = build_int_cst (gfc_array_index_type, length - 1);
+   tmp = build_range_type (gfc_array_index_type,
+ 			  gfc_index_zero_node, tmp);
+   tmp = build_array_type (type, tmp);
+   field = build_decl (FIELD_DECL, NULL_TREE, tmp);
+   gfc_set_decl_location (field, &gfc_current_locus);
+ 
+   known_align = BIGGEST_ALIGNMENT;
+ 
+   desired_align = update_alignment_for_field (rli, field, known_align);
+   if (desired_align > known_align)
+     DECL_PACKED (field) = 1;
+ 
+   DECL_FIELD_CONTEXT (field) = union_type;
+   DECL_FIELD_OFFSET (field) = size_int (0);
+   DECL_FIELD_BIT_OFFSET (field) = bitsize_zero_node;
+   SET_DECL_OFFSET_ALIGN (field, known_align);
+ 
+   rli->offset = size_binop (MAX_EXPR, rli->offset,
+                             size_binop (PLUS_EXPR,
+                                         DECL_FIELD_OFFSET (field),
+                                         DECL_SIZE_UNIT (field)));
+ 
+   init = build_constructor (TREE_TYPE (field), v);
+   TREE_CONSTANT (init) = 1;
+   TREE_INVARIANT (init) = 1;
+ 
+   *field_init = init;
+ 
+   for (s = head; s; s = s->next)
+     {
+       if (s->sym->value == NULL)
+ 	continue;
+ 
+       gfc_free_expr (s->sym->value);
+       s->sym->value = NULL;
+     }
+ 
+   return field;
+ }
+ 
+ 
  /* Declare memory for the common block or local equivalence, and create
     backend declarations for all of the elements.  */
  
*************** create_common (gfc_common_head *com, seg
*** 422,427 ****
--- 527,534 ----
    segment_info *s, *next_s;
    tree union_type;
    tree *field_link;
+   tree field;
+   tree field_init;
    record_layout_info rli;
    tree decl;
    bool is_init = false;
*************** create_common (gfc_common_head *com, seg
*** 440,445 ****
--- 547,566 ----
    rli = start_record_layout (union_type);
    field_link = &TYPE_FIELDS (union_type);
  
+   /* Check for overlapping initializers and replace them with a single,
+      artificial field that contains all the data.  */
+   if (saw_equiv)
+     field = get_init_field (head, union_type, &field_init, rli);
+   else
+     field = NULL_TREE;
+ 
+   if (field != NULL_TREE)
+     {
+       is_init = true;
+       *field_link = field;
+       field_link = &TREE_CHAIN (field);
+     }
+ 
    for (s = head; s; s = s->next)
      {
        build_field (s, union_type, rli);
*************** create_common (gfc_common_head *com, seg
*** 456,461 ****
--- 577,583 ----
        if (s->sym->attr.save)
          is_saved = true;
      }
+ 
    finish_record_layout (rli, true);
  
    if (com)
*************** create_common (gfc_common_head *com, seg
*** 469,497 ****
        HOST_WIDE_INT offset = 0;
        VEC(constructor_elt,gc) *v = NULL;
  
!       for (s = head; s; s = s->next)
!         {
!           if (s->sym->value)
!             {
!               if (s->offset < offset)
!                 {
! 		    /* We have overlapping initializers.  It could either be
! 		       partially initialized arrays (legal), or the user
! 		       specified multiple initial values (illegal).
! 		       We don't implement this yet, so bail out.  */
!                   gfc_todo_error ("Initialization of overlapping variables");
!                 }
! 	      /* Add the initializer for this field.  */
! 	      tmp = gfc_conv_initializer (s->sym->value, &s->sym->ts,
! 					  TREE_TYPE (s->field),
! 					  s->sym->attr.dimension,
! 					  s->sym->attr.pointer
! 					  || s->sym->attr.allocatable);
! 
! 	      CONSTRUCTOR_APPEND_ELT (v, s->field, tmp);
!               offset = s->offset + s->length;
!             }
!         }
        gcc_assert (!VEC_empty (constructor_elt, v));
        ctor = build_constructor (union_type, v);
        TREE_CONSTANT (ctor) = 1;
--- 591,613 ----
        HOST_WIDE_INT offset = 0;
        VEC(constructor_elt,gc) *v = NULL;
  
!       if (field != NULL_TREE && field_init != NULL_TREE)
! 	CONSTRUCTOR_APPEND_ELT (v, field, field_init);
!       else
! 	for (s = head; s; s = s->next)
! 	  {
! 	    if (s->sym->value)
! 	      {
! 		/* Add the initializer for this field.  */
! 		tmp = gfc_conv_initializer (s->sym->value, &s->sym->ts,
! 		    TREE_TYPE (s->field), s->sym->attr.dimension,
! 		    s->sym->attr.pointer || s->sym->attr.allocatable);
! 
! 		CONSTRUCTOR_APPEND_ELT (v, s->field, tmp);
! 		offset = s->offset + s->length;
! 	      }
! 	  }
! 
        gcc_assert (!VEC_empty (constructor_elt, v));
        ctor = build_constructor (union_type, v);
        TREE_CONSTANT (ctor) = 1;
Index: gcc/fortran/resolve.c
===================================================================
*** gcc/fortran/resolve.c	(revision 125599)
--- gcc/fortran/resolve.c	(working copy)
*************** resolve_equivalence_derived (gfc_symbol 
*** 6992,7005 ****
  		     sym->name, &e->where);
  	  return FAILURE;
  	}
- 
-       if (c->initializer)
- 	{
- 	  gfc_error ("Derived type variable '%s' at %L with default "
- 		     "initializer cannot be an EQUIVALENCE object",
- 		     sym->name, &e->where);
- 	  return FAILURE;
- 	}
      }
    return SUCCESS;
  }
--- 6992,6997 ----
*************** resolve_equivalence (gfc_equiv *eq)
*** 7122,7142 ****
  	      break;
  	}
  
-       /* An equivalence statement cannot have more than one initialized
- 	 object.  */
-       if (sym->value)
- 	{
- 	  if (value_name != NULL)
- 	    {
- 	      gfc_error ("Initialized objects '%s' and '%s' cannot both "
- 			 "be in the EQUIVALENCE statement at %L",
- 			 value_name, sym->name, &e->where);
- 	      continue;
- 	    }
- 	  else
- 	    value_name = sym->name;
- 	}
- 
        /* Shall not equivalence common block variables in a PURE procedure.  */
        if (sym->ns->proc_name
  	  && sym->ns->proc_name->attr.pure
--- 7114,7119 ----
Index: gcc/fortran/target-memory.c
===================================================================
*** gcc/fortran/target-memory.c	(revision 125599)
--- gcc/fortran/target-memory.c	(working copy)
*************** encode_derived (gfc_expr *source, unsign
*** 198,205 ****
    cmp = source->ts.derived->components;
    for (;ctr; ctr = ctr->next, cmp = cmp->next)
      {
!       gcc_assert (ctr->expr && cmp);
!       ptr = TREE_INT_CST_LOW (DECL_FIELD_OFFSET (cmp->backend_decl));
        gfc_target_encode_expr (ctr->expr, &buffer[ptr],
  			      buffer_size - ptr);
      }
--- 198,208 ----
    cmp = source->ts.derived->components;
    for (;ctr; ctr = ctr->next, cmp = cmp->next)
      {
!       gcc_assert (cmp);
!       if (!ctr->expr)
! 	continue;
!       ptr = TREE_INT_CST_LOW(DECL_FIELD_OFFSET(cmp->backend_decl))
! 	    + TREE_INT_CST_LOW(DECL_FIELD_BIT_OFFSET(cmp->backend_decl))/8;
        gfc_target_encode_expr (ctr->expr, &buffer[ptr],
  			      buffer_size - ptr);
      }
*************** gfc_target_interpret_expr (unsigned char
*** 491,493 ****
--- 494,598 ----
  
    return result->representation.length;
  }
+ 
+ 
+ /* --------------------------------------------------------------- */ 
+ /* Two functions used by trans-common.c to write overlapping
+    equivalence initializers to a buffer.  This is added to the union
+    and the original initializers freed.  */
+ 
+ 
+ /* Writes the values of a constant expression to a char buffer. If another
+    unequal initializer has already been written to the buffer, this is an
+    error.  */
+ 
+ static size_t
+ expr_to_char (gfc_expr *e, unsigned char *data, unsigned char *chk, size_t len)
+ {
+   int i;
+   int ptr;
+   gfc_constructor *ctr;
+   gfc_component *cmp;
+   unsigned char *buffer;
+ 
+   if (e == NULL)
+     return 0;
+ 
+   /* Take a derived type, one component at a time, using the offsets from the backend
+      declaration.  */
+   if (e->ts.type == BT_DERIVED)
+     {
+       ctr = e->value.constructor;
+       cmp = e->ts.derived->components;
+       for (;ctr; ctr = ctr->next, cmp = cmp->next)
+ 	{
+ 	  gcc_assert (cmp && cmp->backend_decl);
+ 	  if (!ctr->expr)
+ 	    continue;
+ 	    ptr = TREE_INT_CST_LOW(DECL_FIELD_OFFSET(cmp->backend_decl))
+ 			+ TREE_INT_CST_LOW(DECL_FIELD_BIT_OFFSET(cmp->backend_decl))/8;
+ 	  expr_to_char (ctr->expr, &data[ptr], &chk[ptr], len);
+ 	}
+       return len;
+     }
+ 
+   /* Otherwise, use the target-memory machinery to write a bitwise image, appropriate
+      to the target, in a buffer and check off the initialized part of the buffer.  */
+   len = gfc_target_expr_size (e);
+   buffer = (unsigned char*)alloca (len);
+   len = gfc_target_encode_expr (e, buffer, len);
+ 
+     for (i = 0; i < (int)len; i++)
+     {
+       if (chk[i] && (buffer[i] != data[i]))
+ 	{
+ 	  gfc_error ("Overlapping unequal initializers in EQUIVALENCE "
+ 		     "at %L", &e->where);
+ 	  return 0;
+ 	}
+       chk[i] = 0xFF;
+     }
+ 
+   memcpy (data, buffer, len);
+   return len;
+ }
+ 
+ 
+ /* Writes the values from the equivalence initializers to a char* array
+    that will be written to the constructor to make the initializer for
+    the union declaration.  */
+ 
+ size_t
+ gfc_merge_initializers (gfc_typespec ts, gfc_expr *e, unsigned char *data,
+ 			unsigned char *chk, size_t length)
+ {
+   size_t len = 0;
+   gfc_constructor * c;
+ 
+   switch (e->expr_type)
+     {
+     case EXPR_CONSTANT:
+     case EXPR_STRUCTURE:
+       len = expr_to_char (e, &data[0], &chk[0], length);
+ 
+       break;
+ 
+     case EXPR_ARRAY:
+       for (c = e->value.constructor; c; c = c->next)
+ 	{
+ 	  size_t elt_size = gfc_target_expr_size (c->expr);
+ 
+ 	  if (c->n.offset)
+ 	    len = elt_size * (size_t)mpz_get_si (c->n.offset);
+ 
+ 	  len = len + gfc_merge_initializers (ts, c->expr, &data[len],
+ 					      &chk[len], length - len);
+ 	}
+       break;
+ 
+     default:
+       return 0;
+     }
+ 
+   return len;
+ }
Index: gcc/fortran/target-memory.h
===================================================================
*** gcc/fortran/target-memory.h	(revision 125599)
--- gcc/fortran/target-memory.h	(working copy)
*************** int gfc_interpret_character (unsigned ch
*** 41,44 ****
--- 41,49 ----
  int gfc_interpret_derived (unsigned char *, size_t, gfc_expr *);
  int gfc_target_interpret_expr (unsigned char *, size_t, gfc_expr *);
  
+ /* Merge overlapping equivalence initializers for trans-common.c. */
+ size_t gfc_merge_initializers (gfc_typespec, gfc_expr *,
+ 			       unsigned char *, unsigned char *,
+ 			       size_t);
+ 
  #endif /* GFC_TARGET_MEMORY_H  */
Index: gcc/testsuite/gfortran.dg/equiv_7.f90
===================================================================
*** gcc/testsuite/gfortran.dg/equiv_7.f90	(revision 0)
--- gcc/testsuite/gfortran.dg/equiv_7.f90	(revision 0)
***************
*** 0 ****
--- 1,91 ----
+ ! { dg-do run }
+ ! Tests the fix for PR29786, in which initialization of overlapping
+ ! equivalence elements caused a compile error.
+ !
+ ! Contributed by Bernhard Fischer <aldot@gcc.gnu.org>
+ !
+ block data
+   common /global/ ca (4)
+   integer(4) ca, cb
+   equivalence (cb, ca(3))
+   data (ca(i), i = 1, 2) /42,43/, ca(4) /44/
+   data cb /99/
+ end block data
+ 
+   call int4_int4
+   call real4_real4
+   call complex_real
+   call check_block_data
+   call derived_types         ! Thanks to Tobias Burnus for this:)
+ !
+ ! This came up in PR29786 comment #9
+ !
+   if (d1mach (1) .ne. transfer ((/0_4, 1048576_4/), 1d0)) call abort ()
+   if (d1mach (2) .ne. transfer ((/-1_4,2146435071_4/), 1d0)) call abort ()
+ !
+ contains
+   subroutine int4_int4
+       integer(4)         a(4)
+       integer(4)         b
+       equivalence (b,a(3))
+       data b/3/
+       data (a(i), i=1,2) /1,2/, a(4) /4/
+       if (any (a .ne. (/1, 2, 3, 4/))) call abort ()
+   end subroutine int4_int4
+   subroutine real4_real4
+       real(4)         a(4)
+       real(4)         b
+       equivalence (b,a(3))
+       data b/3.0_4/
+       data (a(i), i=1,2) /1.0_4, 2.0_4/, &
+             a(4) /4.0_4/
+       if (sum (abs (a -  &
+           (/1.0_4, 2.0_4, 3.0_4, 4.0_4/))) > 1.0e-6) call abort ()
+   end subroutine real4_real4
+   subroutine complex_real
+       complex(4)         a(4)
+       real(4)            b(2)
+       equivalence (b,a(3))
+       data b(1)/3.0_4/, b(2)/4.0_4/
+       data (a(i), i=1,2) /(0.0_4, 1.0_4),(2.0_4,0.0_4)/, &
+             a(4) /(0.0_4,5.0_4)/
+       if (sum (abs (a - (/(0.0_4, 1.0_4),(2.0_4, 0.0_4), &
+           (3.0_4, 4.0_4),(0.0_4, 5.0_4)/)))  > 1.0e-6) call abort ()
+   end subroutine complex_real
+   subroutine check_block_data
+       common /global/ ca (4)
+       equivalence (ca(3), cb)
+       integer(4) ca
+       if (any (ca .ne. (/42, 43, 99, 44/))) call abort ()
+   end subroutine check_block_data
+   function d1mach(i)
+     implicit none
+     double precision d1mach,dmach(5)
+     integer i,large(4),small(4)
+     equivalence ( dmach(1), small(1) )
+     equivalence ( dmach(2), large(1) )
+     data small(1),small(2) / 0,   1048576/
+     data large(1),large(2) /-1,2146435071/
+     d1mach = dmach(i) 
+   end function d1mach
+     subroutine derived_types
+       TYPE T1
+         sequence
+         character (3) :: chr
+         integer :: i = 1
+         integer :: j
+         END TYPE T1
+       TYPE T2
+         sequence
+         character (3) :: chr = "wxy"
+         integer :: i = 1
+         integer :: j = 4
+       END TYPE T2
+       TYPE(T1) :: a1
+       TYPE(T2) :: a2
+       EQUIVALENCE(a1,a2)
+       if (a1%chr .ne. "wxy") call abort ()
+       if (a1%i .ne. 1) call abort ()
+       if (a1%j .ne. 4) call abort ()
+       end subroutine derived_types
+ end
Index: gcc/testsuite/gfortran.dg/equiv_constraint_5.f90
===================================================================
*** gcc/testsuite/gfortran.dg/equiv_constraint_5.f90	(revision 125599)
--- gcc/testsuite/gfortran.dg/equiv_constraint_5.f90	(working copy)
***************
*** 1,18 ****
  ! { dg-do compile }
  ! { dg-options "-O0" }
! ! PR20902 - Structure with default initializer cannot be equivalence memeber.
  ! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
! TYPE T1
!  sequence
!  integer :: i=1
! END TYPE T1
! TYPE T2
!  sequence
!  integer :: i      ! drop original initializer to pick up error below.
! END TYPE T2
! TYPE(T1) :: a1
! TYPE(T2) :: a2
! EQUIVALENCE(a1,a2) ! { dg-error "initializer cannot be an EQUIVALENCE" }
! write(6,*) a1,a2
  END
  
--- 1,31 ----
  ! { dg-do compile }
  ! { dg-options "-O0" }
! ! PR20902 - Overlapping initializers in an equivalence block must
! ! have the same value.
! !
! ! The code was replaced completely after the fix for PR30875, which
! ! is a repeat of the original and comes from the same contributor.
! ! The fix for 20902 was wrong.
! !
  ! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
! !
!   TYPE T1
!     sequence
!     integer :: i=1
!   END TYPE T1
!   TYPE T2        ! OK because initializers are equal
!     sequence
!     integer :: i=1
!   END TYPE T2
!   TYPE T3        ! { dg-error "Overlapping unequal initializers" }
!     sequence
!     integer :: i=2
!   END TYPE T3
!   TYPE(T1) :: a1
!   TYPE(T2) :: a2
!   TYPE(T3) :: a3
!   EQUIVALENCE (a1, a2)
!   EQUIVALENCE (a1, a3)
!   write(6, *) a1, a2, a3
  END
  
Index: gcc/testsuite/gfortran.dg/equiv_constraint_7.f90
===================================================================
*** gcc/testsuite/gfortran.dg/equiv_constraint_7.f90	(revision 125599)
--- gcc/testsuite/gfortran.dg/equiv_constraint_7.f90	(working copy)
***************
*** 1,11 ****
  ! { dg-do compile }
  ! { dg-options "-O0" }
! ! PR20890 - Equivalence cannot contain more than one initialized variables.
  ! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
  ! Started out being in BLOCK DATA; however, blockdata variables must be in
  ! COMMON and therefore cannot have F95 style initializers....
   MODULE DATA
!   INTEGER :: I=1,J=2
!   EQUIVALENCE(I,J)  ! { dg-error "cannot both be in the EQUIVALENCE" }
   END MODULE DATA
   END
--- 1,11 ----
  ! { dg-do compile }
  ! { dg-options "-O0" }
! ! PR20890 - Equivalence cannot contain overlapping unequal initializers.
  ! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
  ! Started out being in BLOCK DATA; however, blockdata variables must be in
  ! COMMON and therefore cannot have F95 style initializers....
   MODULE DATA
!   INTEGER :: I=1,J=2  ! { dg-error "Overlapping unequal initializers" }
!   EQUIVALENCE(I,J)
   END MODULE DATA
   END