re PR fortran/49540 (Memory-hog with large DATA stmt)

	PR fortran/49540
	* gfortran.h (gfc_constructor): Add repeat field.
	* trans-array.c (gfc_conv_array_initializer): Handle repeat > 1.
	* array.c (current_expand): Add repeat field.
	(expand_constructor): Copy repeat.
	* constructor.c (node_free, node_copy, gfc_constructor_get,
	gfc_constructor_lookup): Handle repeat field.
	(gfc_constructor_lookup_next, gfc_constructor_remove): New functions.
	* data.h (gfc_assign_data_value): Add mpz_t * argument.
	(gfc_assign_data_value_range): Removed.
	* constructor.h (gfc_constructor_advance): Removed.
	(gfc_constructor_lookup_next, gfc_constructor_remove): New prototypes.
	* data.c (gfc_assign_data_value): Add REPEAT argument, handle it and
	also handle overwriting a range with a single entry.
	(gfc_assign_data_value_range): Removed.
	* resolve.c (check_data_variable): Adjust gfc_assign_data_value
	call.  Use gfc_assign_data_value instead of
	gfc_assign_data_value_expr.

	* gfortran.dg/pr49540-1.f90: New test.
	* gfortran.dg/pr49540-2.f90: New test.

From-SVN: r175693

9 files changed, 243 insertions, 49 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index ed9c705..055c15d 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,24 @@
+2011-06-30  Jakub Jelinek  <jakub@redhat.com>
+
+	PR fortran/49540
+	* gfortran.h (gfc_constructor): Add repeat field.
+	* trans-array.c (gfc_conv_array_initializer): Handle repeat > 1.
+	* array.c (current_expand): Add repeat field.
+	(expand_constructor): Copy repeat.
+	* constructor.c (node_free, node_copy, gfc_constructor_get,
+	gfc_constructor_lookup): Handle repeat field.
+	(gfc_constructor_lookup_next, gfc_constructor_remove): New functions.
+	* data.h (gfc_assign_data_value): Add mpz_t * argument.
+	(gfc_assign_data_value_range): Removed.
+	* constructor.h (gfc_constructor_advance): Removed.
+	(gfc_constructor_lookup_next, gfc_constructor_remove): New prototypes.
+	* data.c (gfc_assign_data_value): Add REPEAT argument, handle it and
+	also handle overwriting a range with a single entry.
+	(gfc_assign_data_value_range): Removed.
+	* resolve.c (check_data_variable): Adjust gfc_assign_data_value
+	call.  Use gfc_assign_data_value instead of
+	gfc_assign_data_value_expr.
+
 2011-06-27  Janus Weil  <janus@gcc.gnu.org>
 
 	PR fortran/49466
diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c
index 1394e17..3074275 100644
--- a/gcc/fortran/array.c
+++ b/gcc/fortran/array.c
@@ -1322,6 +1322,7 @@ typedef struct
 
   mpz_t *offset;
   gfc_component *component;
+  mpz_t *repeat;
 
   gfc_try (*expand_work_function) (gfc_expr *);
 }
@@ -1556,6 +1557,7 @@ expand_constructor (gfc_constructor_base base)
 	  return FAILURE;
 	}
       current_expand.offset = &c->offset;
+      current_expand.repeat = &c->repeat;
       current_expand.component = c->n.component;
       if (current_expand.expand_work_function (e) == FAILURE)
 	return FAILURE;
