From 1954a27b0c3d427a8fddeab6b089cbbe10f9f049 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Sun, 14 Oct 2007 22:24:20 +0200 Subject: [PATCH] re PR fortran/33745 (-fbounds-check: Bogus out-of-bounds run-time error for assumed-size array) 2007-10-14 Tobias Burnus PR fortran/33745 * trans-array.c (gfc_conv_ss_startstride): Fix dimension check. (gfc_trans_array_bound_check, gfc_conv_array_ref, gfc_conv_ss_startstride): Simplify error message. * resolve.c (check_dimension): Fix dimension-type switch; improve error message. 2007-10-14 Tobias Burnus PR fortran/33745 * gfortran.dg/bounds_check_11.f90: New. From-SVN: r129302 --- gcc/fortran/ChangeLog | 9 +++ gcc/fortran/resolve.c | 65 ++++++++++++++----- gcc/fortran/trans-array.c | 38 +++++------ gcc/testsuite/ChangeLog | 7 +- gcc/testsuite/gfortran.dg/bounds_check_11.f90 | 25 +++++++ 5 files changed, 107 insertions(+), 37 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/bounds_check_11.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index eddaa91fb09..717053a68fe 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,12 @@ +2007-10-14 Tobias Burnus + + PR fortran/33745 + * trans-array.c (gfc_conv_ss_startstride): Fix dimension check. + (gfc_trans_array_bound_check, gfc_conv_array_ref, + gfc_conv_ss_startstride): Simplify error message. + * resolve.c (check_dimension): Fix dimension-type switch; + improve error message. + 2007-10-13 Tobias Schlüter Paul Thomas diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 26c139c84b8..2461bc3beeb 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -3215,20 +3215,32 @@ check_dimension (int i, gfc_array_ref *ar, gfc_array_spec *as) /* Given start, end and stride values, calculate the minimum and maximum referenced indexes. */ - switch (ar->type) + switch (ar->dimen_type[i]) { - case AR_FULL: + case DIMEN_VECTOR: break; - case AR_ELEMENT: + case DIMEN_ELEMENT: if (compare_bound (ar->start[i], as->lower[i]) == CMP_LT) - goto bound; + { + gfc_warning ("Array reference at %L is out of bounds " + "(%ld < %ld) in dimension %d", &ar->c_where[i], + mpz_get_si (ar->start[i]->value.integer), + mpz_get_si (as->lower[i]->value.integer), i+1); + return SUCCESS; + } if (compare_bound (ar->start[i], as->upper[i]) == CMP_GT) - goto bound; + { + gfc_warning ("Array reference at %L is out of bounds " + "(%ld > %ld) in dimension %d", &ar->c_where[i], + mpz_get_si (ar->start[i]->value.integer), + mpz_get_si (as->upper[i]->value.integer), i+1); + return SUCCESS; + } break; - case AR_SECTION: + case DIMEN_RANGE: { #define AR_START (ar->start[i] ? ar->start[i] : as->lower[i]) #define AR_END (ar->end[i] ? ar->end[i] : as->upper[i]) @@ -3253,9 +3265,22 @@ check_dimension (int i, gfc_array_ref *ar, gfc_array_spec *as) || (compare_bound_int (ar->stride[i], 0) == CMP_LT && comp_start_end == CMP_GT)) { - if (compare_bound (AR_START, as->lower[i]) == CMP_LT - || compare_bound (AR_START, as->upper[i]) == CMP_GT) - goto bound; + if (compare_bound (AR_START, as->lower[i]) == CMP_LT) + { + gfc_warning ("Lower array reference at %L is out of bounds " + "(%ld < %ld) in dimension %d", &ar->c_where[i], + mpz_get_si (AR_START->value.integer), + mpz_get_si (as->lower[i]->value.integer), i+1); + return SUCCESS; + } + if (compare_bound (AR_START, as->upper[i]) == CMP_GT) + { + gfc_warning ("Lower array reference at %L is out of bounds " + "(%ld > %ld) in dimension %d", &ar->c_where[i], + mpz_get_si (AR_START->value.integer), + mpz_get_si (as->upper[i]->value.integer), i+1); + return SUCCESS; + } } /* If we can compute the highest index of the array section, @@ -3264,11 +3289,23 @@ check_dimension (int i, gfc_array_ref *ar, gfc_array_spec *as) if (compute_last_value_for_triplet (AR_START, AR_END, ar->stride[i], last_value)) { - if (compare_bound_mpz_t (as->lower[i], last_value) == CMP_GT - || compare_bound_mpz_t (as->upper[i], last_value) == CMP_LT) + if (compare_bound_mpz_t (as->lower[i], last_value) == CMP_GT) { + gfc_warning ("Upper array reference at %L is out of bounds " + "(%ld < %ld) in dimension %d", &ar->c_where[i], + mpz_get_si (last_value), + mpz_get_si (as->lower[i]->value.integer), i+1); mpz_clear (last_value); - goto bound; + return SUCCESS; + } + if (compare_bound_mpz_t (as->upper[i], last_value) == CMP_LT) + { + gfc_warning ("Upper array reference at %L is out of bounds " + "(%ld > %ld) in dimension %d", &ar->c_where[i], + mpz_get_si (last_value), + mpz_get_si (as->upper[i]->value.integer), i+1); + mpz_clear (last_value); + return SUCCESS; } } mpz_clear (last_value); @@ -3283,10 +3320,6 @@ check_dimension (int i, gfc_array_ref *ar, gfc_array_spec *as) } return SUCCESS; - -bound: - gfc_warning ("Array reference at %L is out of bounds", &ar->c_where[i]); - return SUCCESS; } diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 4fb1fdaab53..c598d25ac1e 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -2109,11 +2109,11 @@ gfc_trans_array_bound_check (gfc_se * se, tree descriptor, tree index, int n, tmp = gfc_conv_array_lbound (descriptor, n); fault = fold_build2 (LT_EXPR, boolean_type_node, index, tmp); if (name) - asprintf (&msg, "%s for array '%s', lower bound of dimension %d exceeded", - gfc_msg_fault, name, n+1); + asprintf (&msg, "%s for array '%s', lower bound of dimension %d exceeded" + "(%%ld < %%ld)", gfc_msg_fault, name, n+1); else - asprintf (&msg, "%s, lower bound of dimension %d exceeded, %%ld is " - "smaller than %%ld", gfc_msg_fault, n+1); + asprintf (&msg, "%s, lower bound of dimension %d exceeded (%%ld < %%ld)", + gfc_msg_fault, n+1); gfc_trans_runtime_check (fault, &se->pre, where, msg, fold_convert (long_integer_type_node, index), fold_convert (long_integer_type_node, tmp)); @@ -2126,10 +2126,10 @@ gfc_trans_array_bound_check (gfc_se * se, tree descriptor, tree index, int 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); + " exceeded (%%ld > %%ld)", gfc_msg_fault, name, n+1); else - asprintf (&msg, "%s, upper bound of dimension %d exceeded, %%ld is " - "larger than %%ld", gfc_msg_fault, n+1); + asprintf (&msg, "%s, upper bound of dimension %d exceeded (%%ld > %%ld)", + gfc_msg_fault, n+1); gfc_trans_runtime_check (fault, &se->pre, where, msg, fold_convert (long_integer_type_node, index), fold_convert (long_integer_type_node, tmp)); @@ -2323,8 +2323,8 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_symbol * sym, cond = fold_build2 (LT_EXPR, boolean_type_node, indexse.expr, tmp); asprintf (&msg, "%s for array '%s', " - "lower bound of dimension %d exceeded, %%ld is smaller " - "than %%ld", gfc_msg_fault, sym->name, n+1); + "lower bound of dimension %d exceeded (%%ld < %%ld)", + gfc_msg_fault, sym->name, n+1); gfc_trans_runtime_check (cond, &se->pre, where, msg, fold_convert (long_integer_type_node, indexse.expr), @@ -2340,8 +2340,8 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_symbol * sym, cond = fold_build2 (GT_EXPR, boolean_type_node, indexse.expr, tmp); asprintf (&msg, "%s for array '%s', " - "upper bound of dimension %d exceeded, %%ld is " - "greater than %%ld", gfc_msg_fault, sym->name, n+1); + "upper bound of dimension %d exceeded (%%ld > %%ld)", + gfc_msg_fault, sym->name, n+1); gfc_trans_runtime_check (cond, &se->pre, where, msg, fold_convert (long_integer_type_node, indexse.expr), @@ -2888,7 +2888,7 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop) if (info->ref->u.ar.dimen_type[dim] != DIMEN_RANGE) continue; - if (n == info->ref->u.ar.dimen - 1 + if (dim == info->ref->u.ar.dimen - 1 && (info->ref->u.ar.as->type == AS_ASSUMED_SIZE || info->ref->u.ar.as->cp_was_assumed)) check_upper = false; @@ -2941,7 +2941,7 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop) tmp = fold_build2 (TRUTH_AND_EXPR, boolean_type_node, non_zerosized, tmp); asprintf (&msg, "%s, lower bound of dimension %d of array '%s'" - " exceeded, %%ld is smaller than %%ld", gfc_msg_fault, + " exceeded (%%ld < %%ld)", gfc_msg_fault, info->dim[n]+1, ss->expr->symtree->name); gfc_trans_runtime_check (tmp, &block, &ss->expr->where, msg, fold_convert (long_integer_type_node, @@ -2957,9 +2957,8 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop) tmp = fold_build2 (TRUTH_AND_EXPR, boolean_type_node, non_zerosized, tmp); asprintf (&msg, "%s, upper bound of dimension %d of array " - "'%s' exceeded, %%ld is greater than %%ld", - gfc_msg_fault, info->dim[n]+1, - ss->expr->symtree->name); + "'%s' exceeded (%%ld > %%ld)", gfc_msg_fault, + info->dim[n]+1, ss->expr->symtree->name); gfc_trans_runtime_check (tmp, &block, &ss->expr->where, msg, fold_convert (long_integer_type_node, info->start[n]), fold_convert (long_integer_type_node, ubound)); @@ -2980,7 +2979,7 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop) tmp = fold_build2 (TRUTH_AND_EXPR, boolean_type_node, non_zerosized, tmp); asprintf (&msg, "%s, lower bound of dimension %d of array '%s'" - " exceeded, %%ld is smaller than %%ld", gfc_msg_fault, + " exceeded (%%ld < %%ld)", gfc_msg_fault, info->dim[n]+1, ss->expr->symtree->name); gfc_trans_runtime_check (tmp, &block, &ss->expr->where, msg, fold_convert (long_integer_type_node, @@ -2995,9 +2994,8 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop) tmp = fold_build2 (TRUTH_AND_EXPR, boolean_type_node, non_zerosized, tmp); asprintf (&msg, "%s, upper bound of dimension %d of array " - "'%s' exceeded, %%ld is greater than %%ld", - gfc_msg_fault, info->dim[n]+1, - ss->expr->symtree->name); + "'%s' exceeded (%%ld > %%ld)", gfc_msg_fault, + info->dim[n]+1, ss->expr->symtree->name); gfc_trans_runtime_check (tmp, &block, &ss->expr->where, msg, fold_convert (long_integer_type_node, tmp2), fold_convert (long_integer_type_node, ubound)); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index abfa7704ef7..4ec1dc3a349 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,6 +1,11 @@ +2007-10-14 Tobias Burnus + + PR fortran/33745 + * gfortran.dg/bounds_check_11.f90: New. + 2007-10-14 Andrew Pinski - PR c++/30303 + PR c++/30303 * g++.dg/other/ctor1.C: New test. * g++.dg/other/ctor2.C: New test. * g++.dg/other/dtor1.C: New test. diff --git a/gcc/testsuite/gfortran.dg/bounds_check_11.f90 b/gcc/testsuite/gfortran.dg/bounds_check_11.f90 new file mode 100644 index 00000000000..648e1d3ab61 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/bounds_check_11.f90 @@ -0,0 +1,25 @@ +! { dg-do run } +! { dg-options "-fbounds-check" } +! { dg-shouldfail "Array bound checking" } +! PR fortran/33745 +! +! Don't check upper bound of assumed-size array +! + +program test + implicit none + integer, parameter :: maxss=7,maxc=8 + integer :: jp(2,maxc) + call findphase(jp) +contains + subroutine findphase(jp) + integer, intent(out) :: jp(2,*) + jp(2,2:4)=0 + jp(2,0:4)=0 ! { dg-warning "out of bounds" } + jp(3,1:4)=0 ! { dg-warning "out of bounds" } + end subroutine +end program test + +! { dg-output "At line 18 of file .*" } +! { dg-output "Array reference out of bounds, lower bound of dimension 2 of array 'jp' exceeded .0 < 1." } +