mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-05 13:51:00 +08:00
Code Issues Packages Projects Releases Wiki Activity

re PR fortran/27588 (-fbounds-check should catch substring out of range accesses)

Browse Source 
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
This commit is contained in:
Tobias Burnus 2006-11-15 11:13:16 +01:00 committed by Tobias Burnus
parent 8c894ae273
commit 65713e5bcc
3 changed files with 47 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
gcc/fortran/ChangeLog
View File

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

37
gcc/fortran/trans-expr.c
View File

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

5
gcc/testsuite/ChangeLog
View File

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