Commit a90552d5 by Francois-Xavier Coudert Committed by François-Xavier Coudert

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
parent 37058415
2007-07-15 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org> 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 PR fortran/32357
* iresolve.c (gfc_resolve_mvbits): Convert FROMPOS, LEN and TOPOS * iresolve.c (gfc_resolve_mvbits): Convert FROMPOS, LEN and TOPOS
to C int. to C int.
......
...@@ -2278,6 +2278,9 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_symbol * sym, ...@@ -2278,6 +2278,9 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_symbol * sym,
tree cond; tree cond;
char *msg; char *msg;
/* Evaluate the indexse.expr only once. */
indexse.expr = save_expr (indexse.expr);
/* Lower bound. */ /* Lower bound. */
tmp = gfc_conv_array_lbound (se->expr, n); tmp = gfc_conv_array_lbound (se->expr, n);
cond = fold_build2 (LT_EXPR, boolean_type_node, cond = fold_build2 (LT_EXPR, boolean_type_node,
......
2007-07-15 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org> 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 PR fortran/32357
* gfortran.dg/mvbits_2.f90: New test. * gfortran.dg/mvbits_2.f90: New test.
! { 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 ...@@ -16,8 +16,8 @@ subroutine something
i = 1 i = 1
n = 5 n = 5
line = 'PZ0R1' line = 'PZ0R1'
if (internal (0)) call abort () if (internal (1)) call abort ()
if (m .ne. 5) call abort () if (m .ne. 4) call abort ()
contains contains
logical function internal (j) logical function internal (j)
intent(in) j intent(in) j
...@@ -25,7 +25,7 @@ contains ...@@ -25,7 +25,7 @@ contains
k = index ('RE', lit (i)) k = index ('RE', lit (i))
m = m + 1 m = m + 1
if (k == 0) cycle if (k == 0) cycle
if (i+1 == n) exit if (i + 1 == n) exit
enddo enddo
internal = (k == 0) internal = (k == 0)
end function end function
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment