procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

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

Browse source 
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
This commit is contained in:
Francois-Xavier Coudert 2009-05-16 16:53:02 +00:00 • committed by François-Xavier Coudert
parent 1ab8a8c260
commit b0c068160f
7 changed files with 102 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

11
gcc/fortran/ChangeLog
View file

@ -1,3 +1,14 @@
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

28
gcc/fortran/resolve.c
View file

@ -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;
}

16
gcc/fortran/simplify.c
View file

@ -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;

7
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,10 @@
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.

14
gcc/testsuite/gfortran.dg/string_1.f90 Normal file
View file

@ -0,0 +1,14 @@
! { 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

12
gcc/testsuite/gfortran.dg/string_2.f90 Normal file
View file

@ -0,0 +1,12 @@
! { 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

19
gcc/testsuite/gfortran.dg/string_3.f90 Normal file
View file

@ -0,0 +1,19 @@
! { 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