1 files changed, 73 insertions, 18 deletions

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 3c28d45..44236e5 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -5084,6 +5084,28 @@ resolve_code (gfc_code * code, gfc_namespace * ns)
 	      goto call;
 	    }
 
+	  if (code->expr->ts.type == BT_CHARACTER
+		&& gfc_option.warn_character_truncation)
+	    {
+	      int llen = 0, rlen = 0;
+	      gfc_symbol *sym;
+	      sym = code->expr->symtree->n.sym;
+	      if (sym->ts.cl->length->expr_type == EXPR_CONSTANT)
+		llen = mpz_get_si (sym->ts.cl->length->value.integer);
+
+	      if (code->expr2->expr_type == EXPR_CONSTANT)
+		rlen = code->expr2->value.character.length;
+
+	      else if (code->expr2->ts.cl != NULL
+		    && code->expr2->ts.cl->length != NULL
+		    && code->expr2->ts.cl->length->expr_type == EXPR_CONSTANT)
+		rlen = mpz_get_si (code->expr2->ts.cl->length->value.integer);
+
+	      if (rlen && llen && rlen > llen)
+		gfc_warning_now ("rhs of CHARACTER assignment at %L will "
+				 "be truncated (%d/%d)", &code->loc, rlen, llen);
+	    }
+
 	  if (gfc_pure (NULL))
 	    {
 	      if (gfc_impure_variable (code->expr->symtree->n.sym))
@@ -6435,17 +6457,47 @@ traverse_data_list (gfc_data_variable * var, locus * where)
 {
   mpz_t trip;
   iterator_stack frame;
-  gfc_expr *e;
+  gfc_expr *e, *start, *end, *step;
+  try retval = SUCCESS;
 
   mpz_init (frame.value);
 
-  mpz_init_set (trip, var->iter.end->value.integer);
-  mpz_sub (trip, trip, var->iter.start->value.integer);
-  mpz_add (trip, trip, var->iter.step->value.integer);
+  start = gfc_copy_expr (var->iter.start);
+  end = gfc_copy_expr (var->iter.end);
+  step = gfc_copy_expr (var->iter.step);
+
+  if (gfc_simplify_expr (start, 1) == FAILURE
+	|| start->expr_type != EXPR_CONSTANT)
+    {
+      gfc_error ("iterator start at %L does not simplify",
+		 &start->where);
+      retval = FAILURE;
+      goto cleanup;
+    }
+  if (gfc_simplify_expr (end, 1) == FAILURE
+	||  end->expr_type != EXPR_CONSTANT)
+    {
+      gfc_error ("iterator end at %L does not simplify",
+		 &end->where);
+      retval = FAILURE;
+      goto cleanup;
+    }
+  if (gfc_simplify_expr (step, 1) == FAILURE
+	||  step->expr_type != EXPR_CONSTANT)
+    {
+      gfc_error ("iterator step at %L does not simplify",
+		 &step->where);
+      retval = FAILURE;
+      goto cleanup;
+    }
+
+  mpz_init_set (trip, end->value.integer);
+  mpz_sub (trip, trip, start->value.integer);
+  mpz_add (trip, trip, step->value.integer);
 
-  mpz_div (trip, trip, var->iter.step->value.integer);
+  mpz_div (trip, trip, step->value.integer);
 
-  mpz_set (frame.value, var->iter.start->value.integer);
+  mpz_set (frame.value, start->value.integer);
 
   frame.prev = iter_stack;
   frame.variable = var->iter.var->symtree;
@@ -6456,26 +6508,34 @@ traverse_data_list (gfc_data_variable * var, locus * where)
       if (traverse_data_var (var->list, where) == FAILURE)
 	{
 	  mpz_clear (trip);
-	  return FAILURE;
+	  retval = FAILURE;
+	  goto cleanup;
 	}
 
       e = gfc_copy_expr (var->expr);
       if (gfc_simplify_expr (e, 1) == FAILURE)
-        {
-          gfc_free_expr (e);
-          return FAILURE;
-        }
+	{
+	  gfc_free_expr (e);
+	  mpz_clear (trip);
+	  retval = FAILURE;
+	  goto cleanup;
+	}
 
-      mpz_add (frame.value, frame.value, var->iter.step->value.integer);
+      mpz_add (frame.value, frame.value, step->value.integer);
 
       mpz_sub_ui (trip, trip, 1);
     }
 
   mpz_clear (trip);
+cleanup:
   mpz_clear (frame.value);
 
+  gfc_free_expr (start);
+  gfc_free_expr (end);
+  gfc_free_expr (step);
+
   iter_stack = frame.prev;
-  return SUCCESS;
+  return retval;
 }
 
 
@@ -6520,11 +6580,6 @@ resolve_data_variables (gfc_data_variable * d)
 	  if (gfc_resolve_iterator (&d->iter, false) == FAILURE)
 	    return FAILURE;
 
-	  if (d->iter.start->expr_type != EXPR_CONSTANT
-	      || d->iter.end->expr_type != EXPR_CONSTANT
-	      || d->iter.step->expr_type != EXPR_CONSTANT)
-	    gfc_internal_error ("resolve_data_variables(): Bad iterator");
-
 	  if (resolve_data_variables (d->list) == FAILURE)
 	    return FAILURE;
 	}