From ef31fe62574cdc2b6e210c655377b7c161de225c Mon Sep 17 00:00:00 2001 From: Francois-Xavier Coudert Date: Fri, 16 Jun 2006 19:03:43 +0200 Subject: re PR fortran/27965 (invalid "Array bound mismatch" runtime error) 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 --- gcc/fortran/ChangeLog | 8 ++++ gcc/fortran/trans-array.c | 93 +++++++++++++++++++++++++++++++++++++++++------ 2 files changed, 89 insertions(+), 12 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index d94a748..8ac4cef 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2006-06-16 Francois-Xavier Coudert + + 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 * trans-array.h (gfc_trans_create_temp_array): Add bool diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index a8a8aa6..941e711 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -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); + /* 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); + + /* 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_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); - /* 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); + 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_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_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); @@ -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); -- cgit v1.1