diff options
author | Tobias Burnus <burnus@gcc.gnu.org> | 2009-03-28 22:39:26 +0100 |
---|---|---|
committer | Tobias Burnus <burnus@gcc.gnu.org> | 2009-03-28 22:39:26 +0100 |
commit | 33abc8454687da28c851b1089b7540a3669c3548 (patch) | |
tree | 035dde6bb8193a46fa1d35b8af11978d76676b9d /gcc/fortran | |
parent | 63f90eb7b0a70009743f7bb0035de2c956add767 (diff) | |
download | gcc-33abc8454687da28c851b1089b7540a3669c3548.zip gcc-33abc8454687da28c851b1089b7540a3669c3548.tar.gz gcc-33abc8454687da28c851b1089b7540a3669c3548.tar.bz2 |
re PR fortran/34656 (modifies do loop variable)
2009-03-28 Tobias Burnus <burnus@net-b.de>
PR fortran/34656
* trans-stmt.c (gfc_trans_simple_do, gfc_trans_do):
Add GFC_RTCHECK_DO support.
* option.c (gfc_handle_runtime_check_option): Enable
* GFC_RTCHECK_DO.
* invoke.texi (-fcheck): Document "do" option.
From-SVN: r145210
Diffstat (limited to 'gcc/fortran')
-rw-r--r-- | gcc/fortran/ChangeLog | 12 | ||||
-rw-r--r-- | gcc/fortran/invoke.texi | 6 | ||||
-rw-r--r-- | gcc/fortran/options.c | 4 | ||||
-rw-r--r-- | gcc/fortran/trans-stmt.c | 46 |
4 files changed, 63 insertions, 5 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 47ebdce..d063295 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,7 +1,15 @@ +2009-03-28 Tobias Burnus <burnus@net-b.de> + + PR fortran/34656 + * trans-stmt.c (gfc_trans_simple_do, gfc_trans_do): + Add GFC_RTCHECK_DO support. + * option.c (gfc_handle_runtime_check_option): Enable GFC_RTCHECK_DO. + * invoke.texi (-fcheck): Document "do" option. + 2009-03-28 Paul Thomas <pault@gcc.gnu.org> - PR fortran/38538 - * trans-array.c (get_elemental_fcn_charlen): Remove. + PR fortran/38538 + * trans-array.c (get_elemental_fcn_charlen): Remove. (get_array_charlen): New function to replace previous. 2009-03-28 Paul Thomas <pault@gcc.gnu.org> diff --git a/gcc/fortran/invoke.texi b/gcc/fortran/invoke.texi index 9eb5de1..a263a15 100644 --- a/gcc/fortran/invoke.texi +++ b/gcc/fortran/invoke.texi @@ -5,7 +5,7 @@ @ignore @c man begin COPYRIGHT -Copyright @copyright{} 2004, 2005, 2006, 2007, 2008 +Copyright @copyright{} 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. Permission is granted to copy, distribute and/or modify this document @@ -1221,6 +1221,10 @@ the compilation of the main program. Note: In the future this may also include other forms of checking, e.g., checking substring references. +@item @samp{do} +Enable generation of run-time checks for invalid modification of loop +iteration variables. + @item @samp{recursion} Enable generation of run-time checks for recursively called subroutines and functions which are not marked as recursive. See also @option{-frecursive}. diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c index fd9fb88..587fb36 100644 --- a/gcc/fortran/options.c +++ b/gcc/fortran/options.c @@ -458,10 +458,10 @@ gfc_handle_runtime_check_option (const char *arg) { int result, pos = 0, n; static const char * const optname[] = { "all", "bounds", "array-temps", - "recursion", /* "do", */ NULL }; + "recursion", "do", NULL }; static const int optmask[] = { GFC_RTCHECK_ALL, GFC_RTCHECK_BOUNDS, GFC_RTCHECK_ARRAY_TEMPS, - GFC_RTCHECK_RECURSION, /* GFC_RTCHECK_DO, */ + GFC_RTCHECK_RECURSION, GFC_RTCHECK_DO, 0 }; while (*arg) diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index 3937e2a..0e51bda 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -761,6 +761,7 @@ gfc_trans_simple_do (gfc_code * code, stmtblock_t *pblock, tree dovar, tree type; tree cond; tree tmp; + tree saved_dovar = NULL; tree cycle_label; tree exit_label; @@ -768,6 +769,13 @@ gfc_trans_simple_do (gfc_code * code, stmtblock_t *pblock, tree dovar, /* Initialize the DO variable: dovar = from. */ gfc_add_modify (pblock, dovar, from); + + /* Save value for do-tinkering checking. */ + if (gfc_option.rtcheck & GFC_RTCHECK_DO) + { + saved_dovar = gfc_create_var (type, ".saved_dovar"); + gfc_add_modify (pblock, saved_dovar, dovar); + } /* Cycle and exit statements are implemented with gotos. */ cycle_label = gfc_build_label_decl (NULL_TREE); @@ -790,6 +798,14 @@ gfc_trans_simple_do (gfc_code * code, stmtblock_t *pblock, tree dovar, gfc_add_expr_to_block (&body, tmp); } + /* Check whether someone has modified the loop variable. */ + if (gfc_option.rtcheck & GFC_RTCHECK_DO) + { + tmp = fold_build2 (NE_EXPR, boolean_type_node, dovar, saved_dovar); + gfc_trans_runtime_check (true, false, tmp, &body, &code->loc, + "Loop variable has been modified"); + } + /* Evaluate the loop condition. */ cond = fold_build2 (EQ_EXPR, boolean_type_node, dovar, to); cond = gfc_evaluate_now (cond, &body); @@ -798,6 +814,9 @@ gfc_trans_simple_do (gfc_code * code, stmtblock_t *pblock, tree dovar, tmp = fold_build2 (PLUS_EXPR, type, dovar, step); gfc_add_modify (&body, dovar, tmp); + if (gfc_option.rtcheck & GFC_RTCHECK_DO) + gfc_add_modify (&body, saved_dovar, dovar); + /* The loop exit. */ tmp = build1_v (GOTO_EXPR, exit_label); TREE_USED (exit_label) = 1; @@ -864,6 +883,7 @@ gfc_trans_do (gfc_code * code) { gfc_se se; tree dovar; + tree saved_dovar = NULL; tree from; tree to; tree step; @@ -902,6 +922,14 @@ gfc_trans_do (gfc_code * code) gfc_add_block_to_block (&block, &se.pre); step = gfc_evaluate_now (se.expr, &block); + if (gfc_option.rtcheck & GFC_RTCHECK_DO) + { + tmp = fold_build2 (EQ_EXPR, boolean_type_node, step, + fold_convert (type, integer_zero_node)); + gfc_trans_runtime_check (true, false, tmp, &block, &code->loc, + "DO step value is zero"); + } + /* Special case simple loops. */ if (TREE_CODE (type) == INTEGER_TYPE && (integer_onep (step) @@ -925,6 +953,13 @@ gfc_trans_do (gfc_code * code) /* Initialize the DO variable: dovar = from. */ gfc_add_modify (&block, dovar, from); + /* Save value for do-tinkering checking. */ + if (gfc_option.rtcheck & GFC_RTCHECK_DO) + { + saved_dovar = gfc_create_var (type, ".saved_dovar"); + gfc_add_modify (&block, saved_dovar, dovar); + } + /* Initialize loop count and jump to exit label if the loop is empty. This code is executed before we enter the loop body. We generate: if (step > 0) @@ -1011,10 +1046,21 @@ gfc_trans_do (gfc_code * code) gfc_add_expr_to_block (&body, tmp); } + /* Check whether someone has modified the loop variable. */ + if (gfc_option.rtcheck & GFC_RTCHECK_DO) + { + tmp = fold_build2 (NE_EXPR, boolean_type_node, dovar, saved_dovar); + gfc_trans_runtime_check (true, false, tmp, &body, &code->loc, + "Loop variable has been modified"); + } + /* Increment the loop variable. */ tmp = fold_build2 (PLUS_EXPR, type, dovar, step); gfc_add_modify (&body, dovar, tmp); + if (gfc_option.rtcheck & GFC_RTCHECK_DO) + gfc_add_modify (&body, saved_dovar, dovar); + /* End with the loop condition. Loop until countm1 == 0. */ cond = fold_build2 (EQ_EXPR, boolean_type_node, countm1, build_int_cst (utype, 0)); |