diff options
| author | Tobias Burnus <burnus@net-b.de> | 2013-06-26 17:39:25 +0200 |
|---|---|---|
| committer | Tobias Burnus <burnus@gcc.gnu.org> | 2013-06-26 17:39:25 +0200 |
| commit | 31f02c775233015db6fb95d31a9cff7a193428d8 (patch) | |
| tree | 924d448f2d4f82f5bc8b73c8b0d78ce5aa666bf5 /gcc/fortran/trans-array.c | |
| parent | fd8c65e7d3f82eb0ec12de4402e8a0a6eb231e90 (diff) | |
| download | gcc-31f02c775233015db6fb95d31a9cff7a193428d8.zip gcc-31f02c775233015db6fb95d31a9cff7a193428d8.tar.gz gcc-31f02c775233015db6fb95d31a9cff7a193428d8.tar.bz2 | |
re PR fortran/29800 (-fbounds-check: For derived types, write not also compound name)
2013-06-26 Tobias Burnus <burnus@net-b.de>
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 <burnus@net-b.de>
PR fortran/29800
* gfortran.dg/bounds_check_17.f90: New.
From-SVN: r200425
Diffstat (limited to 'gcc/fortran/trans-array.c')
| -rw-r--r-- | gcc/fortran/trans-array.c | 37 |
1 files changed, 34 insertions, 3 deletions
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), |