diff --git a/gcc/fortran/constructor.c b/gcc/fortran/constructor.c
index 9739981..600488d 100644
--- a/gcc/fortran/constructor.c
+++ b/gcc/fortran/constructor.c
@@ -1,5 +1,5 @@
 /* Array and structure constructors
-   Copyright (C) 2009, 2010
+   Copyright (C) 2009, 2010, 2011
    Free Software Foundation, Inc.
 
 This file is part of GCC.
@@ -36,6 +36,7 @@ node_free (splay_tree_value value)
     gfc_free_iterator (c->iterator, 1);
 
   mpz_clear (c->offset);
+  mpz_clear (c->repeat);
 
   free (c);
 }
@@ -54,6 +55,7 @@ node_copy (splay_tree_node node, void *base)
   c->n.component = src->n.component;
 
   mpz_init_set (c->offset, src->offset);
+  mpz_init_set (c->repeat, src->repeat);
 
   return c;
 }
@@ -78,6 +80,7 @@ gfc_constructor_get (void)
   c->iterator = NULL;
 
   mpz_init_set_si (c->offset, 0);
+  mpz_init_set_si (c->repeat, 1);
 
   return c;
 }
@@ -169,6 +172,7 @@ gfc_constructor_insert_expr (gfc_constructor_base *base,
 gfc_constructor *
 gfc_constructor_lookup (gfc_constructor_base base, int offset)
 {
+  gfc_constructor *c;
   splay_tree_node node;
 
   if (!base)
@@ -176,9 +180,24 @@ gfc_constructor_lookup (gfc_constructor_base base, int offset)
 
   node = splay_tree_lookup (base, (splay_tree_key) offset);
   if (node)
-    return (gfc_constructor*) node->value;
+    return (gfc_constructor *) node->value;
 
-  return NULL;
+  /* Check if the previous node has a repeat count big enough to
+     cover the offset looked for.  */
+  node = splay_tree_predecessor (base, (splay_tree_key) offset);
+  if (!node)
+    return NULL;
+
+  c = (gfc_constructor *) node->value;
+  if (mpz_cmp_si (c->repeat, 1) > 0)
+    {
+      if (mpz_get_si (c->offset) + mpz_get_si (c->repeat) <= offset)
+	c = NULL;
+    }
+  else
+    c = NULL;
+
+  return c;
 }
 
 
@@ -232,3 +251,27 @@ gfc_constructor_next (gfc_constructor *ctor)
   else
     return NULL;
 }
+
+
+void
+gfc_constructor_remove (gfc_constructor *ctor)
+{
+  if (ctor)
+    splay_tree_remove (ctor->base, mpz_get_si (ctor->offset));
+}
+
+
+gfc_constructor *
+gfc_constructor_lookup_next (gfc_constructor_base base, int offset)
+{
+  splay_tree_node node;
+
+  if (!base)
+    return NULL;
+
+  node = splay_tree_successor (base, (splay_tree_key) offset);
+  if (!node)
+    return NULL;
+
+  return (gfc_constructor *) node->value;
+}
diff --git a/gcc/fortran/constructor.h b/gcc/fortran/constructor.h
index 558de7f..6b4bab4 100644
--- a/gcc/fortran/constructor.h
+++ b/gcc/fortran/constructor.h
@@ -1,5 +1,5 @@
 /* Array and structure constructors
-   Copyright (C) 2009, 2010
+   Copyright (C) 2009, 2010, 2011
    Free Software Foundation, Inc.
 
 This file is part of GCC.
@@ -81,6 +81,10 @@ gfc_constructor *gfc_constructor_first (gfc_constructor_base base);
    Returns NULL if there is no next expression.  */
 gfc_constructor *gfc_constructor_next (gfc_constructor *ctor);
 
-gfc_constructor *gfc_constructor_advance (gfc_constructor *ctor, int n);
+/* Remove the gfc_constructor node from the splay tree.  */
+void gfc_constructor_remove (gfc_constructor *);
+
+/* Return first constructor node after offset.  */
+gfc_constructor *gfc_constructor_lookup_next (gfc_constructor_base, int);
 
 #endif /* GFC_CONSTRUCTOR_H */
diff --git a/gcc/fortran/data.c b/gcc/fortran/data.c
index 137a939..67da371 100644
--- a/gcc/fortran/data.c
+++ b/gcc/fortran/data.c
@@ -1,5 +1,5 @@
 /* Supporting functions for resolving DATA statement.
-   Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
+   Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
    Free Software Foundation, Inc.
    Contributed by Lifang Zeng <zlf605@hotmail.com>
 
@@ -189,10 +189,13 @@ create_character_initializer (gfc_expr *init, gfc_typespec *ts,
 
 /* Assign the initial value RVALUE to  LVALUE's symbol->value. If the
    LVALUE already has an initialization, we extend this, otherwise we
-   create a new one.  */
+   create a new one.  If REPEAT is non-NULL, initialize *REPEAT
+   consecutive values in LVALUE the same value in RVALUE.  In that case,
+   LVALUE must refer to a full array, not an array section.  */
 
 gfc_try
-gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index)
+gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index,
+		       mpz_t *repeat)
 {
   gfc_ref *ref;
   gfc_expr *init;
@@ -269,6 +272,100 @@ gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index)
 			 &lvalue->where);
 	      goto abort;
 	    }
+	  else if (repeat != NULL
+		   && ref->u.ar.type != AR_ELEMENT)
+	    {
+	      mpz_t size, end;
+	      gcc_assert (ref->u.ar.type == AR_FULL
+			  && ref->next == NULL);
+	      mpz_init_set (end, offset);
+	      mpz_add (end, end, *repeat);
+	      if (spec_size (ref->u.ar.as, &size) == SUCCESS)
+		{
+		  if (mpz_cmp (end, size) > 0)
+		    {
+		      mpz_clear (size);
+		      gfc_error ("Data element above array upper bound at %L",
+				 &lvalue->where);
+		      goto abort;
+		    }
+		  mpz_clear (size);
+		}
+
+	      con = gfc_constructor_lookup (expr->value.constructor,
+					    mpz_get_si (offset));
+	      if (!con)
+		{
+		  con = gfc_constructor_lookup_next (expr->value.constructor,
+						     mpz_get_si (offset));
+		  if (con != NULL && mpz_cmp (con->offset, end) >= 0)
+		    con = NULL;
+		}
+
+	      /* Overwriting an existing initializer is non-standard but
+		 usually only provokes a warning from other compilers.  */
+	      if (con != NULL && con->expr != NULL)
+		{
+		  /* Order in which the expressions arrive here depends on
+		     whether they are from data statements or F95 style
+		     declarations.  Therefore, check which is the most
+		     recent.  */
+		  gfc_expr *exprd;
+		  exprd = (LOCATION_LINE (con->expr->where.lb->location)
+			   > LOCATION_LINE (rvalue->where.lb->location))
+			  ? con->expr : rvalue;
+		  if (gfc_notify_std (GFC_STD_GNU,"Extension: "
+				      "re-initialization of '%s' at %L",
+				      symbol->name, &exprd->where) == FAILURE)
+		    return FAILURE;
+		}
+
+	      while (con != NULL)
+		{
+		  gfc_constructor *next_con = gfc_constructor_next (con);
+
+		  if (mpz_cmp (con->offset, end) >= 0)
+		    break;
+		  if (mpz_cmp (con->offset, offset) < 0)
+		    {
+		      gcc_assert (mpz_cmp_si (con->repeat, 1) > 0);
+		      mpz_sub (con->repeat, offset, con->offset);
+		    }
+		  else if (mpz_cmp_si (con->repeat, 1) > 0
+			   && mpz_get_si (con->offset)
+			      + mpz_get_si (con->repeat) > mpz_get_si (end))
+		    {
+		      int endi;
+		      splay_tree_node node
+			= splay_tree_lookup (con->base,
+					     mpz_get_si (con->offset));
+		      gcc_assert (node
+				  && con == (gfc_constructor *) node->value
+				  && node->key == (splay_tree_key)
+						  mpz_get_si (con->offset));
+		      endi = mpz_get_si (con->offset)
+			     + mpz_get_si (con->repeat);
+		      if (endi > mpz_get_si (end) + 1)
+			mpz_set_si (con->repeat, endi - mpz_get_si (end));
+		      else
+			mpz_set_si (con->repeat, 1);
+		      mpz_set (con->offset, end);
+		      node->key = (splay_tree_key) mpz_get_si (end);
+		      break;
+		    }
+		  else
+		    gfc_constructor_remove (con);
+		  con = next_con;
+		}
+
+	      con = gfc_constructor_insert_expr (&expr->value.constructor,
+						 NULL, &rvalue->where,
+						 mpz_get_si (offset));
+	      mpz_set (con->repeat, *repeat);
+	      repeat = NULL;
+	      mpz_clear (end);
+	      break;
+	    }
 	  else
 	    {
 	      mpz_t size;
@@ -293,6 +390,32 @@ gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index)
 						 NULL, &rvalue->where,
 						 mpz_get_si (offset));
 	    }
