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

re PR fortran/19777 (-fbounds-check catches non-existent bounds violation)

	PR fortran/19777

	* trans-array.c (gfc_conv_array_ref): Perform out-of-bounds
	checking for assumed-size arrrays for all but the last dimension.

	* gfortran.dg/bounds_check_2.f: Add new check for multidimensional
	arrays.

From-SVN: r114210
parent 944caafc
2006-05-29 Francois-Xavier Coudert <coudert@clipper.ens.fr> 2006-05-29 Francois-Xavier Coudert <coudert@clipper.ens.fr>
PR fortran/19777
* trans-array.c (gfc_conv_array_ref): Perform out-of-bounds
checking for assumed-size arrrays for all but the last dimension.
2006-05-29 Francois-Xavier Coudert <coudert@clipper.ens.fr>
* invoke.texi: Change -fpackderived into -fpack-derived. * invoke.texi: Change -fpackderived into -fpack-derived.
2006-05-29 Kazu Hirata <kazu@codesourcery.com> 2006-05-29 Kazu Hirata <kazu@codesourcery.com>
......
...@@ -1783,7 +1783,7 @@ gfc_trans_array_bound_check (gfc_se * se, tree descriptor, tree index, int n) ...@@ -1783,7 +1783,7 @@ gfc_trans_array_bound_check (gfc_se * se, tree descriptor, tree index, int n)
cond = fold_build2 (GT_EXPR, boolean_type_node, index, tmp); cond = fold_build2 (GT_EXPR, boolean_type_node, index, tmp);
fault = fold_build2 (TRUTH_OR_EXPR, boolean_type_node, fault, cond); fault = fold_build2 (TRUTH_OR_EXPR, boolean_type_node, fault, cond);
gfc_trans_runtime_check (fault, gfc_strconst_fault, &se->pre); gfc_trans_runtime_check (fault, gfc_msg_fault, &se->pre);
return index; return index;
} }
...@@ -1948,7 +1948,8 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar) ...@@ -1948,7 +1948,8 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar)
gfc_conv_expr_type (&indexse, ar->start[n], gfc_array_index_type); gfc_conv_expr_type (&indexse, ar->start[n], gfc_array_index_type);
gfc_add_block_to_block (&se->pre, &indexse.pre); gfc_add_block_to_block (&se->pre, &indexse.pre);
if (flag_bounds_check && ar->as->type != AS_ASSUMED_SIZE) if (flag_bounds_check &&
(ar->as->type != AS_ASSUMED_SIZE || n < ar->dimen - 1))
{ {
/* Check array bounds. */ /* Check array bounds. */
tree cond; tree cond;
...@@ -1978,7 +1979,7 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar) ...@@ -1978,7 +1979,7 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar)
} }
if (flag_bounds_check) if (flag_bounds_check)
gfc_trans_runtime_check (fault, gfc_strconst_fault, &se->pre); gfc_trans_runtime_check (fault, gfc_msg_fault, &se->pre);
tmp = gfc_conv_array_offset (se->expr); tmp = gfc_conv_array_offset (se->expr);
if (!integer_zerop (tmp)) if (!integer_zerop (tmp))
...@@ -2519,7 +2520,7 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop) ...@@ -2519,7 +2520,7 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop)
size[n] = gfc_evaluate_now (tmp, &block); size[n] = gfc_evaluate_now (tmp, &block);
} }
} }
gfc_trans_runtime_check (fault, gfc_strconst_bounds, &block); gfc_trans_runtime_check (fault, gfc_msg_bounds, &block);
tmp = gfc_finish_block (&block); tmp = gfc_finish_block (&block);
gfc_add_expr_to_block (&loop->pre, tmp); gfc_add_expr_to_block (&loop->pre, tmp);
...@@ -3714,7 +3715,7 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, tree body) ...@@ -3714,7 +3715,7 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, tree body)
stride2 = build2 (MINUS_EXPR, gfc_array_index_type, stride2 = build2 (MINUS_EXPR, gfc_array_index_type,
dubound, dlbound); dubound, dlbound);
tmp = fold_build2 (NE_EXPR, gfc_array_index_type, tmp, stride2); tmp = fold_build2 (NE_EXPR, gfc_array_index_type, tmp, stride2);
gfc_trans_runtime_check (tmp, gfc_strconst_bounds, &block); gfc_trans_runtime_check (tmp, gfc_msg_bounds, &block);
} }
} }
else else
......
2006-05-29 Francois-Xavier Coudert <coudert@clipper.ens.fr>
PR fortran/19777
* gfortran.dg/bounds_check_2.f: Add new check for multidimensional
arrays.
2006-05-29 Volker Reichelt <reichelt@igpm.rwth-aachen.de> 2006-05-29 Volker Reichelt <reichelt@igpm.rwth-aachen.de>
PR c++/27713 PR c++/27713
...@@ -5,9 +5,12 @@ ...@@ -5,9 +5,12 @@
integer npts integer npts
parameter (npts=10) parameter (npts=10)
double precision v(npts) double precision v(npts)
double precision w(npts,npts,npts)
external init1 external init1
external init2
call init1 (npts, v) call init1 (npts, v)
call init2 (npts, w)
end end
subroutine init1 (npts, v) subroutine init1 (npts, v)
...@@ -21,3 +24,16 @@ ...@@ -21,3 +24,16 @@
v(i) = 0 v(i) = 0
10 continue 10 continue
end end
subroutine init2 (npts, w)
implicit none
integer npts
double precision w(npts,npts,*)
integer i
do 20 i = 1, npts
w(i,1,1) = 0
w(1,npts,i) = 0
20 continue
end
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