From 9482d0e53dad137e9a0fd63911216ff75dc64f0c Mon Sep 17 00:00:00 2001
From: fxcoudert <fxcoudert@138bc75d-0d04-0410-961f-82ee72b054a4>
Date: Fri, 16 Jun 2006 17:03:43 +0000
Subject: [PATCH] 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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@114724 138bc75d-0d04-0410-961f-82ee72b054a4
---
gcc/fortran/ChangeLog | 8 ++++
gcc/fortran/trans-array.c | 93 ++++++++++++++++++++++++++++++++++-----
2 files changed, 89 insertions(+), 12 deletions(-)
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index d94a7487c895..8ac4cef5c644 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -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
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index a8a8aa6d1203..941e7115281a 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);
--
GitLab