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;
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);
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);