From: Tobias Burnus Date: Sat, 28 Mar 2009 21:39:26 +0000 (+0100) Subject: re PR fortran/34656 (modifies do loop variable) X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=33abc8454687da28c851b1089b7540a3669c3548;p=platform%2Fupstream%2Fgcc.git re PR fortran/34656 (modifies do loop variable) 2009-03-28 Tobias Burnus 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 --- 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 + + 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 - 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 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)); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 7a870c2..ee2e360 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,11 @@ +2009-03-28 Tobias Burnus + + PR fortran/34656 + * gfortran.dg/do_check_1.f90: Add test. + * gfortran.dg/do_check_2.f90: Add test. + * gfortran.dg/do_check_3.f90: Add test. + * gfortran.dg/do_check_4.f90: Add test. + 2009-03-28 Jan Hubicka * gcc.dg/attr-noinline.c: Avoid pure-const optimization. diff --git a/gcc/testsuite/gfortran.dg/do_check_1.f90 b/gcc/testsuite/gfortran.dg/do_check_1.f90 new file mode 100644 index 0000000..94d8a84 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/do_check_1.f90 @@ -0,0 +1,16 @@ +! { dg-do run } +! { dg-options "-fcheck=do" } +! { dg-shouldfail "DO check" } +! +! PR fortran/34656 +! Run-time check for zero STEP +! +program test + implicit none + integer :: i,j + j = 0 + do i = 1, 40, j + print *, i + end do +end program test +! { dg-output "Fortran runtime error: DO step value is zero" } diff --git a/gcc/testsuite/gfortran.dg/do_check_2.f90 b/gcc/testsuite/gfortran.dg/do_check_2.f90 new file mode 100644 index 0000000..c40760d --- /dev/null +++ b/gcc/testsuite/gfortran.dg/do_check_2.f90 @@ -0,0 +1,20 @@ +! { dg-do run } +! { dg-options "-fcheck=do" } +! { dg-shouldfail "DO check" } +! +! PR fortran/34656 +! Run-time check for modifing loop variables +! +program test + implicit none + integer :: i,j + do i = 1, 10 + call modLoopVar(i) + end do +contains + subroutine modLoopVar(i) + integer :: i + i = i + 1 + end subroutine modLoopVar +end program test +! { dg-output "Fortran runtime error: Loop variable has been modified" } diff --git a/gcc/testsuite/gfortran.dg/do_check_3.f90 b/gcc/testsuite/gfortran.dg/do_check_3.f90 new file mode 100644 index 0000000..15086c2 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/do_check_3.f90 @@ -0,0 +1,22 @@ +! { dg-do run } +! { dg-options "-fcheck=do" } +! { dg-shouldfail "DO check" } +! +! PR fortran/34656 +! Run-time check for modifing loop variables +! +program test + implicit none + real :: i, j, k + j = 10.0 + k = 1.0 + do i = 1.0, j, k ! { dg-warning "must be integer" } + call modLoopVar(i) + end do +contains + subroutine modLoopVar(x) + real :: x + x = x + 1 + end subroutine modLoopVar +end program test +! { dg-output "Fortran runtime error: Loop variable has been modified" } diff --git a/gcc/testsuite/gfortran.dg/do_check_4.f90 b/gcc/testsuite/gfortran.dg/do_check_4.f90 new file mode 100644 index 0000000..65bc92c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/do_check_4.f90 @@ -0,0 +1,21 @@ +! { dg-do run } +! { dg-options "-fcheck=do" } +! { dg-shouldfail "DO check" } +! +! PR fortran/34656 +! Run-time check for modifing loop variables +! +PROGRAM test + IMPLICIT NONE + INTEGER :: i + DO i=1,100 + CALL do_something() + ENDDO +CONTAINS + SUBROUTINE do_something() + IMPLICIT NONE + DO i=1,10 + ENDDO + END SUBROUTINE do_something +END PROGRAM test +! { dg-output "Fortran runtime error: Loop variable has been modified" }