FreeChainXenon/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

re PR fortran/27965 (invalid "Array bound mismatch" runtime error)

Browse source 
PR fortran/27965
	* trans-array.c (gfc_conv_ss_startstride): Correct the runtime
	conditions for bounds-checking. Check for nonzero stride.
	Don't check the last dimension of assumed-size arrays. Fix the
	dimension displayed in the error message.

From-SVN: r114724
This commit is contained in:
Francois-Xavier Coudert 2006-06-16 19:03:43 +02:00 • committed by François-Xavier Coudert
parent 1af8dcbf0b
commit ef31fe6257
2 changed files with 90 additions and 13 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
gcc/fortran/ChangeLog
View file

@ -1,3 +1,11 @@
2006-06-16 Francois-Xavier Coudert <coudert@clipper.ens.fr>
PR fortran/27965
* trans-array.c (gfc_conv_ss_startstride): Correct the runtime
conditions for bounds-checking. Check for nonzero stride.
Don't check the last dimension of assumed-size arrays. Fix the
dimension displayed in the error message.
2006-06-15 Thomas Koenig <Thomas.Koenig@online.de>
* trans-array.h (gfc_trans_create_temp_array): Add bool

95
gcc/fortran/trans-array.c
View file

@ -2524,9 +2524,10 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop)
if (flag_bounds_check)
{
stmtblock_t block;
tree bound;
tree lbound, ubound;
tree end;
tree size[GFC_MAX_DIMENSIONS];
tree stride_pos, stride_neg, non_zerosized, tmp2;
gfc_ss_info *info;
char *msg;
int dim;
@ -2551,25 +2552,93 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop)
dim = info->dim[n];
if (info->ref->u.ar.dimen_type[dim] != DIMEN_RANGE)
continue;
if (n == info->ref->u.ar.dimen - 1
&& (info->ref->u.ar.as->type == AS_ASSUMED_SIZE
|| info->ref->u.ar.as->cp_was_assumed))
continue;
desc = ss->data.info.descriptor;
/* Check lower bound. */
bound = gfc_conv_array_lbound (desc, dim);
tmp = info->start[n];
tmp = fold_build2 (LT_EXPR, boolean_type_node, tmp, bound);
asprintf (&msg, "%s, lower bound of dimension %d of array '%s'"
" exceeded", gfc_msg_bounds, n+1,
/* This is the run-time equivalent of resolve.c's
check_dimension(). The logical is more readable there
than it is here, with all the trees. */
lbound = gfc_conv_array_lbound (desc, dim);
ubound = gfc_conv_array_ubound (desc, dim);
end = gfc_conv_section_upper_bound (ss, n, &block);
/* Zero stride is not allowed. */
tmp = fold_build2 (EQ_EXPR, boolean_type_node, info->stride[n],
gfc_index_zero_node);
asprintf (&msg, "Zero stride is not allowed, for dimension %d "
"of array '%s'", info->dim[n]+1,
ss->expr->symtree->name);
gfc_trans_runtime_check (tmp, msg, &block, &ss->expr->where);
gfc_free (msg);
/* Check the upper bound. */
bound = gfc_conv_array_ubound (desc, dim);
end = gfc_conv_section_upper_bound (ss, n, &block);
tmp = fold_build2 (GT_EXPR, boolean_type_node, end, bound);
/* non_zerosized is true when the selected range is not
empty. */
stride_pos = fold_build2 (GT_EXPR, boolean_type_node,
info->stride[n], gfc_index_zero_node);
tmp = fold_build2 (LE_EXPR, boolean_type_node, info->start[n],
end);
stride_pos = fold_build2 (TRUTH_AND_EXPR, boolean_type_node,
stride_pos, tmp);
stride_neg = fold_build2 (LT_EXPR, boolean_type_node,
info->stride[n], gfc_index_zero_node);
tmp = fold_build2 (GE_EXPR, boolean_type_node, info->start[n],
end);
stride_neg = fold_build2 (TRUTH_AND_EXPR, boolean_type_node,
stride_neg, tmp);
non_zerosized = fold_build2 (TRUTH_OR_EXPR, boolean_type_node,
stride_pos, stride_neg);
/* Check the start of the range against the lower and upper
bounds of the array, if the range is not empty. */
tmp = fold_build2 (LT_EXPR, boolean_type_node, info->start[n],
lbound);
tmp = fold_build2 (TRUTH_AND_EXPR, boolean_type_node,
non_zerosized, tmp);
asprintf (&msg, "%s, lower bound of dimension %d of array '%s'"
" exceeded", gfc_msg_fault, info->dim[n]+1,
ss->expr->symtree->name);
gfc_trans_runtime_check (tmp, msg, &block, &ss->expr->where);
gfc_free (msg);
tmp = fold_build2 (GT_EXPR, boolean_type_node, info->start[n],
ubound);
tmp = fold_build2 (TRUTH_AND_EXPR, boolean_type_node,
non_zerosized, tmp);
asprintf (&msg, "%s, upper bound of dimension %d of array '%s'"
" exceeded", gfc_msg_bounds, n+1,
" exceeded", gfc_msg_fault, info->dim[n]+1,
ss->expr->symtree->name);
gfc_trans_runtime_check (tmp, msg, &block, &ss->expr->where);
gfc_free (msg);
/* Compute the last element of the range, which is not
necessarily "end" (think 0:5:3, which doesn't contain 5)
and check it against both lower and upper bounds. */
tmp2 = fold_build2 (MINUS_EXPR, gfc_array_index_type, end,
info->start[n]);
tmp2 = fold_build2 (TRUNC_MOD_EXPR, gfc_array_index_type, tmp2,
info->stride[n]);
tmp2 = fold_build2 (MINUS_EXPR, gfc_array_index_type, end,
tmp2);
tmp = fold_build2 (LT_EXPR, boolean_type_node, tmp2, lbound);
tmp = fold_build2 (TRUTH_AND_EXPR, boolean_type_node,
non_zerosized, tmp);
asprintf (&msg, "%s, lower bound of dimension %d of array '%s'"
" exceeded", gfc_msg_fault, info->dim[n]+1,
ss->expr->symtree->name);
gfc_trans_runtime_check (tmp, msg, &block, &ss->expr->where);
gfc_free (msg);
tmp = fold_build2 (GT_EXPR, boolean_type_node, tmp2, ubound);
tmp = fold_build2 (TRUTH_AND_EXPR, boolean_type_node,
non_zerosized, tmp);
asprintf (&msg, "%s, upper bound of dimension %d of array '%s'"
" exceeded", gfc_msg_fault, info->dim[n]+1,
ss->expr->symtree->name);
gfc_trans_runtime_check (tmp, msg, &block, &ss->expr->where);
gfc_free (msg);
@ -2586,7 +2655,7 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop)
tmp =
fold_build2 (NE_EXPR, boolean_type_node, tmp, size[n]);
asprintf (&msg, "%s, size mismatch for dimension %d "
"of array '%s'", gfc_msg_bounds, n+1,
"of array '%s'", gfc_msg_bounds, info->dim[n]+1,
ss->expr->symtree->name);
gfc_trans_runtime_check (tmp, msg, &block, &ss->expr->where);
gfc_free (msg);