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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index d94a748..8ac4cef 100644 (file)
--- 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 a8a8aa6..941e711 100644 (file)
--- 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);