re PR fortran/31243 (Detect strings longer than 2**32 characters)

	PR fortran/31243

	* resolve.c (resolve_substring): Don't allow too large substring
	indexes.
	(gfc_resolve_substring_charlen): Fix typo.
	(gfc_resolve_character_operator): Fix typo.
	(resolve_charlen): Catch unreasonably large string lengths.
	* simplify.c (gfc_simplify_len): Don't error out on LEN
	range checks.

	* gcc/testsuite/gfortran.dg/string_1.f90: New test.
	* gcc/testsuite/gfortran.dg/string_2.f90: New test.
	* gcc/testsuite/gfortran.dg/string_3.f90: New test.

From-SVN: r147619

3 files changed, 50 insertions, 5 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 81182df..0b81464 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,5 +1,16 @@
 2009-05-16  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
 
+	PR fortran/31243
+	* resolve.c (resolve_substring): Don't allow too large substring
+	indexes.
+	(gfc_resolve_substring_charlen): Fix typo.
+	(gfc_resolve_character_operator): Fix typo.
+	(resolve_charlen): Catch unreasonably large string lengths.
+	* simplify.c (gfc_simplify_len): Don't error out on LEN
+	range checks.
+
+2009-05-16  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
 	PR fortran/36031
 	* decl.c (set_enum_kind): Use global short-enums flag.
 	* gfortran.h (gfc_option_t): Remove short_enums flag.
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index dbca175..836aeb0 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -3897,6 +3897,8 @@ resolve_array_ref (gfc_array_ref *ar)
 static gfc_try
 resolve_substring (gfc_ref *ref)
 {
+  int k = gfc_validate_kind (BT_INTEGER, gfc_charlen_int_kind, false);
+
   if (ref->u.ss.start != NULL)
     {
       if (gfc_resolve_expr (ref->u.ss.start) == FAILURE)
@@ -3954,6 +3956,16 @@ resolve_substring (gfc_ref *ref)
 		     &ref->u.ss.start->where);
 	  return FAILURE;
 	}
+
+      if (compare_bound_mpz_t (ref->u.ss.end,
+			       gfc_integer_kinds[k].huge) == CMP_GT
+	  && (compare_bound (ref->u.ss.end, ref->u.ss.start) == CMP_EQ
+	      || compare_bound (ref->u.ss.end, ref->u.ss.start) == CMP_GT))
+	{
+	  gfc_error ("Substring end index at %L is too large",
+		     &ref->u.ss.end->where);
+	  return FAILURE;
+	}
     }
 
   return SUCCESS;
@@ -4016,7 +4028,7 @@ gfc_resolve_substring_charlen (gfc_expr *e)
   e->ts.cl->length = gfc_add (e->ts.cl->length, gfc_int_expr (1));
 
   e->ts.cl->length->ts.type = BT_INTEGER;
-  e->ts.cl->length->ts.kind = gfc_charlen_int_kind;;
+  e->ts.cl->length->ts.kind = gfc_charlen_int_kind;
 
   /* Make sure that the length is simplified.  */
   gfc_simplify_expr (e->ts.cl->length, 1);
@@ -4475,7 +4487,7 @@ gfc_resolve_character_operator (gfc_expr *e)
 
   e->ts.cl->length = gfc_add (e1, e2);
   e->ts.cl->length->ts.type = BT_INTEGER;
-  e->ts.cl->length->ts.kind = gfc_charlen_int_kind;;
+  e->ts.cl->length->ts.kind = gfc_charlen_int_kind;
   gfc_simplify_expr (e->ts.cl->length, 0);
   gfc_resolve_expr (e->ts.cl->length);
 
@@ -7383,7 +7395,7 @@ resolve_index_expr (gfc_expr *e)
 static gfc_try
 resolve_charlen (gfc_charlen *cl)
 {
-  int i;
+  int i, k;
 
   if (cl->resolved)
     return SUCCESS;
@@ -7407,6 +7419,16 @@ resolve_charlen (gfc_charlen *cl)
       gfc_replace_expr (cl->length, gfc_int_expr (0));
     }
 
+  /* Check that the character length is not too large.  */
+  k = gfc_validate_kind (BT_INTEGER, gfc_charlen_int_kind, false);
+  if (cl->length && cl->length->expr_type == EXPR_CONSTANT
+      && cl->length->ts.type == BT_INTEGER
+      && mpz_cmp (cl->length->value.integer, gfc_integer_kinds[k].huge) > 0)
+    {
+      gfc_error ("String length at %L is too large", &cl->length->where);
+      return FAILURE;
+    }
+
   return SUCCESS;
 }
 
diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index 7be4671..68ebb56 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -2433,7 +2433,13 @@ gfc_simplify_len (gfc_expr *e, gfc_expr *kind)
     {
       result = gfc_constant_result (BT_INTEGER, k, &e->where);
       mpz_set_si (result->value.integer, e->value.character.length);
-      return range_check (result, "LEN");
+      if (gfc_range_check (result) == ARITH_OK)
+	return result;
+      else
+	{
+	  gfc_free_expr (result);
+	  return NULL;
+	}
     }
 
   if (e->ts.cl != NULL && e->ts.cl->length != NULL
@@ -2442,7 +2448,13 @@ gfc_simplify_len (gfc_expr *e, gfc_expr *kind)
     {
       result = gfc_constant_result (BT_INTEGER, k, &e->where);
       mpz_set (result->value.integer, e->ts.cl->length->value.integer);
-      return range_check (result, "LEN");
+      if (gfc_range_check (result) == ARITH_OK)
+	return result;
+      else
+	{
+	  gfc_free_expr (result);
+	  return NULL;
+	}
     }
 
   return NULL;