From c6ec7cc699a93d16ac7be97e77a8eb1b9bfaf41e Mon Sep 17 00:00:00 2001 From: Dennis Wassel Date: Thu, 1 Oct 2009 02:32:41 +0000 Subject: [PATCH] trans-array.c (gfc_trans_array_bound_check): Improved bounds checking error messages. 2009-09-30 Dennis Wassel * gcc/fortran/trans-array.c (gfc_trans_array_bound_check): Improved bounds checking error messages. (gfc_conv_array_ref): Likewise. (gfc_conv_ss_startstride): Likewise. From-SVN: r152355 --- gcc/fortran/ChangeLog | 6 ++ gcc/fortran/trans-array.c | 198 ++++++++++++++++++++++++++-------------------- 2 files changed, 118 insertions(+), 86 deletions(-) diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 9318bae..2398dd0 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2009-09-30 Dennis Wassel + + * gcc/fortran/trans-array.c (gfc_trans_array_bound_check): Improved + bounds checking error messages. (gfc_conv_array_ref): Likewise. + (gfc_conv_ss_startstride): Likewise. + 2009-09-30 Janus Weil * resolve.c (check_typebound_baseobject): Don't check for diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 0c00d32..e162000 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -2296,7 +2296,7 @@ gfc_trans_array_bound_check (gfc_se * se, tree descriptor, tree index, int n, locus * where, bool check_upper) { tree fault; - tree tmp; + tree tmp_lo, tmp_up; char *msg; const char * name = NULL; @@ -2333,34 +2333,46 @@ gfc_trans_array_bound_check (gfc_se * se, tree descriptor, tree index, int n, name = "unnamed constant"; } - /* Check lower bound. */ - 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" - "(%%ld < %%ld)", gfc_msg_fault, name, n+1); - else - asprintf (&msg, "%s, lower bound of dimension %d exceeded (%%ld < %%ld)", - gfc_msg_fault, n+1); - gfc_trans_runtime_check (true, false, fault, &se->pre, where, msg, - fold_convert (long_integer_type_node, index), - fold_convert (long_integer_type_node, tmp)); - gfc_free (msg); - - /* Check upper bound. */ + /* If upper bound is present, include both bounds in the error message. */ if (check_upper) { - tmp = gfc_conv_array_ubound (descriptor, n); - fault = fold_build2 (GT_EXPR, boolean_type_node, index, tmp); + tmp_lo = gfc_conv_array_lbound (descriptor, n); + tmp_up = gfc_conv_array_ubound (descriptor, n); + if (name) - asprintf (&msg, "%s for array '%s', upper bound of dimension %d " - " exceeded (%%ld > %%ld)", gfc_msg_fault, name, n+1); + asprintf (&msg, "Index '%%ld' of dimension %d of array '%s' " + "outside of expected range (%%ld:%%ld)", n+1, name); else - asprintf (&msg, "%s, upper bound of dimension %d exceeded (%%ld > %%ld)", - gfc_msg_fault, n+1); + asprintf (&msg, "Index '%%ld' of dimension %d " + "outside of expected range (%%ld:%%ld)", n+1); + + fault = fold_build2 (LT_EXPR, boolean_type_node, index, tmp_lo); gfc_trans_runtime_check (true, false, fault, &se->pre, where, msg, fold_convert (long_integer_type_node, index), - fold_convert (long_integer_type_node, tmp)); + fold_convert (long_integer_type_node, tmp_lo), + fold_convert (long_integer_type_node, tmp_up)); + fault = fold_build2 (GT_EXPR, boolean_type_node, index, tmp_up); + gfc_trans_runtime_check (true, false, fault, &se->pre, where, msg, + fold_convert (long_integer_type_node, index), + fold_convert (long_integer_type_node, tmp_lo), + fold_convert (long_integer_type_node, tmp_up)); + gfc_free (msg); + } + else + { + tmp_lo = gfc_conv_array_lbound (descriptor, n); + + if (name) + asprintf (&msg, "Index '%%ld' of dimension %d of array '%s' " + "below lower bound of %%ld", n+1, name); + else + asprintf (&msg, "Index '%%ld' of dimension %d " + "below lower bound of %%ld", n+1); + + fault = fold_build2 (LT_EXPR, boolean_type_node, index, tmp_lo); + gfc_trans_runtime_check (true, false, fault, &se->pre, where, msg, + fold_convert (long_integer_type_node, index), + fold_convert (long_integer_type_node, tmp_lo)); gfc_free (msg); } @@ -2561,9 +2573,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 < %%ld)", - gfc_msg_fault, sym->name, n+1); + asprintf (&msg, "Index '%%ld' of dimension %d of array '%s' " + "below lower bound of %%ld", n+1, sym->name); gfc_trans_runtime_check (true, false, cond, &se->pre, where, msg, fold_convert (long_integer_type_node, indexse.expr), @@ -2587,9 +2598,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 > %%ld)", - gfc_msg_fault, sym->name, n+1); + asprintf (&msg, "Index '%%ld' of dimension %d of array '%s' " + "above upper bound of %%ld", n+1, sym->name); gfc_trans_runtime_check (true, false, cond, &se->pre, where, msg, fold_convert (long_integer_type_node, indexse.expr), @@ -3166,7 +3176,7 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop) tree lbound, ubound; tree end; tree size[GFC_MAX_DIMENSIONS]; - tree stride_pos, stride_neg, non_zerosized, tmp2; + tree stride_pos, stride_neg, non_zerosized, tmp2, tmp3; gfc_ss_info *info; char *msg; int dim; @@ -3246,77 +3256,95 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop) 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 (%%ld < %%ld)", gfc_msg_fault, - info->dim[n]+1, ss->expr->symtree->name); - gfc_trans_runtime_check (true, false, tmp, &inner, - &ss->expr->where, msg, - fold_convert (long_integer_type_node, - info->start[n]), - fold_convert (long_integer_type_node, - lbound)); - gfc_free (msg); - + bounds of the array, if the range is not empty. + If upper bound is present, include both bounds in the + error message. */ if (check_upper) { - tmp = fold_build2 (GT_EXPR, boolean_type_node, - info->start[n], ubound); + 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, upper bound of dimension %d of array " - "'%s' exceeded (%%ld > %%ld)", gfc_msg_fault, + tmp2 = fold_build2 (GT_EXPR, boolean_type_node, + info->start[n], ubound); + tmp2 = fold_build2 (TRUTH_AND_EXPR, boolean_type_node, + non_zerosized, tmp2); + asprintf (&msg, "Index '%%ld' of dimension %d of array '%s' " + "outside of expected range (%%ld:%%ld)", info->dim[n]+1, ss->expr->symtree->name); - gfc_trans_runtime_check (true, false, tmp, &inner, - &ss->expr->where, msg, - fold_convert (long_integer_type_node, info->start[n]), - fold_convert (long_integer_type_node, ubound)); + gfc_trans_runtime_check (true, false, tmp, &inner, + &ss->expr->where, msg, + fold_convert (long_integer_type_node, info->start[n]), + fold_convert (long_integer_type_node, lbound), + fold_convert (long_integer_type_node, ubound)); + gfc_trans_runtime_check (true, false, tmp2, &inner, + &ss->expr->where, msg, + fold_convert (long_integer_type_node, info->start[n]), + fold_convert (long_integer_type_node, lbound), + fold_convert (long_integer_type_node, ubound)); gfc_free (msg); } - + else + { + 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, "Index '%%ld' of dimension %d of array '%s' " + "below lower bound of %%ld", + info->dim[n]+1, ss->expr->symtree->name); + gfc_trans_runtime_check (true, false, tmp, &inner, + &ss->expr->where, msg, + fold_convert (long_integer_type_node, info->start[n]), + fold_convert (long_integer_type_node, lbound)); + 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, + + tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, end, info->start[n]); - tmp2 = fold_build2 (TRUNC_MOD_EXPR, gfc_array_index_type, tmp2, + tmp = fold_build2 (TRUNC_MOD_EXPR, gfc_array_index_type, tmp, 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 (%%ld < %%ld)", gfc_msg_fault, - info->dim[n]+1, ss->expr->symtree->name); - gfc_trans_runtime_check (true, false, tmp, &inner, - &ss->expr->where, msg, - fold_convert (long_integer_type_node, - tmp2), - fold_convert (long_integer_type_node, - lbound)); - gfc_free (msg); - + tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, end, + tmp); + tmp2 = fold_build2 (LT_EXPR, boolean_type_node, tmp, lbound); + tmp2 = fold_build2 (TRUTH_AND_EXPR, boolean_type_node, + non_zerosized, tmp2); 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 (%%ld > %%ld)", gfc_msg_fault, + tmp3 = fold_build2 (GT_EXPR, boolean_type_node, tmp, ubound); + tmp3 = fold_build2 (TRUTH_AND_EXPR, boolean_type_node, + non_zerosized, tmp3); + asprintf (&msg, "Index '%%ld' of dimension %d of array '%s' " + "outside of expected range (%%ld:%%ld)", info->dim[n]+1, ss->expr->symtree->name); - gfc_trans_runtime_check (true, false, tmp, &inner, - &ss->expr->where, msg, - fold_convert (long_integer_type_node, tmp2), - fold_convert (long_integer_type_node, ubound)); + gfc_trans_runtime_check (true, false, tmp2, &inner, + &ss->expr->where, msg, + fold_convert (long_integer_type_node, tmp), + fold_convert (long_integer_type_node, ubound), + fold_convert (long_integer_type_node, lbound)); + gfc_trans_runtime_check (true, false, tmp3, &inner, + &ss->expr->where, msg, + fold_convert (long_integer_type_node, tmp), + fold_convert (long_integer_type_node, ubound), + fold_convert (long_integer_type_node, lbound)); gfc_free (msg); } - + else + { + asprintf (&msg, "Index '%%ld' of dimension %d of array '%s' " + "below lower bound of %%ld", + info->dim[n]+1, ss->expr->symtree->name); + gfc_trans_runtime_check (true, false, tmp2, &inner, + &ss->expr->where, msg, + fold_convert (long_integer_type_node, tmp), + fold_convert (long_integer_type_node, lbound)); + gfc_free (msg); + } + /* Check the section sizes match. */ tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, end, info->start[n]); @@ -3330,8 +3358,6 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop) others against this. */ if (size[n]) { - tree tmp3; - tmp3 = fold_build2 (NE_EXPR, boolean_type_node, tmp, size[n]); asprintf (&msg, "%s, size mismatch for dimension %d " "of array '%s' (%%ld/%%ld)", gfc_msg_bounds, -- 2.7.4