+	  else if (mpz_cmp_si (con->repeat, 1) > 0)
+	    {
+	      /* Need to split a range.  */
+	      if (mpz_cmp (con->offset, offset) < 0)
+		{
+		  gfc_constructor *pred_con = con;
+		  con = gfc_constructor_insert_expr (&expr->value.constructor,
+						     NULL, &con->where,
+						     mpz_get_si (offset));
+		  con->expr = gfc_copy_expr (pred_con->expr);
+		  mpz_add (con->repeat, pred_con->offset, pred_con->repeat);
+		  mpz_sub (con->repeat, con->repeat, offset);
+		  mpz_sub (pred_con->repeat, offset, pred_con->offset);
+		}
+	      if (mpz_cmp_si (con->repeat, 1) > 0)
+		{
+		  gfc_constructor *succ_con;
+		  succ_con
+		    = gfc_constructor_insert_expr (&expr->value.constructor,
+						   NULL, &con->where,
+						   mpz_get_si (offset) + 1);
+		  succ_con->expr = gfc_copy_expr (con->expr);
+		  mpz_sub_ui (succ_con->repeat, con->repeat, 1);
+		  mpz_set_si (con->repeat, 1);
+		}
+	    }
 	  break;
 
 	case REF_COMPONENT:
@@ -337,6 +460,7 @@ gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index)
     }
 
   mpz_clear (offset);
+  gcc_assert (repeat == NULL);
 
   if (ref || last_ts->type == BT_CHARACTER)
     {
@@ -380,36 +504,6 @@ abort:
 }
 
 
-/* Similarly, but initialize REPEAT consecutive values in LVALUE the same
-   value in RVALUE.  */
-
-gfc_try
-gfc_assign_data_value_range (gfc_expr *lvalue, gfc_expr *rvalue,
-			     mpz_t index, mpz_t repeat)
-{
-  mpz_t offset, last_offset;
-  gfc_try t;
-
-  mpz_init (offset);
-  mpz_init (last_offset);
-  mpz_add (last_offset, index, repeat);
-
-  t = SUCCESS;
-  for (mpz_set(offset, index) ; mpz_cmp(offset, last_offset) < 0;
-		   mpz_add_ui (offset, offset, 1))
-    if (gfc_assign_data_value (lvalue, rvalue, offset) == FAILURE)
-      {
-	t = FAILURE;
-	break;
-      }
-
-  mpz_clear (offset);
-  mpz_clear (last_offset);
-
-  return t;
-}
-
-
 /* Modify the index of array section and re-calculate the array offset.  */
 
 void 
diff --git a/gcc/fortran/data.h b/gcc/fortran/data.h
index 955843c..a9687c4 100644
--- a/gcc/fortran/data.h
+++ b/gcc/fortran/data.h
@@ -1,5 +1,5 @@
 /* Header for functions resolving DATA statements.
-   Copyright (C) 2007, 2008, 2010 Free Software Foundation, Inc.
+   Copyright (C) 2007, 2008, 2010, 2011 Free Software Foundation, Inc.
 
 This file is part of GCC.
 
@@ -19,6 +19,5 @@ along with GCC; see the file COPYING3.  If not see
 
 void gfc_formalize_init_value (gfc_symbol *);
 void gfc_get_section_index (gfc_array_ref *, mpz_t *, mpz_t *);
-gfc_try gfc_assign_data_value (gfc_expr *, gfc_expr *, mpz_t);
-gfc_try gfc_assign_data_value_range (gfc_expr *, gfc_expr *, mpz_t, mpz_t);
+gfc_try gfc_assign_data_value (gfc_expr *, gfc_expr *, mpz_t, mpz_t *);
 void gfc_advance_section (mpz_t *, gfc_array_ref *, mpz_t *);
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 8b834ab..2eb497a 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2271,6 +2271,8 @@ typedef struct gfc_constructor
      gfc_component *component; /* Record the component being initialized.  */
   }
   n;
