re PR fortran/29786 (Initialization of overlapping variables: Not implemented)

2007-06-12  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-12  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.

From-SVN: r125628

1 files changed, 139 insertions, 23 deletions

diff --git a/gcc/fortran/trans-common.c b/gcc/fortran/trans-common.c
index bde7ea5..e39ec59 100644
--- a/gcc/fortran/trans-common.c
+++ b/gcc/fortran/trans-common.c
@@ -106,6 +106,7 @@ Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
 #include "trans.h"
 #include "trans-types.h"
 #include "trans-const.h"
+#include "target-memory.h"
 
 
 /* Holds a single variable in an equivalence set.  */
@@ -413,6 +414,110 @@ build_common_decl (gfc_common_head *com, tree union_type, bool is_init)
 }
 
 
+/* 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.  */
 
@@ -422,6 +527,8 @@ create_common (gfc_common_head *com, segment_info *head, bool saw_equiv)
   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;
@@ -440,6 +547,20 @@ create_common (gfc_common_head *com, segment_info *head, bool saw_equiv)
   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);
@@ -456,6 +577,7 @@ create_common (gfc_common_head *com, segment_info *head, bool saw_equiv)
       if (s->sym->attr.save)
         is_saved = true;
     }
+
   finish_record_layout (rli, true);
 
   if (com)
@@ -469,29 +591,23 @@ create_common (gfc_common_head *com, segment_info *head, bool saw_equiv)
       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;
-            }
-        }
+      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;