From 3a5a6289e070b6f838485a2de5fe79a010dccf87 Mon Sep 17 00:00:00 2001 From: burnus Date: Wed, 26 Jun 2013 15:39:25 +0000 Subject: [PATCH] 2013-06-26 Tobias Burnus PR fortran/29800 * trans-array.c (gfc_conv_array_ref): Improve out-of-bounds diagnostic message. * trans-array.c (gfc_conv_array_ref): Update prototype. * trans-expr.c (gfc_conv_variable): Update call. 2013-06-26 Tobias Burnus PR fortran/29800 * gfortran.dg/bounds_check_17.f90: New. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@200425 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 8 ++++++ gcc/fortran/trans-array.c | 37 ++++++++++++++++++++++++--- gcc/fortran/trans-array.h | 2 +- gcc/fortran/trans-expr.c | 2 +- gcc/testsuite/ChangeLog | 5 ++++ gcc/testsuite/gfortran.dg/bounds_check_17.f90 | 26 +++++++++++++++++++ 6 files changed, 75 insertions(+), 5 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/bounds_check_17.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 60097db..7519725 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2013-06-26 Tobias Burnus + + PR fortran/29800 + * trans-array.c (gfc_conv_array_ref): Improve out-of-bounds + diagnostic message. + * trans-array.c (gfc_conv_array_ref): Update prototype. + * trans-expr.c (gfc_conv_variable): Update call. + 2013-06-24 Steven G. Kargl Francois-Xavier Coudert Dominique d'Humieres diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 96162e5..39bf0dd 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -3145,7 +3145,7 @@ build_array_ref (tree desc, tree offset, tree decl) a(i, j, k) = base[offset + i * stride[0] + j * stride[1] + k * stride[2]]*/ void -gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_symbol * sym, +gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_expr *expr, locus * where) { int n; @@ -3154,6 +3154,8 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_symbol * sym, tree stride; gfc_se indexse; gfc_se tmpse; + gfc_symbol * sym = expr->symtree->n.sym; + char *var_name = NULL; if (ar->dimen == 0) { @@ -3184,6 +3186,35 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_symbol * sym, return; } + if (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS) + { + size_t len; + gfc_ref *ref; + + len = strlen (sym->name) + 1; + for (ref = expr->ref; ref; ref = ref->next) + { + if (ref->type == REF_ARRAY && &ref->u.ar == ar) + break; + if (ref->type == REF_COMPONENT) + len += 1 + strlen (ref->u.c.component->name); + } + + var_name = XALLOCAVEC (char, len); + strcpy (var_name, sym->name); + + for (ref = expr->ref; ref; ref = ref->next) + { + if (ref->type == REF_ARRAY && &ref->u.ar == ar) + break; + if (ref->type == REF_COMPONENT) + { + strcat (var_name, "%%"); + strcat (var_name, ref->u.c.component->name); + } + } + } + cst_offset = offset = gfc_index_zero_node; add_to_offset (&cst_offset, &offset, gfc_conv_array_offset (se->expr)); @@ -3219,7 +3250,7 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_symbol * sym, cond = fold_build2_loc (input_location, LT_EXPR, boolean_type_node, indexse.expr, tmp); asprintf (&msg, "Index '%%ld' of dimension %d of array '%s' " - "below lower bound of %%ld", n+1, sym->name); + "below lower bound of %%ld", n+1, var_name); gfc_trans_runtime_check (true, false, cond, &se->pre, where, msg, fold_convert (long_integer_type_node, indexse.expr), @@ -3243,7 +3274,7 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_symbol * sym, cond = fold_build2_loc (input_location, GT_EXPR, boolean_type_node, indexse.expr, tmp); asprintf (&msg, "Index '%%ld' of dimension %d of array '%s' " - "above upper bound of %%ld", n+1, sym->name); + "above upper bound of %%ld", n+1, var_name); gfc_trans_runtime_check (true, false, cond, &se->pre, where, msg, fold_convert (long_integer_type_node, indexse.expr), diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h index 8d9e461..2d2b45d 100644 --- a/gcc/fortran/trans-array.h +++ b/gcc/fortran/trans-array.h @@ -123,7 +123,7 @@ void gfc_conv_resolve_dependencies (gfc_loopinfo *, gfc_ss *, gfc_ss *); tree gfc_build_null_descriptor (tree); /* Get a single array element. */ -void gfc_conv_array_ref (gfc_se *, gfc_array_ref *, gfc_symbol *, locus *); +void gfc_conv_array_ref (gfc_se *, gfc_array_ref *, gfc_expr *, locus *); /* Translate a reference to a temporary array. */ void gfc_conv_tmp_array_ref (gfc_se * se); /* Translate a reference to an array temporary. */ diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 56dc766..0eef2b2 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -1910,7 +1910,7 @@ gfc_conv_variable (gfc_se * se, gfc_expr * expr) && ref->next == NULL && (se->descriptor_only)) return; - gfc_conv_array_ref (se, &ref->u.ar, sym, &expr->where); + gfc_conv_array_ref (se, &ref->u.ar, expr, &expr->where); /* Return a pointer to an element. */ break; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 5e1f52e..edd60ac 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2013-06-26 Tobias Burnus + + PR fortran/29800 + * gfortran.dg/bounds_check_17.f90: New. + 2013-06-25 Ed Smith-Rowland <3dw4rd@verizon.net> PR c++/57640 diff --git a/gcc/testsuite/gfortran.dg/bounds_check_17.f90 b/gcc/testsuite/gfortran.dg/bounds_check_17.f90 new file mode 100644 index 0000000..50d66c7 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/bounds_check_17.f90 @@ -0,0 +1,26 @@ +! { dg-do run } +! { dg-options "-fcheck=bounds" } +! { dg-shouldfail "above upper bound" } +! +! PR fortran/29800 +! +! Contributed by Joost VandeVondele +! + +TYPE data + INTEGER :: x(10) +END TYPE +TYPE data_areas + TYPE(data) :: y(10) +END TYPE + +TYPE(data_areas) :: z(10) + +integer, volatile :: i,j,k +i=1 ; j=1 ; k=11 + +z(i)%y(j)%x(k)=0 + +END + +! { dg-output "At line 22 of file .*bounds_check_17.f90.*Fortran runtime error: Index '11' of dimension 1 of array 'z%y%x' above upper bound of 10" } -- 2.7.4