OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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
This commit is contained in:
Tobias Burnus 2009-03-28 22:39:26 +01:00
parent 63f90eb7b0
commit 33abc84546
9 changed files with 150 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
gcc/fortran/ChangeLog
View File

@ -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>

6
gcc/fortran/invoke.texi
View File

@ -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}.

4
gcc/fortran/options.c
View File

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

46
gcc/fortran/trans-stmt.c
View File

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

8
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,11 @@
2009-03-28 Tobias Burnus <burnus@net-b.de>
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 <jh@suse.cz>
* gcc.dg/attr-noinline.c: Avoid pure-const optimization.

16
gcc/testsuite/gfortran.dg/do_check_1.f90 Normal file
View File

@ -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" }

20
gcc/testsuite/gfortran.dg/do_check_2.f90 Normal file
View File

@ -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" }

22
gcc/testsuite/gfortran.dg/do_check_3.f90 Normal file
View File

@ -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" }

21
gcc/testsuite/gfortran.dg/do_check_4.f90 Normal file
View File

@ -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" }