diff options
Diffstat (limited to 'gcc/fortran/trans-expr.c')
| -rw-r--r-- | gcc/fortran/trans-expr.c | 37 |
1 files changed, 34 insertions, 3 deletions
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); } |