Skip to content

R
riscv-gcc-1
Commit fea70c99 by Manuel López-Ibáñez
Options

re PR fortran/44054 (Handle -Werror, -Werror=, -fdiagnostics-show-option, !GCC$… 

re PR fortran/44054 (Handle -Werror, -Werror=, -fdiagnostics-show-option, !GCC$ diagnostic (pragmas) and color)

gcc/fortran/ChangeLog:

2015-05-24  Manuel López-Ibáñez  <manu@gcc.gnu.org>

	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
parent 84a3423b
Showing with 211 additions and 363 deletions
gcc/fortran/ChangeLog
2015-05-24 Manuel López-Ibáñez <manu@gcc.gnu.org>
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 <jim.wilson@linaro.org>
* Make-lang.in (check_gfortran_parallelize): Update comment.
......
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 ("%<I%> at %L and %<J%>' 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;
}
}
......
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;
}
......
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;
}
......
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;
}
......
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;
}
}
......
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);
......
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;
......
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);
......
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;
}
......
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;
......
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)
......
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;
......
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);
}
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment