gcc/fortran/:

2010-05-05  Daniel Franke  <franke.daniel@gmail.com>

	PR fortran/24978
	* gfortran.h: Removed repeat count from constructor, removed
	all usages.
	* data.h (gfc_assign_data_value_range): Changed return value from
	void to gfc_try.
	* data.c (gfc_assign_data_value): Add location to constructor element.
	(gfc_assign_data_value_range): Call gfc_assign_data_value()
	for each element in range. Return early if an error was generated.
	* resolve.c (check_data_variable): Stop early if range assignment
	generated an error.

gcc/testsuite/:
2010-05-05  Daniel Franke  <franke.daniel@gmail.com>

	PR fortran/24978
	* gfortran.dg/data_invalid.f90: New.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@159076 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 26 insertions, 138 deletions

diff --git a/gcc/fortran/data.c b/gcc/fortran/data.c
index fca251cb660..c217e1cab0e 100644
--- a/gcc/fortran/data.c
+++ b/gcc/fortran/data.c
@@ -288,7 +288,7 @@ gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index)
 	  if (!con)
 	    {
 	      con = gfc_constructor_insert_expr (&expr->value.constructor,
-						 NULL, NULL,
+						 NULL, &rvalue->where,
 						 mpz_get_si (offset));
 	    }
 	  break;
@@ -352,8 +352,10 @@ gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index)
 	  expr = (LOCATION_LINE (init->where.lb->location)
 		  > LOCATION_LINE (rvalue->where.lb->location))
 	       ? init : rvalue;
-	  gfc_notify_std (GFC_STD_GNU, "Extension: re-initialization "
-			  "of '%s' at %L", symbol->name, &expr->where);
+	  if (gfc_notify_std (GFC_STD_GNU,"Extension: "
+			      "re-initialization of '%s' at %L",
+			      symbol->name, &expr->where) == FAILURE)
+	    return FAILURE;
 	}
 
       expr = gfc_copy_expr (rvalue);
@@ -371,149 +373,35 @@ gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index)
 
 
 /* Similarly, but initialize REPEAT consecutive values in LVALUE the same
-   value in RVALUE.  For the nonce, LVALUE must refer to a full array, not
-   an array section.  */
+   value in RVALUE.  */
 
-void
+gfc_try
 gfc_assign_data_value_range (gfc_expr *lvalue, gfc_expr *rvalue,
 			     mpz_t index, mpz_t repeat)
 {
-  gfc_ref *ref;
-  gfc_expr *init, *expr;
-  gfc_constructor *con, *last_con;
-  gfc_symbol *symbol;
-  gfc_typespec *last_ts;
-  mpz_t offset;
-
-  symbol = lvalue->symtree->n.sym;
-  init = symbol->value;
-  last_ts = &symbol->ts;
-  last_con = NULL;
-  mpz_init_set_si (offset, 0);
-
-  /* Find/create the parent expressions for subobject references.  */
-  for (ref = lvalue->ref; ref; ref = ref->next)
-    {
-      /* Use the existing initializer expression if it exists.
-	 Otherwise create a new one.  */
-      if (init == NULL)
-	expr = gfc_get_expr ();
-      else
-	expr = init;
-
-      /* Find or create this element.  */
-      switch (ref->type)
-	{
-	case REF_ARRAY:
-	  if (init == NULL)
-	    {
-	      /* The element typespec will be the same as the array
-		 typespec.  */
-	      expr->ts = *last_ts;
-	      /* Setup the expression to hold the constructor.  */
-	      expr->expr_type = EXPR_ARRAY;
-	      expr->rank = ref->u.ar.as->rank;
-	    }
-	  else
-	    gcc_assert (expr->expr_type == EXPR_ARRAY);
-
-	  if (ref->u.ar.type == AR_ELEMENT)
-	    {
-	      get_array_index (&ref->u.ar, &offset);
-
-	      /* This had better not be the bottom of the reference.
-		 We can still get to a full array via a component.  */
-	      gcc_assert (ref->next != NULL);
-	    }
-	  else
-	    {
-	      mpz_set (offset, index);
-
-	      /* We're at a full array or an array section.  This means
-		 that we've better have found a full array, and that we're
-		 at the bottom of the reference.  */
-	      gcc_assert (ref->u.ar.type == AR_FULL);
-	      gcc_assert (ref->next == NULL);
-	    }
-
-	  con = gfc_constructor_lookup (expr->value.constructor,
-					mpz_get_si (offset));
-	  if (con == NULL)
-	    {
-	      con = gfc_constructor_insert_expr (&expr->value.constructor,
-						 NULL, NULL,
-						 mpz_get_si (offset));
-	      if (ref->next == NULL)
-		mpz_set (con->repeat, repeat);
-	    }
-	  else
-	    gcc_assert (ref->next != NULL);
-	  break;
-
-	case REF_COMPONENT:
-	  if (init == NULL)
-	    {
-	      /* Setup the expression to hold the constructor.  */
-	      expr->expr_type = EXPR_STRUCTURE;
-	      expr->ts.type = BT_DERIVED;
-	      expr->ts.u.derived = ref->u.c.sym;
-	    }
-	  else
-	    gcc_assert (expr->expr_type == EXPR_STRUCTURE);
-	  last_ts = &ref->u.c.component->ts;
-
-  	  /* Find the same element in the existing constructor.  */
-	  con = find_con_by_component (ref->u.c.component,
-				       expr->value.constructor);
-
-	  if (con == NULL)
-	    {
-	      /* Create a new constructor.  */
-	      con = gfc_constructor_append_expr (&expr->value.constructor,
-						 NULL, NULL);
-	      con->n.component = ref->u.c.component;
-	    }
-
-	  /* Since we're only intending to initialize arrays here,
-	     there better be an inner reference.  */
-	  gcc_assert (ref->next != NULL);
-	  break;
-
-	case REF_SUBSTRING:
-	default:
-	  gcc_unreachable ();
-	}
-
-      if (init == NULL)
-	{
-	  /* Point the container at the new expression.  */
-	  if (last_con == NULL)
-	    symbol->value = expr;
-	  else
-	    last_con->expr = expr;
-	}
-      init = con->expr;
-      last_con = con;
-    }
+  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;
+      }
 
-  if (last_ts->type == BT_CHARACTER)
-    expr = create_character_intializer (init, last_ts, NULL, rvalue);
-  else
-    {
-      /* We should never be overwriting an existing initializer.  */
-      gcc_assert (!init);
+  mpz_clear (offset);
+  mpz_clear (last_offset);
 
-      expr = gfc_copy_expr (rvalue);
-      if (!gfc_compare_types (&lvalue->ts, &expr->ts))
-	gfc_convert_type (expr, &lvalue->ts, 0);
-    }
-
-  if (last_con == NULL)
-    symbol->value = expr;
-  else
-    last_con->expr = expr;
+  return t;
 }
 
+
 /* Modify the index of array section and re-calculate the array offset.  */
 
 void