diff options
| author | Tobias Burnus <burnus@net-b.de> | 2006-11-15 11:13:16 +0100 |
|---|---|---|
| committer | Tobias Burnus <burnus@gcc.gnu.org> | 2006-11-15 11:13:16 +0100 |
| commit | 65713e5bcc306e08a6d5e63a7ffeba90170b6b36 (patch) | |
| tree | bbc3008260eb8144684b57875d8190b3ae8b0001 | |
| parent | 8c894ae273073a4a45cd37be4ee2b06c35c40dd6 (diff) | |
| download | gcc-65713e5bcc306e08a6d5e63a7ffeba90170b6b36.zip gcc-65713e5bcc306e08a6d5e63a7ffeba90170b6b36.tar.gz gcc-65713e5bcc306e08a6d5e63a7ffeba90170b6b36.tar.bz2 | |
re PR fortran/27588 (-fbounds-check should catch substring out of range accesses)
fortran/
2006-11-15 Tobias Burnus <burnus@net-b.de>
Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
PR fortran/27588
* trans-expr.c (gfc_conv_substring): Add bounds checking.
(gfc_conv_variable, gfc_conv_substring_expr): Pass more
arguments to gfc_conv_substring.
testsuite/
2006-11-15 Tobias Burnus <burnus@net-b.de>
PR fortran/27588
* gfortran.dg/char_bounds_check_fail_1.f90: New test.
Co-Authored-By: Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
From-SVN: r118852
| -rw-r--r-- | gcc/fortran/ChangeLog | 8 | ||||
| -rw-r--r-- | gcc/fortran/trans-expr.c | 37 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 5 |
3 files changed, 47 insertions, 3 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 4486399..ea2d741 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,4 +1,12 @@ 2006-11-15 Tobias Burnus <burnus@net-b.de> + Francois-Xavier Coudert <fxcoudert@gcc.gnu.org> + + PR fortran/27588 + * trans-expr.c (gfc_conv_substring): Add bounds checking. + (gfc_conv_variable, gfc_conv_substring_expr): Pass more + arguments to gfc_conv_substring. + +2006-11-15 Tobias Burnus <burnus@net-b.de> PR fortran/29806 * parse.c (parse_contained): Check for empty contains statement. diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 6d8b8b9..984c6d3 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -234,13 +234,16 @@ gfc_trans_init_string_length (gfc_charlen * cl, stmtblock_t * pblock) static void -gfc_conv_substring (gfc_se * se, gfc_ref * ref, int kind) +gfc_conv_substring (gfc_se * se, gfc_ref * ref, int kind, + const char *name, locus *where) { tree tmp; tree type; tree var; + tree fault; gfc_se start; gfc_se end; + char *msg; type = gfc_get_character_type (kind, ref->u.ss.length); type = build_pointer_type (type); @@ -272,6 +275,33 @@ gfc_conv_substring (gfc_se * se, gfc_ref * ref, int kind) gfc_conv_expr_type (&end, ref->u.ss.end, gfc_charlen_type_node); gfc_add_block_to_block (&se->pre, &end.pre); } + if (flag_bounds_check) + { + /* Check lower bound. */ + fault = fold_build2 (LT_EXPR, boolean_type_node, start.expr, + build_int_cst (gfc_charlen_type_node, 1)); + if (name) + asprintf (&msg, "Substring out of bounds: lower bound of '%s' " + "is less than one", name); + else + asprintf (&msg, "Substring out of bounds: lower bound " + "is less than one"); + gfc_trans_runtime_check (fault, msg, &se->pre, where); + gfc_free (msg); + + /* Check upper bound. */ + fault = fold_build2 (GT_EXPR, boolean_type_node, end.expr, + se->string_length); + if (name) + asprintf (&msg, "Substring out of bounds: upper bound of '%s' " + "exceeds string length", name); + else + asprintf (&msg, "Substring out of bounds: upper bound " + "exceeds string length"); + gfc_trans_runtime_check (fault, msg, &se->pre, where); + gfc_free (msg); + } + tmp = fold_build2 (MINUS_EXPR, gfc_charlen_type_node, build_int_cst (gfc_charlen_type_node, 1), start.expr); @@ -485,7 +515,8 @@ gfc_conv_variable (gfc_se * se, gfc_expr * expr) break; case REF_SUBSTRING: - gfc_conv_substring (se, ref, expr->ts.kind); + gfc_conv_substring (se, ref, expr->ts.kind, + expr->symtree->name, &expr->where); break; default: @@ -2958,7 +2989,7 @@ gfc_conv_substring_expr (gfc_se * se, gfc_expr * expr) se->string_length = TYPE_MAX_VALUE (TYPE_DOMAIN (TREE_TYPE (se->expr))); TYPE_STRING_FLAG (TREE_TYPE (se->expr))=1; - gfc_conv_substring(se,ref,expr->ts.kind); + gfc_conv_substring(se,ref,expr->ts.kind,NULL,&expr->where); } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 0288e55..c485ed6 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,5 +1,10 @@ 2006-11-15 Tobias Burnus <burnus@net-b.de> + PR fortran/27588 + * gfortran.dg/char_bounds_check_fail_1.f90: New test. + +2006-11-15 Tobias Burnus <burnus@net-b.de> + PR fortran/29806 * gfortran.dg/contains.f90: New test. * gfortran.dg/derived_function_interface_1.f90: Add a dg-warning. |