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
This commit is contained in:
parent
3705841503
commit
a90552d564
5 changed files with 61 additions and 3 deletions
|
@ -1,3 +1,8 @@
|
|||
2007-07-15 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
|
||||
|
||||
PR fortran/32036
|
||||
* trans-array.c (gfc_conv_array_ref): Only evaluate index once.
|
||||
|
||||
2007-07-15 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
|
||||
|
||||
PR fortran/32357
|
||||
|
|
|
@ -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,
|
||||
|
|
|
@ -1,3 +1,9 @@
|
|||
2007-07-15 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
|
||||
|
||||
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 <fxcoudert@gcc.gnu.org>
|
||||
|
||||
PR fortran/32357
|
||||
|
|
44
gcc/testsuite/gfortran.dg/bounds_check_8.f90
Normal file
44
gcc/testsuite/gfortran.dg/bounds_check_8.f90
Normal file
|
@ -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
|
|
@ -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
|
||||
|
|
Loading…
Add table
Reference in a new issue