+  mpz_t repeat; /* Record the repeat number of initial values in data
+		  statement like "data a/5*10/".  */
 }
 gfc_constructor;
 
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index f484a22..8418c21 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -12752,8 +12752,8 @@ check_data_variable (gfc_data_variable *var, locus *where)
 	      mpz_set_ui (size, 0);
 	    }
 
-	  t = gfc_assign_data_value_range (var->expr, values.vnode->expr,
-					   offset, range);
+	  t = gfc_assign_data_value (var->expr, values.vnode->expr,
+				     offset, &range);
 
 	  mpz_add (offset, offset, range);
 	  mpz_clear (range);
@@ -12768,7 +12768,8 @@ check_data_variable (gfc_data_variable *var, locus *where)
 	  mpz_sub_ui (values.left, values.left, 1);
 	  mpz_sub_ui (size, size, 1);
 
-	  t = gfc_assign_data_value (var->expr, values.vnode->expr, offset);
+	  t = gfc_assign_data_value (var->expr, values.vnode->expr,
+				     offset, NULL);
 	  if (t == FAILURE)
 	    break;
 
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 408b73a..4c21389 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -4555,7 +4555,7 @@ gfc_conv_array_initializer (tree type, gfc_expr * expr)
   gfc_se se;
   HOST_WIDE_INT hi;
   unsigned HOST_WIDE_INT lo;
-  tree index;
+  tree index, range;
   VEC(constructor_elt,gc) *v = NULL;
 
   switch (expr->expr_type)
@@ -4609,28 +4609,56 @@ gfc_conv_array_initializer (tree type, gfc_expr * expr)
           else
             index = NULL_TREE;
 
+	  if (mpz_cmp_si (c->repeat, 1) > 0)
+	    {
+	      tree tmp1, tmp2;
+	      mpz_t maxval;
+
+	      mpz_init (maxval);
+	      mpz_add (maxval, c->offset, c->repeat);
+	      mpz_sub_ui (maxval, maxval, 1);
+	      tmp2 = gfc_conv_mpz_to_tree (maxval, gfc_index_integer_kind);
+	      if (mpz_cmp_si (c->offset, 0) != 0)
+		{
+		  mpz_add_ui (maxval, c->offset, 1);
+		  tmp1 = gfc_conv_mpz_to_tree (maxval, gfc_index_integer_kind);
+		}
+	      else
+		tmp1 = gfc_conv_mpz_to_tree (c->offset, gfc_index_integer_kind);
+
+	      range = fold_build2 (RANGE_EXPR, gfc_array_index_type, tmp1, tmp2);
+	      mpz_clear (maxval);
+	    }
+	  else
+	    range = NULL;
+
           gfc_init_se (&se, NULL);
 	  switch (c->expr->expr_type)
 	    {
 	    case EXPR_CONSTANT:
 	      gfc_conv_constant (&se, c->expr);
-	      CONSTRUCTOR_APPEND_ELT (v, index, se.expr);
 	      break;
 
 	    case EXPR_STRUCTURE:
               gfc_conv_structure (&se, c->expr, 1);
-	      CONSTRUCTOR_APPEND_ELT (v, index, se.expr);
 	      break;
 
-
 	    default:
 	      /* Catch those occasional beasts that do not simplify
 		 for one reason or another, assuming that if they are
 		 standard defying the frontend will catch them.  */
 	      gfc_conv_expr (&se, c->expr);
-	      CONSTRUCTOR_APPEND_ELT (v, index, se.expr);
 	      break;
 	    }
+
+	  if (range == NULL_TREE)
+	    CONSTRUCTOR_APPEND_ELT (v, index, se.expr);
+	  else
+	    {
+	      if (index != NULL_TREE)
+		CONSTRUCTOR_APPEND_ELT (v, index, se.expr);
+	      CONSTRUCTOR_APPEND_ELT (v, range, se.expr);
+	    }
         }
       break;