* 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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@147619
138bc75d-0d04-0410-961f-
82ee72b054a4
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.
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)
&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;
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);
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);
static gfc_try
resolve_charlen (gfc_charlen *cl)
{
- int i;
+ int i, k;
if (cl->resolved)
return SUCCESS;
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;
}
{
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
{
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;
+2009-05-16 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
+
+ PR fortran/31243
+ * 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.
+
2009-05-16 David Billinghurst <billingd@gcc.gnu.org>
* gfortran.dg/default_format_denormal_1.f90: XFAIL on cygwin.
--- /dev/null
+! { dg-do compile }
+!
+program main
+ implicit none
+ integer(kind=8), parameter :: l1 = 2_8**32_8
+ character (len=2_8**32_8+4_8), parameter :: s = "" ! { dg-error "too large" }
+ character (len=2_8**32_8+4_8) :: ch ! { dg-error "too large" }
+ character (len=l1 + 1_8) :: v ! { dg-error "too large" }
+ character (len=int(huge(0_4),kind=8) + 1_8) :: z ! { dg-error "too large" }
+ character (len=int(huge(0_4),kind=8) + 0_8) :: w
+
+ print *, len(s)
+
+end program main
--- /dev/null
+! { dg-do compile }
+!
+program main
+ implicit none
+ character(len=10) :: s
+
+ s = ''
+ print *, s(1:2_8**32_8+3_8) ! { dg-error "exceeds the string length" }
+ print *, s(2_8**32_8+3_8:2_8**32_8+4_8) ! { dg-error "exceeds the string length" }
+ print *, len(s(1:2_8**32_8+3_8)) ! { dg-error "exceeds the string length" }
+
+end program main
--- /dev/null
+! { dg-do compile }
+!
+subroutine foo(i)
+ implicit none
+ integer, intent(in) :: i
+ character(len=i) :: s
+
+ s = ''
+ print *, s(1:2_8**32_8+3_8) ! { dg-error "too large" }
+ print *, s(2_8**32_8+3_8:2_8**32_8+4_8) ! { dg-error "too large" }
+ print *, len(s(1:2_8**32_8+3_8)) ! { dg-error "too large" }
+ print *, len(s(2_8**32_8+3_8:2_8**32_8+4_8)) ! { dg-error "too large" }
+
+ print *, s(2_8**32_8+3_8:1)
+ print *, s(2_8**32_8+4_8:2_8**32_8+3_8)
+ print *, len(s(2_8**32_8+3_8:1))
+ print *, len(s(2_8**32_8+4_8:2_8**32_8+3_8))
+
+end subroutine