From c8fe94c7ea3debcf5b41cfabfe0ca395b1834da4 Mon Sep 17 00:00:00 2001 From: Francois-Xavier Coudert Date: Fri, 10 Aug 2007 22:12:04 +0000 Subject: [PATCH] re PR fortran/31270 (print subscript value and array bounds when out-of-bounds error occurs) PR fortran/31270 * trans.c (gfc_trans_runtime_check): Reorder arguments and add extra variable arguments. Hand them to the library function. * trans.h (gfc_trans_runtime_check): Update prototype. * trans-array.c (gfc_trans_array_bound_check): Issue more detailled error messages. (gfc_conv_array_ref): Likewise. (gfc_conv_ss_startstride): Likewise. (gfc_trans_dummy_array_bias): Reorder arguments to gfc_trans_runtime_check. * trans-expr.c (gfc_conv_substring): Issue more detailled error messages. (gfc_conv_function_call): Reorder arguments to gfc_trans_runtime_check. * trans-stmt.c (gfc_trans_goto): Likewise. * trans-io.c (set_string): Reorder arguments to gfc_trans_runtime_check and issue a more detailled error message. * trans-decl.c (gfc_build_builtin_function_decls): Make runtime_error and runtime_error_at handle a variable number of arguments. * trans-intrinsic.c (gfc_conv_intrinsic_bound): Reorder arguments to gfc_trans_runtime_check. (gfc_conv_intrinsic_minmax): Likewise. (gfc_conv_intrinsic_repeat): Issue more detailled error messages. * runtime/error.c (runtime_error_at): Add a variable number of arguments. * libgfortran.h (runtime_error_at): Update prototype. From-SVN: r127352 --- gcc/fortran/ChangeLog | 26 +++++++++++ gcc/fortran/trans-array.c | 84 +++++++++++++++++++++++------------ gcc/fortran/trans-decl.c | 4 +- gcc/fortran/trans-expr.c | 23 ++++++---- gcc/fortran/trans-intrinsic.c | 19 ++++---- gcc/fortran/trans-io.c | 12 ++--- gcc/fortran/trans-stmt.c | 8 ++-- gcc/fortran/trans.c | 37 +++++++++++++-- gcc/fortran/trans.h | 2 +- libgfortran/ChangeLog | 7 +++ libgfortran/libgfortran.h | 4 +- libgfortran/runtime/error.c | 10 ++++- 12 files changed, 169 insertions(+), 67 deletions(-) diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index d9a75808e58..d768b08e4da 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,29 @@ +2007-08-10 Francois-Xavier Coudert + + PR fortran/31270 + * trans.c (gfc_trans_runtime_check): Reorder arguments and + add extra variable arguments. Hand them to the library function. + * trans.h (gfc_trans_runtime_check): Update prototype. + * trans-array.c (gfc_trans_array_bound_check): Issue more + detailled error messages. + (gfc_conv_array_ref): Likewise. + (gfc_conv_ss_startstride): Likewise. + (gfc_trans_dummy_array_bias): Reorder arguments to + gfc_trans_runtime_check. + * trans-expr.c (gfc_conv_substring): Issue more detailled + error messages. + (gfc_conv_function_call): Reorder arguments to gfc_trans_runtime_check. + * trans-stmt.c (gfc_trans_goto): Likewise. + * trans-io.c (set_string): Reorder arguments to + gfc_trans_runtime_check and issue a more detailled error message. + * trans-decl.c (gfc_build_builtin_function_decls): Make + runtime_error and runtime_error_at handle a variable number of + arguments. + * trans-intrinsic.c (gfc_conv_intrinsic_bound): Reorder arguments + to gfc_trans_runtime_check. + (gfc_conv_intrinsic_minmax): Likewise. + (gfc_conv_intrinsic_repeat): Issue more detailled error messages. + 2007-08-10 Kaveh R. Ghazi * gfortranspec.c (lang_specific_driver): Use CONST_CAST. diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index abbf8f63eb1..78b038a4ee7 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -2097,9 +2097,11 @@ gfc_trans_array_bound_check (gfc_se * se, tree descriptor, tree index, int n, asprintf (&msg, "%s for array '%s', lower bound of dimension %d exceeded", gfc_msg_fault, 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, where); + asprintf (&msg, "%s, lower bound of dimension %d exceeded, %%ld is " + "smaller than %%ld", gfc_msg_fault, n+1); + gfc_trans_runtime_check (fault, &se->pre, where, msg, + fold_convert (long_integer_type_node, index), + fold_convert (long_integer_type_node, tmp)); gfc_free (msg); /* Check upper bound. */ @@ -2111,9 +2113,11 @@ gfc_trans_array_bound_check (gfc_se * se, tree descriptor, tree index, int n, asprintf (&msg, "%s for array '%s', upper bound of dimension %d " " exceeded", gfc_msg_fault, 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, where); + asprintf (&msg, "%s, upper bound of dimension %d exceeded, %%ld is " + "larger than %%ld", gfc_msg_fault, n+1); + gfc_trans_runtime_check (fault, &se->pre, where, msg, + fold_convert (long_integer_type_node, index), + fold_convert (long_integer_type_node, tmp)); gfc_free (msg); } @@ -2300,9 +2304,12 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_symbol * sym, cond = fold_build2 (LT_EXPR, boolean_type_node, indexse.expr, tmp); 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); + "lower bound of dimension %d exceeded, %%ld is smaller " + "than %%ld", gfc_msg_fault, sym->name, n+1); + gfc_trans_runtime_check (cond, &se->pre, where, msg, + fold_convert (long_integer_type_node, + indexse.expr), + fold_convert (long_integer_type_node, tmp)); gfc_free (msg); /* Upper bound, but not for the last dimension of assumed-size @@ -2314,9 +2321,12 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_symbol * sym, cond = fold_build2 (GT_EXPR, boolean_type_node, indexse.expr, tmp); 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); + "upper bound of dimension %d exceeded, %%ld is " + "greater than %%ld", gfc_msg_fault, sym->name, n+1); + gfc_trans_runtime_check (cond, &se->pre, where, msg, + fold_convert (long_integer_type_node, + indexse.expr), + fold_convert (long_integer_type_node, tmp)); gfc_free (msg); } } @@ -2872,7 +2882,7 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop) asprintf (&msg, "Zero stride is not allowed, for dimension %d " "of array '%s'", info->dim[n]+1, ss->expr->symtree->name); - gfc_trans_runtime_check (tmp, msg, &block, &ss->expr->where); + gfc_trans_runtime_check (tmp, &block, &ss->expr->where, msg); gfc_free (msg); desc = ss->data.info.descriptor; @@ -2912,9 +2922,13 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop) tmp = fold_build2 (TRUTH_AND_EXPR, boolean_type_node, non_zerosized, tmp); asprintf (&msg, "%s, lower bound of dimension %d of array '%s'" - " exceeded", gfc_msg_fault, info->dim[n]+1, - ss->expr->symtree->name); - gfc_trans_runtime_check (tmp, msg, &block, &ss->expr->where); + " exceeded, %%ld is smaller than %%ld", gfc_msg_fault, + info->dim[n]+1, ss->expr->symtree->name); + gfc_trans_runtime_check (tmp, &block, &ss->expr->where, msg, + fold_convert (long_integer_type_node, + info->start[n]), + fold_convert (long_integer_type_node, + lbound)); gfc_free (msg); if (check_upper) @@ -2924,9 +2938,12 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop) tmp = fold_build2 (TRUTH_AND_EXPR, boolean_type_node, non_zerosized, tmp); asprintf (&msg, "%s, upper bound of dimension %d of array " - "'%s' exceeded", gfc_msg_fault, info->dim[n]+1, + "'%s' exceeded, %%ld is greater than %%ld", + gfc_msg_fault, info->dim[n]+1, ss->expr->symtree->name); - gfc_trans_runtime_check (tmp, msg, &block, &ss->expr->where); + gfc_trans_runtime_check (tmp, &block, &ss->expr->where, msg, + fold_convert (long_integer_type_node, info->start[n]), + fold_convert (long_integer_type_node, ubound)); gfc_free (msg); } @@ -2944,9 +2961,13 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop) tmp = fold_build2 (TRUTH_AND_EXPR, boolean_type_node, non_zerosized, tmp); asprintf (&msg, "%s, lower bound of dimension %d of array '%s'" - " exceeded", gfc_msg_fault, info->dim[n]+1, - ss->expr->symtree->name); - gfc_trans_runtime_check (tmp, msg, &block, &ss->expr->where); + " exceeded, %%ld is smaller than %%ld", gfc_msg_fault, + info->dim[n]+1, ss->expr->symtree->name); + gfc_trans_runtime_check (tmp, &block, &ss->expr->where, msg, + fold_convert (long_integer_type_node, + tmp2), + fold_convert (long_integer_type_node, + lbound)); gfc_free (msg); if (check_upper) @@ -2955,9 +2976,12 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop) tmp = fold_build2 (TRUTH_AND_EXPR, boolean_type_node, non_zerosized, tmp); asprintf (&msg, "%s, upper bound of dimension %d of array " - "'%s' exceeded", gfc_msg_fault, info->dim[n]+1, + "'%s' exceeded, %%ld is greater than %%ld", + gfc_msg_fault, info->dim[n]+1, ss->expr->symtree->name); - gfc_trans_runtime_check (tmp, msg, &block, &ss->expr->where); + gfc_trans_runtime_check (tmp, &block, &ss->expr->where, msg, + fold_convert (long_integer_type_node, tmp2), + fold_convert (long_integer_type_node, ubound)); gfc_free (msg); } @@ -2970,12 +2994,14 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop) others against this. */ if (size[n]) { - tmp = - fold_build2 (NE_EXPR, boolean_type_node, tmp, size[n]); + tree tmp3 + = fold_build2 (NE_EXPR, boolean_type_node, tmp, size[n]); asprintf (&msg, "%s, size mismatch for dimension %d " - "of array '%s'", gfc_msg_bounds, info->dim[n]+1, - ss->expr->symtree->name); - gfc_trans_runtime_check (tmp, msg, &block, &ss->expr->where); + "of array '%s' (%%ld/%%ld)", gfc_msg_bounds, + info->dim[n]+1, ss->expr->symtree->name); + gfc_trans_runtime_check (tmp3, &block, &ss->expr->where, msg, + fold_convert (long_integer_type_node, tmp), + fold_convert (long_integer_type_node, size[n])); gfc_free (msg); } else @@ -4194,7 +4220,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, &loc); + gfc_trans_runtime_check (tmp, &block, &loc, msg); gfc_free (msg); } } diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index cf6d9d26b0a..58cbc37b4f5 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -2340,13 +2340,13 @@ gfc_build_builtin_function_decls (void) gfor_fndecl_runtime_error = gfc_build_library_function_decl (get_identifier (PREFIX("runtime_error")), - void_type_node, 1, pchar_type_node); + void_type_node, -1, pchar_type_node); /* The runtime_error function does not return. */ TREE_THIS_VOLATILE (gfor_fndecl_runtime_error) = 1; gfor_fndecl_runtime_error_at = gfc_build_library_function_decl (get_identifier (PREFIX("runtime_error_at")), - void_type_node, 2, pchar_type_node, + void_type_node, -2, pchar_type_node, pchar_type_node); /* The runtime_error_at function does not return. */ TREE_THIS_VOLATILE (gfor_fndecl_runtime_error_at) = 1; diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 674448b7a44..b24a8ac76c5 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -296,12 +296,14 @@ gfc_conv_substring (gfc_se * se, gfc_ref * ref, int kind, fault = fold_build2 (TRUTH_ANDIF_EXPR, boolean_type_node, nonempty, fault); if (name) - asprintf (&msg, "Substring out of bounds: lower bound of '%s' " + asprintf (&msg, "Substring out of bounds: lower bound (%%ld) of '%s' " "is less than one", name); else - asprintf (&msg, "Substring out of bounds: lower bound " + asprintf (&msg, "Substring out of bounds: lower bound (%%ld)" "is less than one"); - gfc_trans_runtime_check (fault, msg, &se->pre, where); + gfc_trans_runtime_check (fault, &se->pre, where, msg, + fold_convert (long_integer_type_node, + start.expr)); gfc_free (msg); /* Check upper bound. */ @@ -310,12 +312,15 @@ gfc_conv_substring (gfc_se * se, gfc_ref * ref, int kind, fault = fold_build2 (TRUTH_ANDIF_EXPR, boolean_type_node, nonempty, fault); if (name) - asprintf (&msg, "Substring out of bounds: upper bound of '%s' " - "exceeds string length", name); + asprintf (&msg, "Substring out of bounds: upper bound (%%ld) of '%s' " + "exceeds string length (%%ld)", name); else - asprintf (&msg, "Substring out of bounds: upper bound " - "exceeds string length"); - gfc_trans_runtime_check (fault, msg, &se->pre, where); + asprintf (&msg, "Substring out of bounds: upper bound (%%ld) " + "exceeds string length (%%ld)"); + gfc_trans_runtime_check (fault, &se->pre, where, msg, + fold_convert (long_integer_type_node, end.expr), + fold_convert (long_integer_type_node, + se->string_length)); gfc_free (msg); } @@ -2589,7 +2594,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_msg_fault, &se->pre, NULL); + gfc_trans_runtime_check (tmp, &se->pre, NULL, gfc_msg_fault); } se->expr = info->descriptor; /* Bundle in the string length. */ diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 8849e446184..b9dbf464c46 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -855,7 +855,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, &expr->where); + gfc_trans_runtime_check (cond, &se->pre, &expr->where, gfc_msg_fault); } } @@ -1485,7 +1485,7 @@ gfc_conv_intrinsic_minmax (gfc_se * se, gfc_expr * expr, int op) expr->symtree->n.sym->name); cond = build2 (EQ_EXPR, boolean_type_node, TREE_OPERAND (args[0], 0), build_int_cst (TREE_TYPE (TREE_OPERAND (args[0], 0)), 0)); - gfc_trans_runtime_check (cond, msg, &se->pre, &expr->where); + gfc_trans_runtime_check (cond, &se->pre, &expr->where, msg); gfc_free (msg); } @@ -1501,7 +1501,7 @@ gfc_conv_intrinsic_minmax (gfc_se * se, gfc_expr * expr, int op) expr->symtree->n.sym->name); cond = build2 (EQ_EXPR, boolean_type_node, TREE_OPERAND (args[1], 0), build_int_cst (TREE_TYPE (TREE_OPERAND (args[1], 0)), 0)); - gfc_trans_runtime_check (cond, msg, &se->pre, &expr->where); + gfc_trans_runtime_check (cond, &se->pre, &expr->where, msg); gfc_free (msg); } @@ -3665,9 +3665,10 @@ gfc_conv_intrinsic_repeat (gfc_se * se, gfc_expr * expr) /* Check that NCOPIES is not negative. */ cond = fold_build2 (LT_EXPR, boolean_type_node, ncopies, build_int_cst (ncopies_type, 0)); - gfc_trans_runtime_check (cond, - "Argument NCOPIES of REPEAT intrinsic is negative", - &se->pre, &expr->where); + gfc_trans_runtime_check (cond, &se->pre, &expr->where, + "Argument NCOPIES of REPEAT intrinsic is negative " + "(its value is %lld)", + fold_convert (long_integer_type_node, ncopies)); /* If the source length is zero, any non negative value of NCOPIES is valid, and nothing happens. */ @@ -3696,9 +3697,9 @@ gfc_conv_intrinsic_repeat (gfc_se * se, gfc_expr * expr) build_int_cst (size_type_node, 0)); cond = fold_build3 (COND_EXPR, boolean_type_node, tmp, boolean_false_node, cond); - gfc_trans_runtime_check (cond, - "Argument NCOPIES of REPEAT intrinsic is too large", - &se->pre, &expr->where); + gfc_trans_runtime_check (cond, &se->pre, &expr->where, + "Argument NCOPIES of REPEAT intrinsic is too large"); + /* Compute the destination length. */ dlen = fold_build2 (MULT_EXPR, gfc_charlen_type_node, diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c index 0fa81c81daf..80646cd0819 100644 --- a/gcc/fortran/trans-io.c +++ b/gcc/fortran/trans-io.c @@ -653,15 +653,17 @@ set_string (stmtblock_t * block, stmtblock_t * postblock, tree var, if (e->ts.type == BT_INTEGER && e->symtree->n.sym->attr.assign == 1) { char * msg; + tree cond; gfc_conv_label_variable (&se, e); tmp = GFC_DECL_STRING_LEN (se.expr); - tmp = fold_build2 (LT_EXPR, boolean_type_node, - tmp, build_int_cst (TREE_TYPE (tmp), 0)); + cond = fold_build2 (LT_EXPR, boolean_type_node, + tmp, build_int_cst (TREE_TYPE (tmp), 0)); - 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); + asprintf(&msg, "Label assigned to variable '%s' (%%ld) is not a format " + "label", e->symtree->name); + gfc_trans_runtime_check (cond, &se.pre, &e->where, msg, + fold_convert (long_integer_type_node, tmp)); gfc_free (msg); gfc_add_modify_expr (&se.pre, io, diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index 2e2be2fb2d3..47e08229fe9 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -153,8 +153,8 @@ gfc_trans_goto (gfc_code * code) 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, "Assigned label is not a target label", - &se.pre, &loc); + gfc_trans_runtime_check (tmp, &se.pre, &loc, + "Assigned label is not a target label"); assigned_goto = GFC_DECL_ASSIGN_ADDR (se.expr); @@ -179,8 +179,8 @@ gfc_trans_goto (gfc_code * code) code = code->block; } while (code != NULL); - gfc_trans_runtime_check (boolean_true_node, - "Assigned label is not in the list", &se.pre, &loc); + gfc_trans_runtime_check (boolean_true_node, &se.pre, &loc, + "Assigned label is not in the list"); return gfc_finish_block (&se.pre); } diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c index 38375afd34f..79112e590ea 100644 --- a/gcc/fortran/trans.c +++ b/gcc/fortran/trans.c @@ -320,19 +320,32 @@ gfc_build_array_ref (tree base, tree offset) /* Generate a runtime error if COND is true. */ void -gfc_trans_runtime_check (tree cond, const char * msgid, stmtblock_t * pblock, - locus * where) +gfc_trans_runtime_check (tree cond, stmtblock_t * pblock, locus * where, + const char * msgid, ...) { + va_list ap; stmtblock_t block; tree body; tree tmp; tree arg, arg2; + tree *argarray; + tree fntype; char *message; - int line; + const char *p; + int line, nargs, i; if (integer_zerop (cond)) return; + /* Compute the number of extra arguments from the format string. */ + for (p = msgid, nargs = 0; *p; p++) + if (*p == '%') + { + p++; + if (*p != '%') + nargs++; + } + /* The code to generate the error. */ gfc_start_block (&block); @@ -357,7 +370,23 @@ gfc_trans_runtime_check (tree cond, const char * msgid, stmtblock_t * pblock, arg2 = gfc_build_addr_expr (pchar_type_node, gfc_build_cstring_const(message)); gfc_free(message); - tmp = build_call_expr (gfor_fndecl_runtime_error_at, 2, arg, arg2); + /* Build the argument array. */ + argarray = (tree *) alloca (sizeof (tree) * (nargs + 2)); + argarray[0] = arg; + argarray[1] = arg2; + va_start (ap, msgid); + for (i = 0; i < nargs; i++) + argarray[2+i] = va_arg (ap, tree); + va_end (ap); + + /* Build the function call to runtime_error_at; because of the variable + number of arguments, we can't use build_call_expr directly. */ + fntype = TREE_TYPE (gfor_fndecl_runtime_error_at); + tmp = fold_builtin_call_array (TREE_TYPE (fntype), + build1 (ADDR_EXPR, + build_pointer_type (fntype), + gfor_fndecl_runtime_error_at), + nargs + 2, argarray); gfc_add_expr_to_block (&block, tmp); body = gfc_finish_block (&block); diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 645f9a3d78d..829551e7b45 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -442,7 +442,7 @@ void gfc_generate_constructors (void); bool get_array_ctor_strlen (stmtblock_t *, gfc_constructor *, tree *); /* Generate a runtime error check. */ -void gfc_trans_runtime_check (tree, const char *, stmtblock_t *, locus *); +void gfc_trans_runtime_check (tree, stmtblock_t *, locus *, const char *, ...); /* Generate a call to free() after checking that its arg is non-NULL. */ tree gfc_call_free (tree); diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index b77eeef9a06..46f7282a639 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,10 @@ +2007-08-10 Francois-Xavier Coudert + + PR fortran/31270 + * runtime/error.c (runtime_error_at): Add a variable number of + arguments. + * libgfortran.h (runtime_error_at): Update prototype. + 2007-08-10 Francois-Xavier Coudert PR fortran/32933 diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h index ce6d621455b..c32b5a37e06 100644 --- a/libgfortran/libgfortran.h +++ b/libgfortran/libgfortran.h @@ -599,8 +599,8 @@ extern void runtime_error (const char *, ...) __attribute__ ((noreturn, format (printf, 1, 2))); iexport_proto(runtime_error); -extern void runtime_error_at (const char *, const char *) -__attribute__ ((noreturn)); +extern void runtime_error_at (const char *, const char *, ...) + __attribute__ ((noreturn, format (printf, 2, 3))); iexport_proto(runtime_error_at); extern void internal_error (st_parameter_common *, const char *) diff --git a/libgfortran/runtime/error.c b/libgfortran/runtime/error.c index 4dda2277dcc..3512ab4e031 100644 --- a/libgfortran/runtime/error.c +++ b/libgfortran/runtime/error.c @@ -267,11 +267,17 @@ iexport(runtime_error); * run time error generated by the front end compiler. */ void -runtime_error_at (const char *where, const char *message) +runtime_error_at (const char *where, const char *message, ...) { + va_list ap; + recursion_check (); st_printf ("%s\n", where); - st_printf ("Fortran runtime error: %s\n", message); + st_printf ("Fortran runtime error: "); + va_start (ap, message); + st_vprintf (message, ap); + va_end (ap); + st_printf ("\n"); sys_exit (2); } iexport(runtime_error_at);