From a90552d5640745659ced7aca0d285a61da3b11ff Mon Sep 17 00:00:00 2001 From: Francois-Xavier Coudert Date: Sat, 14 Jul 2007 23:59:00 +0000 Subject: [PATCH] re PR fortran/32036 (Multiple evaluation of array index with bounds checking) PR fortran/32036 * trans-array.c (gfc_conv_array_ref): Only evaluate index once. * gfortran.dg/bounds_check_8.f90: New test. * gfortran.dg/do_iterator_2.f90: Make code legal Fortran. From-SVN: r126647 --- gcc/fortran/ChangeLog | 5 +++ gcc/fortran/trans-array.c | 3 ++ gcc/testsuite/ChangeLog | 6 +++ gcc/testsuite/gfortran.dg/bounds_check_8.f90 | 44 ++++++++++++++++++++ gcc/testsuite/gfortran.dg/do_iterator_2.f90 | 6 +-- 5 files changed, 61 insertions(+), 3 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/bounds_check_8.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 1493c65ec4d..9f8a27cfc10 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,8 @@ +2007-07-15 Francois-Xavier Coudert + + PR fortran/32036 + * trans-array.c (gfc_conv_array_ref): Only evaluate index once. + 2007-07-15 Francois-Xavier Coudert PR fortran/32357 diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 8a2365813ba..16f95777ee7 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -2278,6 +2278,9 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_symbol * sym, tree cond; char *msg; + /* Evaluate the indexse.expr only once. */ + indexse.expr = save_expr (indexse.expr); + /* Lower bound. */ tmp = gfc_conv_array_lbound (se->expr, n); cond = fold_build2 (LT_EXPR, boolean_type_node, diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 61b29245548..97e883694dc 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2007-07-15 Francois-Xavier Coudert + + PR fortran/32036 + * gfortran.dg/bounds_check_8.f90: New test. + * gfortran.dg/do_iterator_2.f90: Make code legal Fortran. + 2007-07-15 Francois-Xavier Coudert PR fortran/32357 diff --git a/gcc/testsuite/gfortran.dg/bounds_check_8.f90 b/gcc/testsuite/gfortran.dg/bounds_check_8.f90 new file mode 100644 index 00000000000..c9d8855d39d --- /dev/null +++ b/gcc/testsuite/gfortran.dg/bounds_check_8.f90 @@ -0,0 +1,44 @@ +! { dg-do run } +! { dg-options "-fbounds-check" } +! PR fortran/32036 +program test + type t + integer, dimension (5) :: field + end type t + type (t), dimension (2) :: a + integer :: calls + + type xyz_type + integer :: x + end type xyz_type + type (xyz_type), dimension(3) :: xyz + character(len=20) :: s + + xyz(1)%x = 11111 + xyz(2)%x = 0 + xyz(3)%x = 0 + + write(s,*) xyz(bar()) + if (trim(adjustl(s)) /= "11111") call abort + + a(1)%field = 0 + a(2)%field = 0 + calls = 0 + if (sum(a(foo(calls))%field) /= 0) call abort + if (calls .ne. 1) call abort + +contains + + function foo (calls) + integer :: calls, foo + calls = calls + 1 + foo = 2 + end function foo + + integer function bar () + integer, save :: i = 1 + bar = i + i = i + 1 + end function + +end program test diff --git a/gcc/testsuite/gfortran.dg/do_iterator_2.f90 b/gcc/testsuite/gfortran.dg/do_iterator_2.f90 index 58b65f33f5f..38f59b5e034 100644 --- a/gcc/testsuite/gfortran.dg/do_iterator_2.f90 +++ b/gcc/testsuite/gfortran.dg/do_iterator_2.f90 @@ -16,8 +16,8 @@ subroutine something i = 1 n = 5 line = 'PZ0R1' - if (internal (0)) call abort () - if (m .ne. 5) call abort () + if (internal (1)) call abort () + if (m .ne. 4) call abort () contains logical function internal (j) intent(in) j @@ -25,7 +25,7 @@ contains k = index ('RE', lit (i)) m = m + 1 if (k == 0) cycle - if (i+1 == n) exit + if (i + 1 == n) exit enddo internal = (k == 0) end function -- 2.30.2