From fea70c996318f9b987ae9da6d35d6b24ca720f5c Mon Sep 17 00:00:00 2001 From: =?utf8?q?Manuel=20L=C3=B3pez-Ib=C3=A1=C3=B1ez?= Date: Sat, 23 May 2015 23:02:52 +0000 Subject: [PATCH] re PR fortran/44054 (Handle -Werror, -Werror=, -fdiagnostics-show-option, !GCC$ diagnostic (pragmas) and color) MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit gcc/fortran/ChangeLog: 2015-05-24 Manuel López-Ibáñez PR fortran/44054 * gfortran.h (struct gfc_error_buf): Rename as gfc_error_buffer. Move closer to push, pop and free methods. Reimplement using an output_buffer. * error.c (errors, warnings, warning_buffer, cur_error_buffer): Delete everywhere in this file. (error_char): Delete all contents. (gfc_increment_error_count): Delete. (gfc_error_now): Update comment. Set error_buffer.flag. (gfc_warning_check): Do not handle warning_buffer. (gfc_error_1): Delete. (gfc_error_now_1): Delete. (gfc_error_check): Simplify. (gfc_move_error_buffer_from_to): Renamed from gfc_move_output_buffer_from_to. (gfc_push_error): Handle only gfc_error_buffer. (gfc_pop_error): Likewise. (gfc_free_error): Likewise. (gfc_get_errors): Remove warnings and errors. (gfc_diagnostics_init): Use static error_buffer. (gfc_error_1,gfc_error_now_1): Delete declarations. * symbol.c, decl.c, trans-common.c, data.c, expr.c, expr.c, frontend-passes.c, resolve.c, match.c, parse.c: Replace gfc_error_1 with gfc_error and gfc_error_now_1 with gfc_error_1 everywhere. * f95-lang.c (gfc_be_parse_file): Do not update errorcount and warningcount here. * primary.c (match_complex_constant): Replace gfc_error_buf and output_buffer with gfc_error_buffer. From-SVN: r223614 --- gcc/fortran/ChangeLog | 32 +++++ gcc/fortran/check.c | 32 ++--- gcc/fortran/data.c | 6 +- gcc/fortran/decl.c | 22 ++-- gcc/fortran/error.c | 230 +++++----------------------------- gcc/fortran/expr.c | 14 +-- gcc/fortran/f95-lang.c | 8 -- gcc/fortran/frontend-passes.c | 44 +++---- gcc/fortran/gfortran.h | 25 ++-- gcc/fortran/match.c | 29 +++-- gcc/fortran/parse.c | 23 ++-- gcc/fortran/primary.c | 13 +- gcc/fortran/resolve.c | 72 +++++------ gcc/fortran/symbol.c | 20 +-- gcc/fortran/trans-common.c | 4 +- 15 files changed, 211 insertions(+), 363 deletions(-) diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 9ce4b567eae..420a99d7788 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,35 @@ +2015-05-24 Manuel López-Ibáñez + + PR fortran/44054 + * gfortran.h (struct gfc_error_buf): Rename as + gfc_error_buffer. Move closer to push, pop and free + methods. Reimplement using an output_buffer. + * error.c (errors, warnings, warning_buffer, cur_error_buffer): + Delete everywhere in this file. + (error_char): Delete all contents. + (gfc_increment_error_count): Delete. + (gfc_error_now): Update comment. Set error_buffer.flag. + (gfc_warning_check): Do not handle warning_buffer. + (gfc_error_1): Delete. + (gfc_error_now_1): Delete. + (gfc_error_check): Simplify. + (gfc_move_error_buffer_from_to): Renamed from + gfc_move_output_buffer_from_to. + (gfc_push_error): Handle only gfc_error_buffer. + (gfc_pop_error): Likewise. + (gfc_free_error): Likewise. + (gfc_get_errors): Remove warnings and errors. + (gfc_diagnostics_init): Use static error_buffer. + (gfc_error_1,gfc_error_now_1): Delete declarations. + * symbol.c, decl.c, trans-common.c, data.c, expr.c, expr.c, + frontend-passes.c, resolve.c, match.c, parse.c: Replace + gfc_error_1 with gfc_error and gfc_error_now_1 with gfc_error_1 + everywhere. + * f95-lang.c (gfc_be_parse_file): Do not update errorcount and + warningcount here. + * primary.c (match_complex_constant): Replace gfc_error_buf and + output_buffer with gfc_error_buffer. + 2015-05-22 Jim Wilson * Make-lang.in (check_gfortran_parallelize): Update comment. diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index a6ba549f296..3286a58df5c 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -1031,8 +1031,8 @@ gfc_check_atomic (gfc_expr *atom, int atom_no, gfc_expr *value, int val_no, if (atom->ts.type != value->ts.type) { - gfc_error_1 ("'%s' argument of '%s' intrinsic at %L shall have the same " - "type as '%s' at %L", gfc_current_intrinsic_arg[val_no]->name, + gfc_error ("%qs argument of %qs intrinsic at %L shall have the same " + "type as %qs at %L", gfc_current_intrinsic_arg[val_no]->name, gfc_current_intrinsic, &value->where, gfc_current_intrinsic_arg[atom_no]->name, &atom->where); return false; @@ -1575,7 +1575,7 @@ gfc_check_co_reduce (gfc_expr *a, gfc_expr *op, gfc_expr *result_image, if (!gfc_compare_types (&a->ts, &sym->result->ts)) { - gfc_error_1 ("A argument at %L has type %s but the function passed as " + gfc_error ("A argument at %L has type %s but the function passed as " "OPERATOR at %L returns %s", &a->where, gfc_typename (&a->ts), &op->where, gfc_typename (&sym->result->ts)); @@ -1655,16 +1655,16 @@ gfc_check_co_reduce (gfc_expr *a, gfc_expr *op, gfc_expr *result_image, && ((formal_size1 && actual_size != formal_size1) || (formal_size2 && actual_size != formal_size2))) { - gfc_error_1 ("The character length of the A argument at %L and of the " - "arguments of the OPERATOR at %L shall be the same", + gfc_error ("The character length of the A argument at %L and of the " + "arguments of the OPERATOR at %L shall be the same", &a->where, &op->where); return false; } if (actual_size && result_size && actual_size != result_size) { - gfc_error_1 ("The character length of the A argument at %L and of the " - "function result of the OPERATOR at %L shall be the same", - &a->where, &op->where); + gfc_error ("The character length of the A argument at %L and of the " + "function result of the OPERATOR at %L shall be the same", + &a->where, &op->where); return false; } } @@ -1680,10 +1680,10 @@ gfc_check_co_minmax (gfc_expr *a, gfc_expr *result_image, gfc_expr *stat, if (a->ts.type != BT_INTEGER && a->ts.type != BT_REAL && a->ts.type != BT_CHARACTER) { - gfc_error_1 ("'%s' argument of '%s' intrinsic at %L shall be of type " - "integer, real or character", - gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic, - &a->where); + gfc_error ("%qs argument of %qs intrinsic at %L shall be of type " + "integer, real or character", + gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic, + &a->where); return false; } return check_co_collective (a, result_image, stat, errmsg, false); @@ -1956,7 +1956,7 @@ gfc_check_dshift (gfc_expr *i, gfc_expr *j, gfc_expr *shift) if (i->is_boz && j->is_boz) { - gfc_error_1 ("'I' at %L and 'J' at %L cannot both be BOZ literal " + gfc_error ("% at %L and %' at %L cannot both be BOZ literal " "constants", &i->where, &j->where); return false; } @@ -2472,9 +2472,9 @@ gfc_check_ishftc (gfc_expr *i, gfc_expr *shift, gfc_expr *size) if (i2 > i3) { - gfc_error_1 ("The absolute value of SHIFT at %L must be less " - "than or equal to SIZE at %L", &shift->where, - &size->where); + gfc_error ("The absolute value of SHIFT at %L must be less " + "than or equal to SIZE at %L", &shift->where, + &size->where); return false; } } diff --git a/gcc/fortran/data.c b/gcc/fortran/data.c index 4fd84e4b415..ef9101b8d55 100644 --- a/gcc/fortran/data.c +++ b/gcc/fortran/data.c @@ -253,9 +253,9 @@ gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index, if (init && expr->expr_type != EXPR_ARRAY) { - gfc_error_1 ("'%s' at %L already is initialized at %L", - lvalue->symtree->n.sym->name, &lvalue->where, - &init->where); + gfc_error ("%qs at %L already is initialized at %L", + lvalue->symtree->n.sym->name, &lvalue->where, + &init->where); goto abort; } diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 086a20ea6d8..e2fd670de39 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -921,17 +921,17 @@ get_proc_name (const char *name, gfc_symbol **result, bool module_fcn_entry) && sym->attr.proc != 0 && (sym->attr.subroutine || sym->attr.function) && sym->attr.if_source != IFSRC_UNKNOWN) - gfc_error_now_1 ("Procedure '%s' at %C is already defined at %L", - name, &sym->declared_at); + gfc_error_now ("Procedure %qs at %C is already defined at %L", + name, &sym->declared_at); /* Trap a procedure with a name the same as interface in the encompassing scope. */ if (sym->attr.generic != 0 && (sym->attr.subroutine || sym->attr.function) && !sym->attr.mod_proc) - gfc_error_now_1 ("Name '%s' at %C is already defined" - " as a generic interface at %L", - name, &sym->declared_at); + gfc_error_now ("Name %qs at %C is already defined" + " as a generic interface at %L", + name, &sym->declared_at); /* Trap declarations of attributes in encompassing scope. The signature for this is that ts.kind is set. Legitimate @@ -942,9 +942,9 @@ get_proc_name (const char *name, gfc_symbol **result, bool module_fcn_entry) && gfc_current_ns->parent != NULL && sym->attr.access == 0 && !module_fcn_entry) - gfc_error_now_1 ("Procedure '%s' at %C has an explicit interface " - "and must not have attributes declared at %L", - name, &sym->declared_at); + gfc_error_now ("Procedure %qs at %C has an explicit interface " + "and must not have attributes declared at %L", + name, &sym->declared_at); } if (gfc_current_ns->parent == NULL || *result == NULL) @@ -2868,9 +2868,9 @@ gfc_match_decl_type_spec (gfc_typespec *ts, int implicit_flag) && !(sym->attr.flavor == FL_PROCEDURE && sym->attr.generic)) || sym->attr.subroutine) { - gfc_error_1 ("Type name '%s' at %C conflicts with previously declared " - "entity at %L, which has the same name", name, - &sym->declared_at); + gfc_error ("Type name %qs at %C conflicts with previously declared " + "entity at %L, which has the same name", name, + &sym->declared_at); return MATCH_ERROR; } diff --git a/gcc/fortran/error.c b/gcc/fortran/error.c index 23308b6544e..2512cfc36aa 100644 --- a/gcc/fortran/error.c +++ b/gcc/fortran/error.c @@ -40,12 +40,12 @@ static int suppress_errors = 0; static bool warnings_not_errors = false; -static int terminal_width, errors, warnings; - -static gfc_error_buf error_buffer, warning_buffer, *cur_error_buffer; +static int terminal_width; /* True if the error/warnings should be buffered. */ static bool buffered_p; + +static gfc_error_buffer error_buffer; /* These are always buffered buffers (.flush_p == false) to be used by the pretty-printer. */ static output_buffer *pp_error_buffer, *pp_warning_buffer; @@ -100,8 +100,6 @@ void gfc_error_init_1 (void) { terminal_width = gfc_get_terminal_width (); - errors = 0; - warnings = 0; gfc_buffer_error (false); } @@ -119,42 +117,9 @@ gfc_buffer_error (bool flag) buffered_p. */ static void -error_char (char c) +error_char (char) { - if (buffered_p) - { - if (cur_error_buffer->index >= cur_error_buffer->allocated) - { - cur_error_buffer->allocated = cur_error_buffer->allocated - ? cur_error_buffer->allocated * 2 : 1000; - cur_error_buffer->message = XRESIZEVEC (char, cur_error_buffer->message, - cur_error_buffer->allocated); - } - cur_error_buffer->message[cur_error_buffer->index++] = c; - } - else - { - if (c != 0) - { - /* We build up complete lines before handing things - over to the library in order to speed up error printing. */ - static char *line; - static size_t allocated = 0, index = 0; - - if (index + 1 >= allocated) - { - allocated = allocated ? allocated * 2 : 1000; - line = XRESIZEVEC (char, line, allocated); - } - line[index++] = c; - if (c == '\n') - { - line[index] = '\0'; - fputs (line, stderr); - index = 0; - } - } - } + /* FIXME: Unused function to be removed in a subsequent patch. */ } @@ -782,18 +747,6 @@ error_printf (const char *gmsgid, ...) } -/* Increment the number of errors, and check whether too many have - been printed. */ - -static void -gfc_increment_error_count (void) -{ - errors++; - if ((gfc_option.max_errors != 0) && (errors >= gfc_option.max_errors)) - gfc_fatal_error ("Error count reached limit of %d.", gfc_option.max_errors); -} - - /* Clear any output buffered in a pretty-print output_buffer. */ static void @@ -1247,9 +1200,6 @@ gfc_warning_now (int opt, const char *gmsgid, ...) /* Immediate error (i.e. do not buffer). */ -/* This function uses the common diagnostics, but does not support - two locations; when being used in scanner.c, ensure that the location - is properly setup. Otherwise, use gfc_error_now_1. */ void gfc_error_now (const char *gmsgid, ...) @@ -1257,6 +1207,8 @@ gfc_error_now (const char *gmsgid, ...) va_list argp; diagnostic_info diagnostic; + error_buffer.flag = true; + va_start (argp, gmsgid); diagnostic_set_info (&diagnostic, gmsgid, &argp, UNKNOWN_LOCATION, DK_ERROR); report_diagnostic (&diagnostic); @@ -1285,8 +1237,6 @@ gfc_fatal_error (const char *gmsgid, ...) void gfc_clear_warning (void) { - warning_buffer.flag = 0; - gfc_clear_pp_buffer (pp_warning_buffer); warningcount_buffered = 0; werrorcount_buffered = 0; @@ -1299,15 +1249,8 @@ gfc_clear_warning (void) void gfc_warning_check (void) { - if (warning_buffer.flag) - { - warnings++; - if (warning_buffer.message != NULL) - fputs (warning_buffer.message, stderr); - gfc_clear_warning (); - } /* This is for the new diagnostics machinery. */ - else if (! gfc_output_buffer_empty_p (pp_warning_buffer)) + if (! gfc_output_buffer_empty_p (pp_warning_buffer)) { pretty_printer *pp = global_dc->printer; output_buffer *tmp_buffer = pp->buffer; @@ -1325,62 +1268,6 @@ gfc_warning_check (void) /* Issue an error. */ -/* Use gfc_error instead, unless two locations are used in the same - warning or for scanner.c, if the location is not properly set up. */ - -void -gfc_error_1 (const char *gmsgid, ...) -{ - va_list argp; - - if (warnings_not_errors) - goto warning; - - if (suppress_errors) - return; - - error_buffer.flag = 1; - error_buffer.index = 0; - cur_error_buffer = &error_buffer; - - va_start (argp, gmsgid); - error_print (_("Error:"), _(gmsgid), argp); - va_end (argp); - - error_char ('\0'); - - if (!buffered_p) - gfc_increment_error_count(); - - return; - -warning: - - if (inhibit_warnings) - return; - - warning_buffer.flag = 1; - warning_buffer.index = 0; - cur_error_buffer = &warning_buffer; - - va_start (argp, gmsgid); - error_print (_("Warning:"), _(gmsgid), argp); - va_end (argp); - - error_char ('\0'); - - if (!buffered_p) - { - warnings++; - if (warnings_are_errors) - gfc_increment_error_count(); - } -} - -/* Issue an error. */ -/* This function uses the common diagnostics, but does not support - two locations; when being used in scanner.c, ensure that the location - is properly setup. Otherwise, use gfc_error_1. */ static void gfc_error (const char *gmsgid, va_list ap) @@ -1440,38 +1327,6 @@ gfc_error (const char *gmsgid, ...) } -/* Immediate error. */ -/* Use gfc_error_now instead, unless two locations are used in the same - warning or for scanner.c, if the location is not properly set up. */ - -void -gfc_error_now_1 (const char *gmsgid, ...) -{ - va_list argp; - bool buffered_p_saved; - - error_buffer.flag = 1; - error_buffer.index = 0; - cur_error_buffer = &error_buffer; - - buffered_p_saved = buffered_p; - buffered_p = false; - - va_start (argp, gmsgid); - error_print (_("Error:"), _(gmsgid), argp); - va_end (argp); - - error_char ('\0'); - - gfc_increment_error_count(); - - buffered_p = buffered_p_saved; - - if (flag_fatal_errors) - exit (FATAL_EXIT_CODE); -} - - /* This shouldn't happen... but sometimes does. */ void @@ -1516,24 +1371,10 @@ gfc_error_flag_test (void) bool gfc_error_check (void) { - bool error_raised = (bool) error_buffer.flag; - - if (error_raised) - { - if (error_buffer.message != NULL) - fputs (error_buffer.message, stderr); - error_buffer.flag = 0; - gfc_clear_pp_buffer (pp_error_buffer); - - gfc_increment_error_count(); - - if (flag_fatal_errors) - exit (FATAL_EXIT_CODE); - } - /* This is for the new diagnostics machinery. */ - else if (! gfc_output_buffer_empty_p (pp_error_buffer)) + if (error_buffer.flag + || ! gfc_output_buffer_empty_p (pp_error_buffer)) { - error_raised = true; + error_buffer.flag = false; pretty_printer *pp = global_dc->printer; output_buffer *tmp_buffer = pp->buffer; pp->buffer = pp_error_buffer; @@ -1542,9 +1383,10 @@ gfc_error_check (void) gcc_assert (gfc_output_buffer_empty_p (pp_error_buffer)); diagnostic_action_after_output (global_dc, DK_ERROR); pp->buffer = tmp_buffer; + return true; } - return error_raised; + return false; } /* Move the text buffered from FROM to TO, then clear @@ -1552,8 +1394,15 @@ gfc_error_check (void) cleared. */ static void -gfc_move_output_buffer_from_to (output_buffer *from, output_buffer *to) +gfc_move_error_buffer_from_to (gfc_error_buffer * buffer_from, + gfc_error_buffer * buffer_to) { + output_buffer * from = &(buffer_from->buffer); + output_buffer * to = &(buffer_to->buffer); + + buffer_to->flag = buffer_from->flag; + buffer_from->flag = false; + gfc_clear_pp_buffer (to); /* We make sure this is always buffered. */ to->flush_p = false; @@ -1569,46 +1418,27 @@ gfc_move_output_buffer_from_to (output_buffer *from, output_buffer *to) /* Save the existing error state. */ void -gfc_push_error (output_buffer *buffer_err, gfc_error_buf *err) +gfc_push_error (gfc_error_buffer *err) { - err->flag = error_buffer.flag; - if (error_buffer.flag) - err->message = xstrdup (error_buffer.message); - - error_buffer.flag = 0; - - /* This part uses the common diagnostics. */ - gfc_move_output_buffer_from_to (pp_error_buffer, buffer_err); + gfc_move_error_buffer_from_to (&error_buffer, err); } /* Restore a previous pushed error state. */ void -gfc_pop_error (output_buffer *buffer_err, gfc_error_buf *err) +gfc_pop_error (gfc_error_buffer *err) { - error_buffer.flag = err->flag; - if (error_buffer.flag) - { - size_t len = strlen (err->message) + 1; - gcc_assert (len <= error_buffer.allocated); - memcpy (error_buffer.message, err->message, len); - free (err->message); - } - /* This part uses the common diagnostics. */ - gfc_move_output_buffer_from_to (buffer_err, pp_error_buffer); + gfc_move_error_buffer_from_to (err, &error_buffer); } /* Free a pushed error state, but keep the current error state. */ void -gfc_free_error (output_buffer *buffer_err, gfc_error_buf *err) +gfc_free_error (gfc_error_buffer *err) { - if (err->flag) - free (err->message); - - gfc_clear_pp_buffer (buffer_err); + gfc_clear_pp_buffer (&(err->buffer)); } @@ -1618,9 +1448,9 @@ void gfc_get_errors (int *w, int *e) { if (w != NULL) - *w = warnings + warningcount + werrorcount; + *w = warningcount + werrorcount; if (e != NULL) - *e = errors + errorcount + sorrycount + werrorcount; + *e = errorcount + sorrycount + werrorcount; } @@ -1642,7 +1472,7 @@ gfc_diagnostics_init (void) global_dc->caret_chars[1] = '2'; pp_warning_buffer = new (XNEW (output_buffer)) output_buffer (); pp_warning_buffer->flush_p = false; - pp_error_buffer = new (XNEW (output_buffer)) output_buffer (); + pp_error_buffer = &(error_buffer.buffer); pp_error_buffer->flush_p = false; } diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index a0c37566cfb..b569e0ccb4c 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -4994,7 +4994,7 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj, if (!gfc_check_vardef_context (assoc->target, pointer, false, false, NULL)) { if (context) - gfc_error_1 ("Associate-name '%s' can not appear in a variable" + gfc_error ("Associate-name %qs can not appear in a variable" " definition context (%s) at %L because its target" " at %L can not, either", name, context, &e->where, @@ -5036,12 +5036,12 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj, if (gfc_dep_compare_expr (ec, en) == 0) { if (context) - gfc_error_now_1 ("Elements with the same value " - "at %L and %L in vector " - "subscript in a variable " - "definition context (%s)", - &(ec->where), &(en->where), - context); + gfc_error_now ("Elements with the same value " + "at %L and %L in vector " + "subscript in a variable " + "definition context (%s)", + &(ec->where), &(en->where), + context); return false; } } diff --git a/gcc/fortran/f95-lang.c b/gcc/fortran/f95-lang.c index de9c813bc53..28eaa6aebac 100644 --- a/gcc/fortran/f95-lang.c +++ b/gcc/fortran/f95-lang.c @@ -221,18 +221,10 @@ gfc_create_decls (void) static void gfc_be_parse_file (void) { - int errors; - int warnings; - gfc_create_decls (); gfc_parse_file (); gfc_generate_constructors (); - /* Tell the frontend about any errors. */ - gfc_get_errors (&warnings, &errors); - errorcount += errors; - warningcount += warnings; - /* Clear the binding level stack. */ while (!global_bindings_p ()) poplevel (0, 0); diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c index aeee73e0489..45b053e665b 100644 --- a/gcc/fortran/frontend-passes.c +++ b/gcc/fortran/frontend-passes.c @@ -1879,19 +1879,19 @@ doloop_code (gfc_code **c, int *walk_subtrees ATTRIBUTE_UNUSED, && a->expr->symtree->n.sym == do_sym) { if (f->sym->attr.intent == INTENT_OUT) - gfc_error_now_1 ("Variable '%s' at %L set to undefined " - "value inside loop beginning at %L as " - "INTENT(OUT) argument to subroutine '%s'", - do_sym->name, &a->expr->where, - &doloop_list[i]->loc, - co->symtree->n.sym->name); + gfc_error_now ("Variable %qs at %L set to undefined " + "value inside loop beginning at %L as " + "INTENT(OUT) argument to subroutine %qs", + do_sym->name, &a->expr->where, + &doloop_list[i]->loc, + co->symtree->n.sym->name); else if (f->sym->attr.intent == INTENT_INOUT) - gfc_error_now_1 ("Variable '%s' at %L not definable inside " - "loop beginning at %L as INTENT(INOUT) " - "argument to subroutine '%s'", - do_sym->name, &a->expr->where, - &doloop_list[i]->loc, - co->symtree->n.sym->name); + gfc_error_now ("Variable %qs at %L not definable inside " + "loop beginning at %L as INTENT(INOUT) " + "argument to subroutine %qs", + do_sym->name, &a->expr->where, + &doloop_list[i]->loc, + co->symtree->n.sym->name); } } a = a->next; @@ -1951,17 +1951,17 @@ do_function (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED, && a->expr->symtree->n.sym == do_sym) { if (f->sym->attr.intent == INTENT_OUT) - gfc_error_now_1 ("Variable '%s' at %L set to undefined value " - "inside loop beginning at %L as INTENT(OUT) " - "argument to function '%s'", do_sym->name, - &a->expr->where, &doloop_list[i]->loc, - expr->symtree->n.sym->name); + gfc_error_now ("Variable %qs at %L set to undefined value " + "inside loop beginning at %L as INTENT(OUT) " + "argument to function %qs", do_sym->name, + &a->expr->where, &doloop_list[i]->loc, + expr->symtree->n.sym->name); else if (f->sym->attr.intent == INTENT_INOUT) - gfc_error_now_1 ("Variable '%s' at %L not definable inside loop" - " beginning at %L as INTENT(INOUT) argument to" - " function '%s'", do_sym->name, - &a->expr->where, &doloop_list[i]->loc, - expr->symtree->n.sym->name); + gfc_error_now ("Variable %qs at %L not definable inside loop" + " beginning at %L as INTENT(INOUT) argument to" + " function %qs", do_sym->name, + &a->expr->where, &doloop_list[i]->loc, + expr->symtree->n.sym->name); } } a = a->next; diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index aaa4e890979..905d47c0086 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -2645,14 +2645,6 @@ const char * gfc_get_string (const char *, ...) ATTRIBUTE_PRINTF_1; bool gfc_find_sym_in_expr (gfc_symbol *, gfc_expr *); /* error.c */ - -typedef struct gfc_error_buf -{ - int flag; - size_t allocated, index; - char *message; -} gfc_error_buf; - void gfc_error_init_1 (void); void gfc_diagnostics_init (void); void gfc_diagnostics_finish (void); @@ -2668,9 +2660,7 @@ bool gfc_warning_now_at (location_t loc, int opt, const char *gmsgid, ...) void gfc_clear_warning (void); void gfc_warning_check (void); -void gfc_error_1 (const char *, ...) ATTRIBUTE_GCC_GFC(1,2); void gfc_error (const char *, ...) ATTRIBUTE_GCC_GFC(1,2); -void gfc_error_now_1 (const char *, ...) ATTRIBUTE_GCC_GFC(1,2); void gfc_error_now (const char *, ...) ATTRIBUTE_GCC_GFC(1,2); void gfc_fatal_error (const char *, ...) ATTRIBUTE_NORETURN ATTRIBUTE_GCC_GFC(1,2); void gfc_internal_error (const char *, ...) ATTRIBUTE_NORETURN ATTRIBUTE_GCC_GFC(1,2); @@ -2685,10 +2675,17 @@ bool gfc_notify_std (int, const char *, ...) ATTRIBUTE_GCC_GFC(2,3); #define gfc_syntax_error(ST) \ gfc_error ("Syntax error in %s statement at %C", gfc_ascii_statement (ST)); -#include "pretty-print.h" /* For output_buffer. */ -void gfc_push_error (output_buffer *, gfc_error_buf *); -void gfc_pop_error (output_buffer *, gfc_error_buf *); -void gfc_free_error (output_buffer *, gfc_error_buf *); +#include "pretty-print.h" /* For output_buffer. */ +struct gfc_error_buffer +{ + bool flag; + output_buffer buffer; + gfc_error_buffer(void) : flag(false), buffer() {} +}; + +void gfc_push_error (gfc_error_buffer *); +void gfc_pop_error (gfc_error_buffer *); +void gfc_free_error (gfc_error_buffer *); void gfc_get_errors (int *, int *); void gfc_errors_to_warnings (bool); diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index 3e12483cc0f..2e15af29df6 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.c @@ -3599,7 +3599,7 @@ alloc_opt_list: /* The next 2 conditionals check C631. */ if (ts.type != BT_UNKNOWN) { - gfc_error_1 ("SOURCE tag at %L conflicts with the typespec at %L", + gfc_error ("SOURCE tag at %L conflicts with the typespec at %L", &tmp->where, &old_locus); goto cleanup; } @@ -3636,7 +3636,7 @@ alloc_opt_list: /* Check F08:C637. */ if (ts.type != BT_UNKNOWN) { - gfc_error_1 ("MOLD tag at %L conflicts with the typespec at %L", + gfc_error ("MOLD tag at %L conflicts with the typespec at %L", &tmp->where, &old_locus); goto cleanup; } @@ -3662,8 +3662,8 @@ alloc_opt_list: /* Check F08:C637. */ if (source && mold) { - gfc_error_1 ("MOLD tag at %L conflicts with SOURCE tag at %L", - &mold->where, &source->where); + gfc_error ("MOLD tag at %L conflicts with SOURCE tag at %L", + &mold->where, &source->where); goto cleanup; } @@ -4350,12 +4350,12 @@ gfc_match_common (void) /* If we find an error, just print it and continue, cause it's just semantic, and we can see if there are more errors. */ - gfc_error_now_1 ("Variable '%s' at %L in common block '%s' " - "at %C must be declared with a C " - "interoperable kind since common block " - "'%s' is bind(c)", - sym->name, &(sym->declared_at), t->name, - t->name); + gfc_error_now ("Variable %qs at %L in common block %qs " + "at %C must be declared with a C " + "interoperable kind since common block " + "%qs is bind(c)", + sym->name, &(sym->declared_at), t->name, + t->name); } if (sym->attr.is_bind_c == 1) @@ -4889,8 +4889,7 @@ recursive_stmt_fcn (gfc_expr *e, gfc_symbol *sym) match gfc_match_st_function (void) { - gfc_error_buf old_error_1; - output_buffer old_error; + gfc_error_buffer old_error; gfc_symbol *sym; gfc_expr *expr; @@ -4900,7 +4899,7 @@ gfc_match_st_function (void) if (m != MATCH_YES) return m; - gfc_push_error (&old_error, &old_error_1); + gfc_push_error (&old_error); if (!gfc_add_procedure (&sym->attr, PROC_ST_FUNCTION, sym->name, NULL)) goto undo_error; @@ -4912,7 +4911,7 @@ gfc_match_st_function (void) if (m == MATCH_NO) goto undo_error; - gfc_free_error (&old_error, &old_error_1); + gfc_free_error (&old_error); if (m == MATCH_ERROR) return m; @@ -4931,7 +4930,7 @@ gfc_match_st_function (void) return MATCH_YES; undo_error: - gfc_pop_error (&old_error, &old_error_1); + gfc_pop_error (&old_error); return MATCH_NO; } diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index 3135d9af797..56c67826dbe 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -108,14 +108,13 @@ match_word_omp_simd (const char *str, match (*subr) (void), locus *old_locus, static void use_modules (void) { - gfc_error_buf old_error_1; - output_buffer old_error; + gfc_error_buffer old_error; - gfc_push_error (&old_error, &old_error_1); + gfc_push_error (&old_error); gfc_buffer_error (false); gfc_use_modules (); gfc_buffer_error (true); - gfc_pop_error (&old_error, &old_error_1); + gfc_pop_error (&old_error); gfc_commit_symbols (); gfc_warning_check (); gfc_current_ns->old_cl_list = gfc_current_ns->cl_list; @@ -2435,7 +2434,7 @@ verify_st_order (st_state *p, gfc_statement st, bool silent) order: if (!silent) - gfc_error_1 ("%s statement at %C cannot follow %s statement at %L", + gfc_error ("%s statement at %C cannot follow %s statement at %L", gfc_ascii_statement (st), gfc_ascii_statement (p->last_statement), &p->where); @@ -2812,7 +2811,7 @@ endType: "subcomponent exists)", c->name, &c->loc, sym->name); if (sym->attr.lock_comp && coarray && !lock_type) - gfc_error_1 ("Noncoarray component %s at %L of type LOCK_TYPE or with " + gfc_error ("Noncoarray component %s at %L of type LOCK_TYPE or with " "subcomponent of type LOCK_TYPE must have a codimension or " "be a subcomponent of a coarray. (Variables of type %s may " "not have a codimension as %s at %L has a codimension or a " @@ -3527,7 +3526,7 @@ parse_if_block (void) case ST_ELSEIF: if (seen_else) { - gfc_error_1 ("ELSE IF statement at %C cannot follow ELSE " + gfc_error ("ELSE IF statement at %C cannot follow ELSE " "statement at %L", &else_locus); reject_statement (); @@ -3751,8 +3750,8 @@ gfc_check_do_variable (gfc_symtree *st) for (s=gfc_state_stack; s; s = s->previous) if (s->do_variable == st) { - gfc_error_now_1 ("Variable '%s' at %C cannot be redefined inside " - "loop beginning at %L", st->name, &s->head->loc); + gfc_error_now ("Variable %qs at %C cannot be redefined inside " + "loop beginning at %L", st->name, &s->head->loc); return 1; } @@ -5070,10 +5069,10 @@ gfc_global_used (gfc_gsymbol *sym, locus *where) } if (sym->binding_label) - gfc_error_1 ("Global binding name '%s' at %L is already being used as a %s " + gfc_error ("Global binding name %qs at %L is already being used as a %s " "at %L", sym->binding_label, where, name, &sym->where); else - gfc_error_1 ("Global name '%s' at %L is already being used as a %s at %L", + gfc_error ("Global name %qs at %L is already being used as a %s at %L", sym->name, where, name, &sym->where); } @@ -5543,7 +5542,7 @@ duplicate_main: /* If we see a duplicate main program, shut down. If the second instance is an implied main program, i.e. data decls or executable statements, we're in for lots of errors. */ - gfc_error_1 ("Two main PROGRAMs at %L and %C", &prog_locus); + gfc_error ("Two main PROGRAMs at %L and %C", &prog_locus); reject_statement (); gfc_done_2 (); return true; diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c index e9ced7e6f71..7d2f9c768fe 100644 --- a/gcc/fortran/primary.c +++ b/gcc/fortran/primary.c @@ -1274,8 +1274,7 @@ static match match_complex_constant (gfc_expr **result) { gfc_expr *e, *real, *imag; - gfc_error_buf old_error_1; - output_buffer old_error; + gfc_error_buffer old_error; gfc_typespec target; locus old_loc; int kind; @@ -1288,18 +1287,18 @@ match_complex_constant (gfc_expr **result) if (m != MATCH_YES) return m; - gfc_push_error (&old_error, &old_error_1); + gfc_push_error (&old_error); m = match_complex_part (&real); if (m == MATCH_NO) { - gfc_free_error (&old_error, &old_error_1); + gfc_free_error (&old_error); goto cleanup; } if (gfc_match_char (',') == MATCH_NO) { - gfc_pop_error (&old_error, &old_error_1); + gfc_pop_error (&old_error); m = MATCH_NO; goto cleanup; } @@ -1311,10 +1310,10 @@ match_complex_constant (gfc_expr **result) if (m == MATCH_ERROR) { - gfc_free_error (&old_error, &old_error_1); + gfc_free_error (&old_error); goto cleanup; } - gfc_pop_error (&old_error, &old_error_1); + gfc_pop_error (&old_error); m = match_complex_part (&imag); if (m == MATCH_NO) diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index fbf260f5233..492c016ad9c 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -418,7 +418,7 @@ resolve_formal_arglist (gfc_symbol *proc) /* F08:C1278a. */ if (sym->ts.type == BT_CLASS && sym->attr.intent == INTENT_OUT) { - gfc_error ("INTENT(OUT) argument '%s' of pure procedure %qs at %L" + gfc_error ("INTENT(OUT) argument %qs of pure procedure %qs at %L" " may not be polymorphic", sym->name, proc->name, &sym->declared_at); continue; @@ -993,7 +993,7 @@ resolve_common_blocks (gfc_symtree *common_root) || (!common_root->n.common->binding_label && gsym->binding_label))) { - gfc_error_1 ("In Fortran 2003 COMMON '%s' block at %L is a global " + gfc_error ("In Fortran 2003 COMMON %qs block at %L is a global " "identifier and must thus have the same binding name " "as the same-named COMMON block at %L: %s vs %s", common_root->n.common->name, &common_root->n.common->where, @@ -1007,7 +1007,7 @@ resolve_common_blocks (gfc_symtree *common_root) if (gsym && gsym->type != GSYM_COMMON && !common_root->n.common->binding_label) { - gfc_error_1 ("COMMON block '%s' at %L uses the same global identifier " + gfc_error ("COMMON block %qs at %L uses the same global identifier " "as entity at %L", common_root->n.common->name, &common_root->n.common->where, &gsym->where); @@ -1015,7 +1015,7 @@ resolve_common_blocks (gfc_symtree *common_root) } if (gsym && gsym->type != GSYM_COMMON) { - gfc_error_1 ("Fortran 2008: COMMON block '%s' with binding label at " + gfc_error ("Fortran 2008: COMMON block %qs with binding label at " "%L sharing the identifier with global non-COMMON-block " "entity at %L", common_root->n.common->name, &common_root->n.common->where, &gsym->where); @@ -1037,7 +1037,7 @@ resolve_common_blocks (gfc_symtree *common_root) common_root->n.common->binding_label); if (gsym && gsym->type != GSYM_COMMON) { - gfc_error_1 ("COMMON block at %L with binding label %s uses the same " + gfc_error ("COMMON block at %L with binding label %s uses the same " "global identifier as entity at %L", &common_root->n.common->where, common_root->n.common->binding_label, &gsym->where); @@ -1058,7 +1058,7 @@ resolve_common_blocks (gfc_symtree *common_root) return; if (sym->attr.flavor == FL_PARAMETER) - gfc_error_1 ("COMMON block '%s' at %L is used as PARAMETER at %L", + gfc_error ("COMMON block %qs at %L is used as PARAMETER at %L", sym->name, &common_root->n.common->where, &sym->declared_at); if (sym->attr.external) @@ -3368,7 +3368,7 @@ resolve_call (gfc_code *c) if (csym && csym->ts.type != BT_UNKNOWN) { - gfc_error_1 ("'%s' at %L has a type, which is not consistent with " + gfc_error ("%qs at %L has a type, which is not consistent with " "the CALL at %L", csym->name, &csym->declared_at, &c->loc); return false; } @@ -3494,8 +3494,8 @@ compare_shapes (gfc_expr *op1, gfc_expr *op2) { if (mpz_cmp (op1->shape[i], op2->shape[i]) != 0) { - gfc_error_1 ("Shapes for operands at %L and %L are not conformable", - &op1->where, &op2->where); + gfc_error ("Shapes for operands at %L and %L are not conformable", + &op1->where, &op2->where); t = false; break; } @@ -6785,7 +6785,7 @@ conformable_arrays (gfc_expr *e1, gfc_expr *e2) if (mpz_cmp (e1->shape[i], s) != 0) { - gfc_error_1 ("Source-expr at %L and allocate-object at %L must " + gfc_error ("Source-expr at %L and allocate-object at %L must " "have the same shape", &e1->where, &e2->where); mpz_clear (s); return false; @@ -6943,8 +6943,8 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code) /* Check F03:C631. */ if (!gfc_type_compatible (&e->ts, &code->expr3->ts)) { - gfc_error_1 ("Type of entity at %L is type incompatible with " - "source-expr at %L", &e->where, &code->expr3->where); + gfc_error ("Type of entity at %L is type incompatible with " + "source-expr at %L", &e->where, &code->expr3->where); goto failure; } @@ -6955,9 +6955,9 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code) /* Check F03:C633. */ if (code->expr3->ts.kind != e->ts.kind && !unlimited) { - gfc_error_1 ("The allocate-object at %L and the source-expr at %L " - "shall have the same kind type parameter", - &e->where, &code->expr3->where); + gfc_error ("The allocate-object at %L and the source-expr at %L " + "shall have the same kind type parameter", + &e->where, &code->expr3->where); goto failure; } @@ -6969,7 +6969,7 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code) && code->expr3->ts.u.derived->intmod_sym_id == ISOFORTRAN_LOCK_TYPE))) { - gfc_error_1 ("The source-expr at %L shall neither be of type " + gfc_error ("The source-expr at %L shall neither be of type " "LOCK_TYPE nor have a LOCK_TYPE component if " "allocate-object at %L is a coarray", &code->expr3->where, &e->where); @@ -7318,20 +7318,20 @@ resolve_allocate_deallocate (gfc_code *code, const char *fcn) { if (pr == NULL && qr == NULL) { - gfc_error_1 ("Allocate-object at %L also appears at %L", - &pe->where, &qe->where); + gfc_error ("Allocate-object at %L also appears at %L", + &pe->where, &qe->where); break; } else if (pr != NULL && qr == NULL) { - gfc_error_1 ("Allocate-object at %L is subobject of" - " object at %L", &pe->where, &qe->where); + gfc_error ("Allocate-object at %L is subobject of" + " object at %L", &pe->where, &qe->where); break; } else if (pr == NULL && qr != NULL) { - gfc_error_1 ("Allocate-object at %L is subobject of" - " object at %L", &qe->where, &pe->where); + gfc_error ("Allocate-object at %L is subobject of" + " object at %L", &qe->where, &pe->where); break; } /* Here, pr != NULL && qr != NULL */ @@ -7534,7 +7534,7 @@ check_case_overlap (gfc_case *list) element in the list. Either way, we must issue an error and get the next case from P. */ /* FIXME: Sort P and Q by line number. */ - gfc_error_1 ("CASE label at %L overlaps with CASE " + gfc_error ("CASE label at %L overlaps with CASE " "label at %L", &p->where, &q->where); overlap_seen = 1; e = p; @@ -7772,7 +7772,7 @@ resolve_select (gfc_code *code, bool select_type) { if (default_case != NULL) { - gfc_error_1 ("The DEFAULT CASE at %L cannot be followed " + gfc_error ("The DEFAULT CASE at %L cannot be followed " "by a second DEFAULT CASE at %L", &default_case->where, &cp->where); t = false; @@ -8145,7 +8145,7 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns) /* Check F03:C818. */ if (default_case) { - gfc_error_1 ("The DEFAULT CASE at %L cannot be followed " + gfc_error ("The DEFAULT CASE at %L cannot be followed " "by a second DEFAULT CASE at %L", &default_case->ext.block.case_list->where, &c->where); error++; @@ -8708,7 +8708,7 @@ resolve_branch (gfc_st_label *label, gfc_code *code) if (label->defined != ST_LABEL_TARGET && label->defined != ST_LABEL_DO_TARGET) { - gfc_error_1 ("Statement at %L is not a valid branch target statement " + gfc_error ("Statement at %L is not a valid branch target statement " "for the branch statement at %L", &label->where, &code->loc); return; } @@ -8735,11 +8735,11 @@ resolve_branch (gfc_st_label *label, gfc_code *code) { if (stack->current->op == EXEC_CRITICAL && bitmap_bit_p (stack->reachable_labels, label->value)) - gfc_error_1 ("GOTO statement at %L leaves CRITICAL construct for " + gfc_error ("GOTO statement at %L leaves CRITICAL construct for " "label at %L", &code->loc, &label->where); else if (stack->current->op == EXEC_DO_CONCURRENT && bitmap_bit_p (stack->reachable_labels, label->value)) - gfc_error_1 ("GOTO statement at %L leaves DO CONCURRENT construct " + gfc_error ("GOTO statement at %L leaves DO CONCURRENT construct " "for label at %L", &code->loc, &label->where); } @@ -8758,13 +8758,13 @@ resolve_branch (gfc_st_label *label, gfc_code *code) { /* Note: A label at END CRITICAL does not leave the CRITICAL construct as END CRITICAL is still part of it. */ - gfc_error_1 ("GOTO statement at %L leaves CRITICAL construct for label" + gfc_error ("GOTO statement at %L leaves CRITICAL construct for label" " at %L", &code->loc, &label->where); return; } else if (stack->current->op == EXEC_DO_CONCURRENT) { - gfc_error_1 ("GOTO statement at %L leaves DO CONCURRENT construct for " + gfc_error ("GOTO statement at %L leaves DO CONCURRENT construct for " "label at %L", &code->loc, &label->where); return; } @@ -10545,7 +10545,7 @@ gfc_verify_binding_labels (gfc_symbol *sym) if (sym->attr.flavor == FL_VARIABLE && gsym->type != GSYM_UNKNOWN) { - gfc_error_1 ("Variable %s with binding label %s at %L uses the same global " + gfc_error ("Variable %s with binding label %s at %L uses the same global " "identifier as entity at %L", sym->name, sym->binding_label, &sym->declared_at, &gsym->where); /* Clear the binding label to prevent checking multiple times. */ @@ -10558,7 +10558,7 @@ gfc_verify_binding_labels (gfc_symbol *sym) { /* This can only happen if the variable is defined in a module - if it isn't the same module, reject it. */ - gfc_error_1 ("Variable %s from module %s with binding label %s at %L uses " + gfc_error ("Variable %s from module %s with binding label %s at %L uses " "the same global identifier as entity at %L from module %s", sym->name, module, sym->binding_label, &sym->declared_at, &gsym->where, gsym->mod_name); @@ -10575,7 +10575,7 @@ gfc_verify_binding_labels (gfc_symbol *sym) /* Print an error if the procedure is defined multiple times; we have to exclude references to the same procedure via module association or multiple checks for the same procedure. */ - gfc_error_1 ("Procedure %s with binding label %s at %L uses the same " + gfc_error ("Procedure %s with binding label %s at %L uses the same " "global identifier as entity at %L", sym->name, sym->binding_label, &sym->declared_at, &gsym->where); sym->binding_label = NULL; @@ -11075,7 +11075,7 @@ resolve_fl_variable_derived (gfc_symbol *sym, int no_init_flag) s = gfc_find_dt_in_generic (s); if (s && s->attr.flavor != FL_DERIVED) { - gfc_error_1 ("The type '%s' cannot be host associated at %L " + gfc_error ("The type %qs cannot be host associated at %L " "because it is blocked by an incompatible object " "of the same name declared at %L", sym->ts.u.derived->name, &sym->declared_at, @@ -11145,7 +11145,7 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag) { /* The shape of a main program or module array needs to be constant. */ - gfc_error ("The module or main program array '%s' at %L must " + gfc_error ("The module or main program array %qs at %L must " "have constant shape", sym->name, &sym->declared_at); specification_expr = saved_specification_expr; return false; @@ -11194,7 +11194,7 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag) && (sym->ns->proc_name->attr.flavor == FL_MODULE || sym->ns->proc_name->attr.is_main_program)) { - gfc_error ("'%s' at %L must have constant character length " + gfc_error ("%qs at %L must have constant character length " "in this context", sym->name, &sym->declared_at); specification_expr = saved_specification_expr; return false; diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index e470cb956a7..08bdf18b857 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -1706,7 +1706,7 @@ gfc_add_type (gfc_symbol *sym, gfc_typespec *ts, locus *where) if (type != BT_UNKNOWN && !(sym->attr.function && sym->attr.implicit_type)) { if (sym->attr.use_assoc) - gfc_error_1 ("Symbol '%s' at %L conflicts with symbol from module '%s', " + gfc_error ("Symbol %qs at %L conflicts with symbol from module %qs, " "use-associated at %L", sym->name, where, sym->module, &sym->declared_at); else @@ -1900,7 +1900,7 @@ gfc_add_component (gfc_symbol *sym, const char *name, { if (strcmp (p->name, name) == 0) { - gfc_error_1 ("Component '%s' at %C already declared at %L", + gfc_error ("Component %qs at %C already declared at %L", name, &p->loc); return false; } @@ -1911,7 +1911,7 @@ gfc_add_component (gfc_symbol *sym, const char *name, if (sym->attr.extension && gfc_find_component (sym->components->ts.u.derived, name, true, true)) { - gfc_error_1 ("Component '%s' at %C already in the parent type " + gfc_error ("Component %qs at %C already in the parent type " "at %L", name, &sym->components->ts.u.derived->declared_at); return false; } @@ -2223,7 +2223,7 @@ gfc_define_st_label (gfc_st_label *lp, gfc_sl_type type, locus *label_locus) labelno = lp->value; if (lp->defined != ST_LABEL_UNKNOWN) - gfc_error_1 ("Duplicate statement label %d at %L and %L", labelno, + gfc_error ("Duplicate statement label %d at %L and %L", labelno, &lp->where, label_locus); else { @@ -3900,9 +3900,9 @@ verify_bind_c_derived_type (gfc_symbol *derived_sym) J3/04-007, Section 15.2.3, C1505. */ if (curr_comp->attr.pointer != 0) { - gfc_error_1 ("Component '%s' at %L cannot have the " + gfc_error ("Component %qs at %L cannot have the " "POINTER attribute because it is a member " - "of the BIND(C) derived type '%s' at %L", + "of the BIND(C) derived type %qs at %L", curr_comp->name, &(curr_comp->loc), derived_sym->name, &(derived_sym->declared_at)); retval = false; @@ -3910,8 +3910,8 @@ verify_bind_c_derived_type (gfc_symbol *derived_sym) if (curr_comp->attr.proc_pointer != 0) { - gfc_error_1 ("Procedure pointer component '%s' at %L cannot be a member" - " of the BIND(C) derived type '%s' at %L", curr_comp->name, + gfc_error ("Procedure pointer component %qs at %L cannot be a member" + " of the BIND(C) derived type %qs at %L", curr_comp->name, &curr_comp->loc, derived_sym->name, &derived_sym->declared_at); retval = false; @@ -3921,9 +3921,9 @@ verify_bind_c_derived_type (gfc_symbol *derived_sym) J3/04-007, Section 15.2.3, C1505. */ if (curr_comp->attr.allocatable != 0) { - gfc_error_1 ("Component '%s' at %L cannot have the " + gfc_error ("Component %qs at %L cannot have the " "ALLOCATABLE attribute because it is a member " - "of the BIND(C) derived type '%s' at %L", + "of the BIND(C) derived type %qs at %L", curr_comp->name, &(curr_comp->loc), derived_sym->name, &(derived_sym->declared_at)); retval = false; diff --git a/gcc/fortran/trans-common.c b/gcc/fortran/trans-common.c index 8064d891870..a2bc089cb11 100644 --- a/gcc/fortran/trans-common.c +++ b/gcc/fortran/trans-common.c @@ -918,8 +918,8 @@ confirm_condition (segment_info *s1, gfc_equiv *eq1, segment_info *s2, offset2 = calculate_offset (eq2->expr); if (s1->offset + offset1 != s2->offset + offset2) - gfc_error_1 ("Inconsistent equivalence rules involving '%s' at %L and " - "'%s' at %L", s1->sym->name, &s1->sym->declared_at, + gfc_error ("Inconsistent equivalence rules involving %qs at %L and " + "%qs at %L", s1->sym->name, &s1->sym->declared_at, s2->sym->name, &s2->sym->declared_at); } -- 2.30.2