This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[gfortran,patch] Bounds-checking for lower bound of last dimension of assumed-size array
- From: "François-Xavier Coudert" <fxcoudert at gmail dot com>
- To: gfortran <fortran at gcc dot gnu dot org>, gcc-patches <gcc-patches at gcc dot gnu dot org>
- Date: Mon, 7 May 2007 17:13:10 +0200
- Subject: [gfortran,patch] Bounds-checking for lower bound of last dimension of assumed-size array
Hi all,
This is probably these few days' series of patches that I submitted to
clear the backlog of patches and bits accumulated in my trees during
these last months. I'll be working next on clearing the backlog for
reviews (so that you can review my patches!). I'm aware of two
unreviewed patches by Paul (for PR31692 and PR31630), but if you have
unreviewed patches that aren't on my radar, don't be afraid to send me
a private ping-ing mail!
This patch fixes PR31627, where we don't check at runtime (with
-fbounds-check) that the lower bound of the last dimension of an
assumed-size array is not exceeded. In fact, as far as checking goes,
the last dimension of assumed-size arrays was completely ignored. This
patch enables checking for the lower bound, while still not checking
the upper bound (which, by definition, is not known).
Bootstrapped && regtested on i686-linux, both without and with
-fbounds-check (no failure introduced by the patch, when running with
-fbounds-check[1]). OK for mainline?
FX
[1] I noticed three unrelated failures when running the testsuite with
-fbounds-check (for der_io.f90, pr19928-2.f90 and pr25603.f). I will
soon submit bug reports for those.
:ADDPATCH fortran:
2007-05-07 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
PR fortran/31627
* trans-array.c (gfc_trans_array_bound_check): Take extra argument to
indicate whether we should check the upper bound in that dimension.
(gfc_conv_array_index_offset): Check only the lower bound of the
last dimension for assumed-size arrays.
(gfc_conv_array_ref): Likewise.
(gfc_conv_ss_startstride): Likewise.
2007-05-07 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
PR fortran/31627
* gfortran.dg/bounds_check_7.f90: New test.
Index: trans-array.c
===================================================================
--- trans-array.c (revision 124285)
+++ trans-array.c (working copy)
@@ -1994,7 +1994,7 @@ gfc_conv_array_ubound (tree descriptor,
static tree
gfc_trans_array_bound_check (gfc_se * se, tree descriptor, tree index, int n,
- locus * where)
+ locus * where, bool check_upper)
{
tree fault;
tree tmp;
@@ -2047,16 +2047,19 @@ gfc_trans_array_bound_check (gfc_se * se
gfc_free (msg);
/* Check upper bound. */
- tmp = gfc_conv_array_ubound (descriptor, n);
- fault = fold_build2 (GT_EXPR, boolean_type_node, index, tmp);
- if (name)
- asprintf (&msg, "%s for array '%s', upper bound of dimension %d exceeded",
- gfc_msg_fault, name, n+1);
- else
- asprintf (&msg, "%s, upper bound of dimension %d exceeded",
- gfc_msg_fault, n+1);
- gfc_trans_runtime_check (fault, msg, &se->pre, where);
- gfc_free (msg);
+ if (check_upper)
+ {
+ tmp = gfc_conv_array_ubound (descriptor, n);
+ fault = fold_build2 (GT_EXPR, boolean_type_node, index, tmp);
+ if (name)
+ asprintf (&msg, "%s for array '%s', upper bound of dimension %d "
+ " exceeded", gfc_msg_fault, name, n+1);
+ else
+ asprintf (&msg, "%s, upper bound of dimension %d exceeded",
+ gfc_msg_fault, n+1);
+ gfc_trans_runtime_check (fault, msg, &se->pre, where);
+ gfc_free (msg);
+ }
return index;
}
@@ -2090,7 +2093,9 @@ gfc_conv_array_index_offset (gfc_se * se
if ((ar->as->type != AS_ASSUMED_SIZE && !ar->as->cp_was_assumed)
|| dim < ar->dimen - 1)
index = gfc_trans_array_bound_check (se, info->descriptor,
- index, dim, &ar->where);
+ index, dim, &ar->where,
+ (ar->as->type != AS_ASSUMED_SIZE
+ && !ar->as->cp_was_assumed) || dim < ar->dimen - 1);
break;
case DIMEN_VECTOR:
@@ -2116,7 +2121,9 @@ gfc_conv_array_index_offset (gfc_se * se
if ((ar->as->type != AS_ASSUMED_SIZE && !ar->as->cp_was_assumed)
|| dim < ar->dimen - 1)
index = gfc_trans_array_bound_check (se, info->descriptor,
- index, dim, &ar->where);
+ index, dim, &ar->where,
+ (ar->as->type != AS_ASSUMED_SIZE
+ && !ar->as->cp_was_assumed) || dim < ar->dimen - 1);
break;
case DIMEN_RANGE:
@@ -2227,14 +2234,13 @@ gfc_conv_array_ref (gfc_se * se, gfc_arr
gfc_conv_expr_type (&indexse, ar->start[n], gfc_array_index_type);
gfc_add_block_to_block (&se->pre, &indexse.pre);
- if (flag_bounds_check &&
- ((ar->as->type != AS_ASSUMED_SIZE && !ar->as->cp_was_assumed)
- || n < ar->dimen - 1))
+ if (flag_bounds_check)
{
/* Check array bounds. */
tree cond;
char *msg;
+ /* Lower bound. */
tmp = gfc_conv_array_lbound (se->expr, n);
cond = fold_build2 (LT_EXPR, boolean_type_node,
indexse.expr, tmp);
@@ -2244,14 +2250,20 @@ gfc_conv_array_ref (gfc_se * se, gfc_arr
gfc_trans_runtime_check (cond, msg, &se->pre, where);
gfc_free (msg);
- tmp = gfc_conv_array_ubound (se->expr, n);
- cond = fold_build2 (GT_EXPR, boolean_type_node,
- indexse.expr, tmp);
- asprintf (&msg, "%s for array '%s', "
- "upper bound of dimension %d exceeded", gfc_msg_fault,
- sym->name, n+1);
- gfc_trans_runtime_check (cond, msg, &se->pre, where);
- gfc_free (msg);
+ /* Upper bound, but not for the last dimension of assumed-size
+ arrays. */
+ if (n < ar->dimen - 1
+ || (ar->as->type != AS_ASSUMED_SIZE && !ar->as->cp_was_assumed))
+ {
+ tmp = gfc_conv_array_ubound (se->expr, n);
+ cond = fold_build2 (GT_EXPR, boolean_type_node,
+ indexse.expr, tmp);
+ asprintf (&msg, "%s for array '%s', "
+ "upper bound of dimension %d exceeded", gfc_msg_fault,
+ sym->name, n+1);
+ gfc_trans_runtime_check (cond, msg, &se->pre, where);
+ gfc_free (msg);
+ }
}
/* Multiply the index by the stride. */
@@ -2786,22 +2798,18 @@ gfc_conv_ss_startstride (gfc_loopinfo *
dimensions are checked later. */
for (n = 0; n < loop->dimen; n++)
{
+ bool check_upper;
+
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;
-
- /* 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 = info->end[n];
+ check_upper = false;
+ else
+ check_upper = true;
/* Zero stride is not allowed. */
tmp = fold_build2 (EQ_EXPR, boolean_type_node, info->stride[n],
@@ -2812,6 +2820,18 @@ gfc_conv_ss_startstride (gfc_loopinfo *
gfc_trans_runtime_check (tmp, msg, &block, &ss->expr->where);
gfc_free (msg);
+ desc = ss->data.info.descriptor;
+
+ /* 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);
+ end = info->end[n];
+ if (check_upper)
+ ubound = gfc_conv_array_ubound (desc, dim);
+ else
+ ubound = NULL;
+
/* non_zerosized is true when the selected range is not
empty. */
stride_pos = fold_build2 (GT_EXPR, boolean_type_node,
@@ -2842,15 +2862,18 @@ gfc_conv_ss_startstride (gfc_loopinfo *
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_fault, info->dim[n]+1,
- ss->expr->symtree->name);
- gfc_trans_runtime_check (tmp, msg, &block, &ss->expr->where);
- gfc_free (msg);
+ if (check_upper)
+ {
+ 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)
@@ -2871,14 +2894,17 @@ gfc_conv_ss_startstride (gfc_loopinfo *
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);
+ if (check_upper)
+ {
+ 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);
+ }
/* Check the section sizes match. */
tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, end,
Index: gcc/testsuite/gfortran.dg/bounds_check_7.f90
===================================================================
--- gcc/testsuite/gfortran.dg/bounds_check_7.f90 (revision 0)
+++ gcc/testsuite/gfortran.dg/bounds_check_7.f90 (revision 0)
@@ -0,0 +1,15 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! { dg-shouldfail "Array reference out of bounds" }
+! PR fortran/31627
+subroutine foo(a)
+ integer a(*), i
+ i = 0
+ a(i) = 42 ! {
+end subroutine foo
+
+program test
+ integer x(42)
+ call foo(x)
+end program test
+! { dg-output "Array reference out of bounds .* lower bound of dimension 1 exceeded" }