From: fxcoudert Date: Sat, 3 Jun 2006 17:28:33 +0000 (+0000) Subject: * trans.c (gfc_msg_bounds, gfc_msg_fault, gfc_msg_wrong_return): X-Git-Url: http://git.sourceforge.jp/view?p=pf3gnuchains%2Fgcc-fork.git;a=commitdiff_plain;h=97c2a00c7e0e3b881d241aeb0a49fd9298857160 * trans.c (gfc_msg_bounds, gfc_msg_fault, gfc_msg_wrong_return): Add strings for common runtime error messages. (gfc_trans_runtime_check): Add a locus argument, use a string and not a string tree for the message. * trans.h (gfc_trans_runtime_check): Change prototype accordingly. (gfc_msg_bounds, gfc_msg_fault, gfc_msg_wrong_return): Add proto. * trans-const.c (gfc_strconst_bounds, gfc_strconst_fault, gfc_strconst_wrong_return, gfc_strconst_current_filename): Remove. (gfc_init_constants): Likewise. * trans-const.h: Likewise. * trans-decl.c (gfc_build_builtin_function_decls): Call to _gfortran_runtime_error has only one argument, the message string. * trans-array.h (gfc_conv_array_ref): Add a symbol argument and a locus. * trans-array.c (gfc_trans_array_bound_check): Build precise error messages. (gfc_conv_array_ref): Use the new symbol argument and the locus to build more precise error messages. (gfc_conv_ss_startstride): More precise error messages. * trans-expr.c (gfc_conv_variable): Give symbol reference and locus to gfc_conv_array_ref. (gfc_conv_function_call): Use the new prototype for gfc_trans_runtime_check. * trans-stmt.c (gfc_trans_goto): Build more precise error message. * trans-io.c (set_string): Likewise. * trans-intrinsic.c (gfc_conv_intrinsic_bound): Use new prototype for gfc_trans_runtime_check. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@114346 138bc75d-0d04-0410-961f-82ee72b054a4 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 44c61b68bd5..cc040a65ccc 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,33 @@ +2006-06-03 Francois-Xavier Coudert + + * trans.c (gfc_msg_bounds, gfc_msg_fault, gfc_msg_wrong_return): + Add strings for common runtime error messages. + (gfc_trans_runtime_check): Add a locus argument, use a string + and not a string tree for the message. + * trans.h (gfc_trans_runtime_check): Change prototype accordingly. + (gfc_msg_bounds, gfc_msg_fault, gfc_msg_wrong_return): Add proto. + * trans-const.c (gfc_strconst_bounds, gfc_strconst_fault, + gfc_strconst_wrong_return, gfc_strconst_current_filename): Remove. + (gfc_init_constants): Likewise. + * trans-const.h: Likewise. + * trans-decl.c (gfc_build_builtin_function_decls): Call to + _gfortran_runtime_error has only one argument, the message string. + * trans-array.h (gfc_conv_array_ref): Add a symbol argument and a + locus. + * trans-array.c (gfc_trans_array_bound_check): Build precise + error messages. + (gfc_conv_array_ref): Use the new symbol argument and the locus + to build more precise error messages. + (gfc_conv_ss_startstride): More precise error messages. + * trans-expr.c (gfc_conv_variable): Give symbol reference and + locus to gfc_conv_array_ref. + (gfc_conv_function_call): Use the new prototype for + gfc_trans_runtime_check. + * trans-stmt.c (gfc_trans_goto): Build more precise error message. + * trans-io.c (set_string): Likewise. + * trans-intrinsic.c (gfc_conv_intrinsic_bound): Use new prototype + for gfc_trans_runtime_check. + 2006-06-01 Thomas Koenig PR fortran/27715 diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index be640bb487f..26d5febaa4a 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -1767,23 +1767,40 @@ gfc_conv_array_ubound (tree descriptor, int dim) static tree gfc_trans_array_bound_check (gfc_se * se, tree descriptor, tree index, int n) { - tree cond; tree fault; tree tmp; + char *msg; if (!flag_bounds_check) return index; index = gfc_evaluate_now (index, &se->pre); + /* Check lower bound. */ tmp = gfc_conv_array_lbound (descriptor, n); fault = fold_build2 (LT_EXPR, boolean_type_node, index, tmp); + if (se->ss) + asprintf (&msg, "%s for array '%s', lower bound of dimension %d exceeded", + gfc_msg_fault, se->ss->expr->symtree->name, n+1); + else + asprintf (&msg, "%s, lower bound of dimension %d exceeded", + gfc_msg_fault, n+1); + gfc_trans_runtime_check (fault, msg, &se->pre, + (se->ss ? &se->ss->expr->where : NULL)); + gfc_free (msg); + /* Check upper bound. */ tmp = gfc_conv_array_ubound (descriptor, n); - cond = fold_build2 (GT_EXPR, boolean_type_node, index, tmp); - fault = fold_build2 (TRUTH_OR_EXPR, boolean_type_node, fault, cond); - - gfc_trans_runtime_check (fault, gfc_strconst_fault, &se->pre); + fault = fold_build2 (GT_EXPR, boolean_type_node, index, tmp); + if (se->ss) + asprintf (&msg, "%s for array '%s', upper bound of dimension %d exceeded", + gfc_msg_fault, se->ss->expr->symtree->name, n+1); + else + asprintf (&msg, "%s, upper bound of dimension %d exceeded", + gfc_msg_fault, n+1); + gfc_trans_runtime_check (fault, msg, &se->pre, + (se->ss ? &se->ss->expr->where : NULL)); + gfc_free (msg); return index; } @@ -1919,13 +1936,13 @@ gfc_conv_tmp_array_ref (gfc_se * se) 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_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_symbol * sym, + locus * where) { int n; tree index; tree tmp; tree stride; - tree fault; gfc_se indexse; /* Handle scalarized references separately. */ @@ -1938,8 +1955,6 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar) index = gfc_index_zero_node; - fault = gfc_index_zero_node; - /* Calculate the offsets from all the dimensions. */ for (n = 0; n < ar->dimen; n++) { @@ -1953,20 +1968,27 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar) { /* Check array bounds. */ tree cond; + char *msg; indexse.expr = gfc_evaluate_now (indexse.expr, &se->pre); tmp = gfc_conv_array_lbound (se->expr, n); cond = fold_build2 (LT_EXPR, boolean_type_node, indexse.expr, tmp); - fault = - fold_build2 (TRUTH_OR_EXPR, boolean_type_node, fault, cond); + asprintf (&msg, "%s for array '%s', " + "lower bound of dimension %d exceeded", gfc_msg_fault, + sym->name, n+1); + gfc_trans_runtime_check (cond, msg, &se->pre, where); + gfc_free (msg); tmp = gfc_conv_array_ubound (se->expr, n); cond = fold_build2 (GT_EXPR, boolean_type_node, indexse.expr, tmp); - fault = - fold_build2 (TRUTH_OR_EXPR, boolean_type_node, fault, cond); + asprintf (&msg, "%s for array '%s', " + "upper bound of dimension %d exceeded", gfc_msg_fault, + sym->name, n+1); + gfc_trans_runtime_check (cond, msg, &se->pre, where); + gfc_free (msg); } /* Multiply the index by the stride. */ @@ -1978,9 +2000,6 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar) index = fold_build2 (PLUS_EXPR, gfc_array_index_type, index, tmp); } - if (flag_bounds_check) - gfc_trans_runtime_check (fault, gfc_strconst_fault, &se->pre); - tmp = gfc_conv_array_offset (se->expr); if (!integer_zerop (tmp)) index = fold_build2 (PLUS_EXPR, gfc_array_index_type, index, tmp); @@ -2457,16 +2476,15 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop) if (flag_bounds_check) { stmtblock_t block; - tree fault; tree bound; tree end; tree size[GFC_MAX_DIMENSIONS]; gfc_ss_info *info; + char *msg; int dim; gfc_start_block (&block); - fault = boolean_false_node; for (n = 0; n < loop->dimen; n++) size[n] = NULL_TREE; @@ -2492,15 +2510,21 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop) bound = gfc_conv_array_lbound (desc, dim); tmp = info->start[n]; tmp = fold_build2 (LT_EXPR, boolean_type_node, tmp, bound); - fault = fold_build2 (TRUTH_OR_EXPR, boolean_type_node, fault, - tmp); + asprintf (&msg, "%s, lower bound of dimension %d of array '%s'" + " exceeded", gfc_msg_bounds, n+1, + ss->expr->symtree->name); + gfc_trans_runtime_check (tmp, msg, &block, &ss->expr->where); + gfc_free (msg); /* Check the upper bound. */ bound = gfc_conv_array_ubound (desc, dim); end = gfc_conv_section_upper_bound (ss, n, &block); tmp = fold_build2 (GT_EXPR, boolean_type_node, end, bound); - fault = fold_build2 (TRUTH_OR_EXPR, boolean_type_node, fault, - tmp); + asprintf (&msg, "%s, upper bound of dimension %d of array '%s'" + " exceeded", gfc_msg_bounds, n+1, + ss->expr->symtree->name); + gfc_trans_runtime_check (tmp, msg, &block, &ss->expr->where); + gfc_free (msg); /* Check the section sizes match. */ tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, end, @@ -2513,14 +2537,16 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop) { tmp = fold_build2 (NE_EXPR, boolean_type_node, tmp, size[n]); - fault = - build2 (TRUTH_OR_EXPR, boolean_type_node, fault, tmp); + asprintf (&msg, "%s, size mismatch for dimension %d " + "of array '%s'", gfc_msg_bounds, n+1, + ss->expr->symtree->name); + gfc_trans_runtime_check (tmp, msg, &block, &ss->expr->where); + gfc_free (msg); } else size[n] = gfc_evaluate_now (tmp, &block); } } - gfc_trans_runtime_check (fault, gfc_strconst_bounds, &block); tmp = gfc_finish_block (&block); gfc_add_expr_to_block (&loop->pre, tmp); @@ -3709,13 +3735,17 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, tree body) if (checkparm) { /* Check (ubound(a) - lbound(a) == ubound(b) - lbound(b)). */ + char * msg; tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, ubound, lbound); stride2 = build2 (MINUS_EXPR, gfc_array_index_type, dubound, dlbound); tmp = fold_build2 (NE_EXPR, gfc_array_index_type, tmp, stride2); - gfc_trans_runtime_check (tmp, gfc_strconst_bounds, &block); + 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_free (msg); } } else diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h index 6f57429ae3c..ae085346643 100644 --- a/gcc/fortran/trans-array.h +++ b/gcc/fortran/trans-array.h @@ -86,7 +86,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 *); +void gfc_conv_array_ref (gfc_se *, gfc_array_ref *, gfc_symbol *, 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-const.c b/gcc/fortran/trans-const.c index 4a23a56854f..936dd6459af 100644 --- a/gcc/fortran/trans-const.c +++ b/gcc/fortran/trans-const.c @@ -33,12 +33,6 @@ Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA #include "trans-const.h" #include "trans-types.h" -/* String constants. */ -tree gfc_strconst_bounds; -tree gfc_strconst_fault; -tree gfc_strconst_wrong_return; -tree gfc_strconst_current_filename; - tree gfc_rank_cst[GFC_MAX_DIMENSIONS + 1]; /* Build a constant with given type from an int_cst. */ @@ -154,17 +148,6 @@ gfc_init_constants (void) for (n = 0; n <= GFC_MAX_DIMENSIONS; n++) gfc_rank_cst[n] = build_int_cst (gfc_array_index_type, n); - - gfc_strconst_bounds = gfc_build_cstring_const ("Array bound mismatch"); - - gfc_strconst_fault = - gfc_build_cstring_const ("Array reference out of bounds"); - - gfc_strconst_wrong_return = - gfc_build_cstring_const ("Incorrect function return value"); - - gfc_strconst_current_filename = - gfc_build_cstring_const (gfc_source_file); } /* Converts a GMP integer into a backend tree node. */ diff --git a/gcc/fortran/trans-const.h b/gcc/fortran/trans-const.h index 304a324f33d..c01316e0a7d 100644 --- a/gcc/fortran/trans-const.h +++ b/gcc/fortran/trans-const.h @@ -49,12 +49,6 @@ void gfc_init_constants (void); /* Build a constant with given type from an int_cst. */ tree gfc_build_const (tree, tree); -/* String constants. */ -extern GTY(()) tree gfc_strconst_current_filename; -extern GTY(()) tree gfc_strconst_bounds; -extern GTY(()) tree gfc_strconst_fault; -extern GTY(()) tree gfc_strconst_wrong_return; - /* Integer constants 0..GFC_MAX_DIMENSIONS. */ extern GTY(()) tree gfc_rank_cst[GFC_MAX_DIMENSIONS + 1]; diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 4efe4bdb95d..30d51b996ca 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -2275,10 +2275,7 @@ gfc_build_builtin_function_decls (void) gfor_fndecl_runtime_error = gfc_build_library_function_decl (get_identifier (PREFIX("runtime_error")), - void_type_node, - 3, - pchar_type_node, pchar_type_node, - gfc_int4_type_node); + void_type_node, 1, pchar_type_node); /* The runtime_error function does not return. */ TREE_THIS_VOLATILE (gfor_fndecl_runtime_error) = 1; diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 752609c4929..c0422b1aaf8 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -472,7 +472,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); + gfc_conv_array_ref (se, &ref->u.ar, sym, &expr->where); /* Return a pointer to an element. */ break; @@ -2153,7 +2153,7 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym, tmp = gfc_conv_descriptor_data_get (info->descriptor); tmp = fold_build2 (NE_EXPR, boolean_type_node, tmp, info->data); - gfc_trans_runtime_check (tmp, gfc_strconst_fault, &se->pre); + gfc_trans_runtime_check (tmp, gfc_msg_fault, &se->pre, NULL); } se->expr = info->descriptor; /* Bundle in the string length. */ diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index c361ad4021f..e8fe286e402 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -761,7 +761,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_strconst_fault, &se->pre); + gfc_trans_runtime_check (cond, gfc_msg_fault, &se->pre, NULL); } } diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c index b4c83f49f86..e56232140a4 100644 --- a/gcc/fortran/trans-io.c +++ b/gcc/fortran/trans-io.c @@ -518,7 +518,6 @@ set_string (stmtblock_t * block, stmtblock_t * postblock, tree var, { gfc_se se; tree tmp; - tree msg; tree io; tree len; gfc_st_parameter_field *p = &st_parameter_field[type]; @@ -536,13 +535,18 @@ set_string (stmtblock_t * block, stmtblock_t * postblock, tree var, /* Integer variable assigned a format label. */ if (e->ts.type == BT_INTEGER && e->symtree->n.sym->attr.assign == 1) { + char * msg; + gfc_conv_label_variable (&se, e); - msg = - gfc_build_cstring_const ("Assigned label is not a format label"); tmp = GFC_DECL_STRING_LEN (se.expr); tmp = fold_build2 (LT_EXPR, boolean_type_node, tmp, build_int_cst (TREE_TYPE (tmp), 0)); - gfc_trans_runtime_check (tmp, msg, &se.pre); + + asprintf(&msg, "Label assigned to variable '%s' is not a format label", + e->symtree->name); + gfc_trans_runtime_check (tmp, msg, &se.pre, &e->where); + gfc_free (msg); + gfc_add_modify_expr (&se.pre, io, fold_convert (TREE_TYPE (io), GFC_DECL_ASSIGN_ADDR (se.expr))); gfc_add_modify_expr (&se.pre, len, GFC_DECL_STRING_LEN (se.expr)); diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index 562e6f1462b..ef7d680bd9c 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -31,6 +31,7 @@ Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA #include "toplev.h" #include "real.h" #include "gfortran.h" +#include "flags.h" #include "trans.h" #include "trans-stmt.h" #include "trans-types.h" @@ -139,14 +140,12 @@ gfc_trans_label_assign (gfc_code * code) tree gfc_trans_goto (gfc_code * code) { + locus loc = code->loc; tree assigned_goto; tree target; tree tmp; - tree assign_error; - tree range_error; gfc_se se; - if (code->label != NULL) return build1_v (GOTO_EXPR, gfc_get_label_decl (code->label)); @@ -154,12 +153,11 @@ gfc_trans_goto (gfc_code * code) gfc_init_se (&se, NULL); gfc_start_block (&se.pre); gfc_conv_label_variable (&se, code->expr); - assign_error = - gfc_build_cstring_const ("Assigned label is not a target label"); tmp = GFC_DECL_STRING_LEN (se.expr); tmp = fold_build2 (NE_EXPR, boolean_type_node, tmp, build_int_cst (TREE_TYPE (tmp), -1)); - gfc_trans_runtime_check (tmp, assign_error, &se.pre); + gfc_trans_runtime_check (tmp, "Assigned label is not a target label", + &se.pre, &loc); assigned_goto = GFC_DECL_ASSIGN_ADDR (se.expr); @@ -172,8 +170,6 @@ gfc_trans_goto (gfc_code * code) } /* Check the label list. */ - range_error = gfc_build_cstring_const ("Assigned label is not in the list"); - do { target = gfc_get_label_decl (code->label); @@ -186,7 +182,9 @@ gfc_trans_goto (gfc_code * code) code = code->block; } while (code != NULL); - gfc_trans_runtime_check (boolean_true_node, range_error, &se.pre); + gfc_trans_runtime_check (boolean_true_node, + "Assigned label is not in the list", &se.pre, &loc); + return gfc_finish_block (&se.pre); } diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c index 3eec75c3444..d4856fde02b 100644 --- a/gcc/fortran/trans.c +++ b/gcc/fortran/trans.c @@ -46,6 +46,10 @@ Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA static gfc_file *gfc_current_backend_file; +char gfc_msg_bounds[] = N_("Array bound mismatch"); +char gfc_msg_fault[] = N_("Array reference out of bounds"); +char gfc_msg_wrong_return[] = N_("Incorrect function return value"); + /* Advance along TREE_CHAIN n times. */ @@ -302,12 +306,15 @@ gfc_build_array_ref (tree base, tree offset) /* Generate a runtime error if COND is true. */ void -gfc_trans_runtime_check (tree cond, tree msg, stmtblock_t * pblock) +gfc_trans_runtime_check (tree cond, const char * msgid, stmtblock_t * pblock, + locus * where) { stmtblock_t block; tree body; tree tmp; tree args; + char * message; + int line; if (integer_zerop (cond)) return; @@ -315,19 +322,24 @@ gfc_trans_runtime_check (tree cond, tree msg, stmtblock_t * pblock) /* The code to generate the error. */ gfc_start_block (&block); - gcc_assert (TREE_CODE (msg) == STRING_CST); - - TREE_USED (msg) = 1; + if (where) + { +#ifdef USE_MAPPED_LOCATION + line = LOCATION_LINE (where->lb->location); +#else + line = where->lb->linenum; +#endif + asprintf (&message, "%s (in file '%s', at line %d)", _(msgid), + where->lb->file->filename, line); + } + else + asprintf (&message, "%s (in file '%s', around line %d)", _(msgid), + gfc_source_file, input_line + 1); - tmp = gfc_build_addr_expr (pchar_type_node, msg); + tmp = gfc_build_addr_expr (pchar_type_node, gfc_build_cstring_const(message)); + gfc_free(message); args = gfc_chainon_list (NULL_TREE, tmp); - tmp = gfc_build_addr_expr (pchar_type_node, gfc_strconst_current_filename); - args = gfc_chainon_list (args, tmp); - - tmp = build_int_cst (NULL_TREE, input_line); - args = gfc_chainon_list (args, tmp); - tmp = build_function_call_expr (gfor_fndecl_runtime_error, args); gfc_add_expr_to_block (&block, tmp); diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 78a5d156103..738ed0261bd 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -423,7 +423,7 @@ void gfc_generate_constructors (void); bool get_array_ctor_strlen (gfc_constructor *, tree *); /* Generate a runtime error check. */ -void gfc_trans_runtime_check (tree, tree, stmtblock_t *); +void gfc_trans_runtime_check (tree, const char *, stmtblock_t *, locus *); /* Generate code for an assignment, includes scalarization. */ tree gfc_trans_assignment (gfc_expr *, gfc_expr *); @@ -674,4 +674,11 @@ void gfc_finish_interface_mapping (gfc_interface_mapping *, void gfc_apply_interface_mapping (gfc_interface_mapping *, gfc_se *, gfc_expr *); + +/* Standard error messages used in all the trans-*.c files. */ +extern char gfc_msg_bounds[]; +extern char gfc_msg_fault[]; +extern char gfc_msg_wrong_return[]; + + #endif /* GFC_TRANS_H */