git
/
gcc
mirror of git://gcc.gnu.org/git/gcc.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

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
This commit is contained in:
Manuel López-Ibáñez 2015-05-23 23:02:52 +00:00
parent 84a3423b97
commit fea70c9963
15 changed files with 211 additions and 363 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
gcc/fortran/ChangeLog
View File

@ -1,3 +1,35 @@
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.

32
gcc/fortran/check.c
View File

@ -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;
}
}

6
gcc/fortran/data.c
View File

@ -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;
}

22
gcc/fortran/decl.c
View File

@ -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;
}

230
gcc/fortran/error.c
View File

@ -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.flag
|| ! gfc_output_buffer_empty_p (pp_error_buffer))
{
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))
{
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;
}

14
gcc/fortran/expr.c
View File

@ -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;
}
}

8
gcc/fortran/f95-lang.c
View File

@ -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);

44
gcc/fortran/frontend-passes.c
View File

@ -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;

25
gcc/fortran/gfortran.h
View File

@ -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);

29
gcc/fortran/match.c
View File

@ -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;
}

23
gcc/fortran/parse.c
View File

@ -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;

13
gcc/fortran/primary.c
View File

@ -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)

72
gcc/fortran/resolve.c
View File

@ -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;

20
gcc/fortran/symbol.c
View File

@ -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;

4
gcc/fortran/trans-common.c
View File

@ -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);
}