diff options
| author | Francois-Xavier Coudert <coudert@clipper.ens.fr> | 2006-11-26 13:25:50 +0100 |
|---|---|---|
| committer | François-Xavier Coudert <fxcoudert@gcc.gnu.org> | 2006-11-26 12:25:50 +0000 |
| commit | d19c0f4fa6599e454c1c7b12917252f6f34852e7 (patch) | |
| tree | dd60c2c6bad2e014d025f178a2f49f119786e154 /gcc/fortran/trans-array.c | |
| parent | 9dedcfe16a380a72d92cb164f229c64a5e97d312 (diff) | |
| download | gcc-d19c0f4fa6599e454c1c7b12917252f6f34852e7.zip gcc-d19c0f4fa6599e454c1c7b12917252f6f34852e7.tar.gz gcc-d19c0f4fa6599e454c1c7b12917252f6f34852e7.tar.bz2 | |
re PR fortran/29892 (substring out of bounds: Missing variable name for variables with parameter attribute)
PR fortran/29892
* trans-intrinsic.c (gfc_conv_intrinsic_bound): Use a locus in
the call to gfc_trans_runtime_check.
* trans-array.c (gfc_trans_array_bound_check): Try harder to find
the variable or function name for the runtime error message.
(gfc_trans_dummy_array_bias): Use a locus in the call to
gfc_trans_runtime_check
From-SVN: r119223
Diffstat (limited to 'gcc/fortran/trans-array.c')
| -rw-r--r-- | gcc/fortran/trans-array.c | 39 |
1 files changed, 34 insertions, 5 deletions
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 2a5b3b7..991fa1c 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -1849,18 +1849,47 @@ gfc_trans_array_bound_check (gfc_se * se, tree descriptor, tree index, int n, tree fault; tree tmp; char *msg; + const char * name = NULL; if (!flag_bounds_check) return index; index = gfc_evaluate_now (index, &se->pre); + /* We find a name for the error message. */ + if (se->ss) + name = se->ss->expr->symtree->name; + + if (!name && se->loop && se->loop->ss && se->loop->ss->expr + && se->loop->ss->expr->symtree) + name = se->loop->ss->expr->symtree->name; + + if (!name && se->loop && se->loop->ss && se->loop->ss->loop_chain + && se->loop->ss->loop_chain->expr + && se->loop->ss->loop_chain->expr->symtree) + name = se->loop->ss->loop_chain->expr->symtree->name; + + if (!name && se->loop && se->loop->ss && se->loop->ss->loop_chain + && se->loop->ss->loop_chain->expr->symtree) + name = se->loop->ss->loop_chain->expr->symtree->name; + + if (!name && se->loop && se->loop->ss && se->loop->ss->expr) + { + if (se->loop->ss->expr->expr_type == EXPR_FUNCTION + && se->loop->ss->expr->value.function.name) + name = se->loop->ss->expr->value.function.name; + else + if (se->loop->ss->type == GFC_SS_CONSTRUCTOR + || se->loop->ss->type == GFC_SS_SCALAR) + name = "unnamed constant"; + } + /* Check lower bound. */ tmp = gfc_conv_array_lbound (descriptor, n); fault = fold_build2 (LT_EXPR, boolean_type_node, index, tmp); - if (se->ss) + if (name) asprintf (&msg, "%s for array '%s', lower bound of dimension %d exceeded", - gfc_msg_fault, se->ss->expr->symtree->name, n+1); + gfc_msg_fault, name, n+1); else asprintf (&msg, "%s, lower bound of dimension %d exceeded", gfc_msg_fault, n+1); @@ -1870,9 +1899,9 @@ gfc_trans_array_bound_check (gfc_se * se, tree descriptor, tree index, int n, /* Check upper bound. */ tmp = gfc_conv_array_ubound (descriptor, n); fault = fold_build2 (GT_EXPR, boolean_type_node, index, tmp); - if (se->ss) + if (name) asprintf (&msg, "%s for array '%s', upper bound of dimension %d exceeded", - gfc_msg_fault, se->ss->expr->symtree->name, n+1); + gfc_msg_fault, name, n+1); else asprintf (&msg, "%s, upper bound of dimension %d exceeded", gfc_msg_fault, n+1); @@ -3904,7 +3933,7 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, tree body) tmp = fold_build2 (NE_EXPR, gfc_array_index_type, tmp, stride2); asprintf (&msg, "%s for dimension %d of array '%s'", gfc_msg_bounds, n+1, sym->name); - gfc_trans_runtime_check (tmp, msg, &block, NULL); + gfc_trans_runtime_check (tmp, msg, &block, &loc); gfc_free (msg); } } |