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
This commit is contained in:
parent
9dedcfe16a
commit
d19c0f4fa6
|
@ -1,3 +1,13 @@
|
|||
2006-11-26 Francois-Xavier Coudert <coudert@clipper.ens.fr>
|
||||
|
||||
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
|
||||
|
||||
2006-11-26 Andrew Pinski <pinskia@gmail.com>
|
||||
|
||||
* trans-decl.c (gfc_build_intrinsic_function_decls): Mark the
|
||||
|
|
|
@ -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);
|
||||
}
|
||||
}
|
||||
|
|
|
@ -779,7 +779,7 @@ gfc_conv_intrinsic_bound (gfc_se * se, gfc_expr * expr, int upper)
|
|||
tmp = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (TREE_TYPE (desc))];
|
||||
tmp = fold_build2 (GE_EXPR, boolean_type_node, bound, tmp);
|
||||
cond = fold_build2 (TRUTH_ORIF_EXPR, boolean_type_node, cond, tmp);
|
||||
gfc_trans_runtime_check (cond, gfc_msg_fault, &se->pre, NULL);
|
||||
gfc_trans_runtime_check (cond, gfc_msg_fault, &se->pre, &expr->where);
|
||||
}
|
||||
}
|
||||
|
||||
|
|
Loading…
Reference in New Issue