* Re: [PATCH fortran/diagnostics] Move gfc_error (buffered) to common diagnostics (try 2)
@ 2014-12-10 22:59 Manuel López-Ibáñez
2014-12-11 8:09 ` Dodji Seketeli
0 siblings, 1 reply; 3+ messages in thread
From: Manuel López-Ibáñez @ 2014-12-10 22:59 UTC (permalink / raw)
To: Dodji Seketeli; +Cc: Tobias Burnus, Gcc Patch List, fortran@gcc.gnu.org List
[-- Attachment #1: Type: text/plain, Size: 2540 bytes --]
New version using XNEW. Bootstrapped & tested on x86_64-linux-gnu.
OK?
gcc/ChangeLog:
2014-12-07 Manuel López-Ibáñez <manu@gcc.gnu.org>
PR fortran/44054
* diagnostic.c (diagnostic_action_after_output): Make it extern.
Take diagnostic_t argument instead of diagnostic_info. Count also
DK_WERROR towards max_errors.
(diagnostic_report_diagnostic): Update call according to the above.
(error_recursion): Likewise.
* diagnostic.h (diagnostic_action_after_output): Declare.
* pretty-print.c (pp_formatted_text_data): Delete.
(pp_append_r): Call output_buffer_append_r.
(pp_formatted_text): Call output_buffer_formatted_text.
(pp_last_position_in_text): Call output_buffer_last_position_in_text.
* pretty-print.h (output_buffer_formatted_text): New.
(output_buffer_append_r): New.
(output_buffer_last_position_in_text): New.
gcc/testsuite/ChangeLog:
2014-12-07 Manuel López-Ibáñez <manu@gcc.gnu.org>
* gfortran.dg/do_iterator.f90: Remove bogus dg-warning.
gcc/fortran/ChangeLog:
2014-12-07 Manuel López-Ibáñez <manu@gcc.gnu.org>
PR fortran/44054
* error.c (pp_error_buffer): New static variable.
(pp_warning_buffer): Make it a pointer.
(gfc_output_buffer_empty_p): New.
(gfc_error_init_1): Call gfc_buffer_error.
(gfc_buffer_error): Do not use pp_warning_buffer.flush_p as the
buffered_p flag.
(gfc_clear_warning): Likewise.
(gfc_warning_check): Call gfc_clear_warning. Only check the new
pp_warning_buffer if the old warning_buffer was empty. Call
diagnostic_action_after_output.
(gfc_error_1): Renamed from gfc_error.
(gfc_error): New.
(gfc_clear_error): Clear also pp_error_buffer.
(gfc_error_flag_test): Check also pp_error_buffer.
(gfc_error_check): Likewise. Only check the new pp_error_buffer
if the old error_buffer was empty.
(gfc_move_output_buffer_from_to): New.
(gfc_push_error): Use it here. Take also an output_buffer as argument.
(gfc_pop_error): Likewise.
(gfc_free_error): Likewise.
(gfc_diagnostics_init): Use XNEW and placement-new to init
pp_error_buffer and pp_warning_buffer. Set flush_p to false for
both pp_warning_buffer and pp_error_buffer.
* Update gfc_push_error, gfc_pop_error and gfc_free_error calls
according to the above changes.
* Use gfc_error_1 for all gfc_error calls that use multiple
locations.
* Use %qs instead of '%s' for many gfc_error calls.
[-- Attachment #2: gfc_error_diag.diff --]
[-- Type: text/plain, Size: 7692 bytes --]
Index: gcc/diagnostic.c
===================================================================
--- gcc/diagnostic.c (revision 218457)
+++ gcc/diagnostic.c (working copy)
@@ -41,12 +41,10 @@ along with GCC; see the file COPYING3.
#define permissive_error_option(DC) ((DC)->opt_permissive)
/* Prototypes. */
static void error_recursion (diagnostic_context *) ATTRIBUTE_NORETURN;
-static void diagnostic_action_after_output (diagnostic_context *,
- diagnostic_info *);
static void real_abort (void) ATTRIBUTE_NORETURN;
/* Name of program invoked, sans directories. */
const char *progname;
@@ -464,15 +462,15 @@ bt_err_callback (void *data ATTRIBUTE_UN
errnum == 0 ? "" : xstrerror (errnum));
}
/* Take any action which is expected to happen after the diagnostic
is written out. This function does not always return. */
-static void
+void
diagnostic_action_after_output (diagnostic_context *context,
- diagnostic_info *diagnostic)
+ diagnostic_t diag_kind)
{
- switch (diagnostic->kind)
+ switch (diag_kind)
{
case DK_DEBUG:
case DK_NOTE:
case DK_ANACHRONISM:
case DK_WARNING:
@@ -488,11 +486,12 @@ diagnostic_action_after_output (diagnost
diagnostic_finish (context);
exit (FATAL_EXIT_CODE);
}
if (context->max_errors != 0
&& ((unsigned) (diagnostic_kind_count (context, DK_ERROR)
- + diagnostic_kind_count (context, DK_SORRY))
+ + diagnostic_kind_count (context, DK_SORRY)
+ + diagnostic_kind_count (context, DK_WERROR))
>= context->max_errors))
{
fnotice (stderr,
"compilation terminated due to -fmax-errors=%u.\n",
context->max_errors);
@@ -845,11 +844,11 @@ diagnostic_report_diagnostic (diagnostic
diagnostic->x_data = NULL;
pp_format (context->printer, &diagnostic->message);
(*diagnostic_starter (context)) (context, diagnostic);
pp_output_formatted_text (context->printer);
(*diagnostic_finalizer (context)) (context, diagnostic);
- diagnostic_action_after_output (context, diagnostic);
+ diagnostic_action_after_output (context, diagnostic->kind);
diagnostic->message.format_spec = saved_format_spec;
diagnostic->x_data = NULL;
context->lock--;
@@ -1245,22 +1244,19 @@ fnotice (FILE *file, const char *cmsgid,
This mustn't use internal_error, that will cause infinite recursion. */
static void
error_recursion (diagnostic_context *context)
{
- diagnostic_info diagnostic;
-
if (context->lock < 3)
pp_newline_and_flush (context->printer);
fnotice (stderr,
"Internal compiler error: Error reporting routines re-entered.\n");
/* Call diagnostic_action_after_output to get the "please submit a bug
- report" message. It only looks at the kind field of diagnostic_info. */
- diagnostic.kind = DK_ICE;
- diagnostic_action_after_output (context, &diagnostic);
+ report" message. */
+ diagnostic_action_after_output (context, DK_ICE);
/* Do not use gcc_unreachable here; that goes through internal_error
and therefore would cause infinite recursion. */
real_abort ();
}
Index: gcc/diagnostic.h
===================================================================
--- gcc/diagnostic.h (revision 218457)
+++ gcc/diagnostic.h (working copy)
@@ -292,10 +292,11 @@ extern void diagnostic_append_note (diag
#endif
extern char *diagnostic_build_prefix (diagnostic_context *, const diagnostic_info *);
void default_diagnostic_starter (diagnostic_context *, diagnostic_info *);
void default_diagnostic_finalizer (diagnostic_context *, diagnostic_info *);
void diagnostic_set_caret_max_width (diagnostic_context *context, int value);
+void diagnostic_action_after_output (diagnostic_context *, diagnostic_t);
void diagnostic_file_cache_fini (void);
/* Expand the location of this diagnostic. Use this function for consistency. */
Index: gcc/pretty-print.c
===================================================================
--- gcc/pretty-print.c (revision 218457)
+++ gcc/pretty-print.c (working copy)
@@ -53,13 +53,10 @@ output_buffer::~output_buffer ()
{
obstack_free (&chunk_obstack, NULL);
obstack_free (&formatted_obstack, NULL);
}
-/* A pointer to the formatted diagnostic message. */
-#define pp_formatted_text_data(PP) \
- ((const char *) obstack_base (pp_buffer (PP)->obstack))
/* Format an integer given by va_arg (ARG, type-specifier T) where
type-specifier is a precision modifier as indicated by PREC. F is
a string used to construct the appropriate format-specifier. */
#define pp_integer_with_precision(PP, ARG, PREC, T, F) \
@@ -223,12 +220,11 @@ pp_maybe_wrap_text (pretty_printer *pp,
/* Append to the output area of PRETTY-PRINTER a string specified by its
STARTing character and LENGTH. */
static inline void
pp_append_r (pretty_printer *pp, const char *start, int length)
{
- obstack_grow (pp_buffer (pp)->obstack, start, length);
- pp_buffer (pp)->line_length += length;
+ output_buffer_append_r (pp_buffer (pp), start, length);
}
/* Insert enough spaces into the output area of PRETTY-PRINTER to bring
the column position to the current indentation level, assuming that a
newline has just been written to the buffer. */
@@ -824,25 +820,19 @@ pp_append_text (pretty_printer *pp, cons
/* Finishes constructing a NULL-terminated character string representing
the PRETTY-PRINTED text. */
const char *
pp_formatted_text (pretty_printer *pp)
{
- obstack_1grow (pp_buffer (pp)->obstack, '\0');
- return pp_formatted_text_data (pp);
+ return output_buffer_formatted_text (pp_buffer (pp));
}
/* Return a pointer to the last character emitted in PRETTY-PRINTER's
output area. A NULL pointer means no character available. */
const char *
pp_last_position_in_text (const pretty_printer *pp)
{
- const char *p = NULL;
- struct obstack *text = pp_buffer (pp)->obstack;
-
- if (obstack_base (text) != obstack_next_free (text))
- p = ((const char *) obstack_next_free (text)) - 1;
- return p;
+ return output_buffer_last_position_in_text (pp_buffer (pp));
}
/* Return the amount of characters PRETTY-PRINTER can accept to
make a full line. Meaningful only in line-wrapping mode. */
int
Index: gcc/pretty-print.h
===================================================================
--- gcc/pretty-print.h (revision 218457)
+++ gcc/pretty-print.h (working copy)
@@ -105,10 +105,42 @@ struct output_buffer
appropriate. Otherwise, text is buffered until either
pp_really_flush or pp_clear_output_area are called. */
bool flush_p;
};
+/* Finishes constructing a NULL-terminated character string representing
+ the buffered text. */
+static inline const char *
+output_buffer_formatted_text (output_buffer *buff)
+{
+ obstack_1grow (buff->obstack, '\0');
+ return (const char *) obstack_base (buff->obstack);
+}
+
+/* Append to the output buffer a string specified by its
+ STARTing character and LENGTH. */
+static inline void
+output_buffer_append_r (output_buffer *buff, const char *start, int length)
+{
+ obstack_grow (buff->obstack, start, length);
+ buff->line_length += length;
+}
+
+/* Return a pointer to the last character emitted in the
+ output_buffer. A NULL pointer means no character available. */
+static inline const char *
+output_buffer_last_position_in_text (const output_buffer *buff)
+{
+ const char *p = NULL;
+ struct obstack *text = buff->obstack;
+
+ if (obstack_base (text) != obstack_next_free (text))
+ p = ((const char *) obstack_next_free (text)) - 1;
+ return p;
+}
+
+
/* The type of pretty-printer flags passed to clients. */
typedef unsigned int pp_flags;
enum pp_padding
{
[-- Attachment #3: gfc_error_fortran.diff --]
[-- Type: text/plain, Size: 195944 bytes --]
Index: gcc/fortran/openmp.c
===================================================================
--- gcc/fortran/openmp.c (revision 218457)
+++ gcc/fortran/openmp.c (working copy)
@@ -2324,45 +2324,45 @@ resolve_omp_clauses (gfc_code *code, loc
default:
for (; n != NULL; n = n->next)
{
bool bad = false;
if (n->sym->attr.threadprivate)
- gfc_error ("THREADPRIVATE object '%s' in %s clause at %L",
+ gfc_error ("THREADPRIVATE object %qs in %s clause at %L",
n->sym->name, name, where);
if (n->sym->attr.cray_pointee)
- gfc_error ("Cray pointee '%s' in %s clause at %L",
+ gfc_error ("Cray pointee %qs in %s clause at %L",
n->sym->name, name, where);
if (n->sym->attr.associate_var)
- gfc_error ("ASSOCIATE name '%s' in %s clause at %L",
+ gfc_error ("ASSOCIATE name %qs in %s clause at %L",
n->sym->name, name, where);
if (list != OMP_LIST_PRIVATE)
{
if (n->sym->attr.proc_pointer && list == OMP_LIST_REDUCTION)
- gfc_error ("Procedure pointer '%s' in %s clause at %L",
+ gfc_error ("Procedure pointer %qs in %s clause at %L",
n->sym->name, name, where);
if (n->sym->attr.pointer && list == OMP_LIST_REDUCTION)
- gfc_error ("POINTER object '%s' in %s clause at %L",
+ gfc_error ("POINTER object %qs in %s clause at %L",
n->sym->name, name, where);
if (n->sym->attr.cray_pointer && list == OMP_LIST_REDUCTION)
- gfc_error ("Cray pointer '%s' in %s clause at %L",
+ gfc_error ("Cray pointer %qs in %s clause at %L",
n->sym->name, name, where);
}
if (n->sym->as && n->sym->as->type == AS_ASSUMED_SIZE)
- gfc_error ("Assumed size array '%s' in %s clause at %L",
+ gfc_error ("Assumed size array %qs in %s clause at %L",
n->sym->name, name, where);
if (n->sym->attr.in_namelist && list != OMP_LIST_REDUCTION)
- gfc_error ("Variable '%s' in %s clause is used in "
+ gfc_error ("Variable %qs in %s clause is used in "
"NAMELIST statement at %L",
n->sym->name, name, where);
if (n->sym->attr.pointer && n->sym->attr.intent == INTENT_IN)
switch (list)
{
case OMP_LIST_PRIVATE:
case OMP_LIST_LASTPRIVATE:
case OMP_LIST_LINEAR:
/* case OMP_LIST_REDUCTION: */
- gfc_error ("INTENT(IN) POINTER '%s' in %s clause at %L",
+ gfc_error ("INTENT(IN) POINTER %qs in %s clause at %L",
n->sym->name, name, where);
break;
default:
break;
}
@@ -2473,26 +2473,26 @@ resolve_omp_clauses (gfc_code *code, loc
}
}
break;
case OMP_LIST_LINEAR:
if (n->sym->ts.type != BT_INTEGER)
- gfc_error ("LINEAR variable '%s' must be INTEGER "
+ gfc_error ("LINEAR variable %qs must be INTEGER "
"at %L", n->sym->name, where);
else if (!code && !n->sym->attr.value)
- gfc_error ("LINEAR dummy argument '%s' must have VALUE "
+ gfc_error ("LINEAR dummy argument %qs must have VALUE "
"attribute at %L", n->sym->name, where);
else if (n->expr)
{
gfc_expr *expr = n->expr;
if (!gfc_resolve_expr (expr)
|| expr->ts.type != BT_INTEGER
|| expr->rank != 0)
- gfc_error ("'%s' in LINEAR clause at %L requires "
+ gfc_error ("%qs in LINEAR clause at %L requires "
"a scalar integer linear-step expression",
n->sym->name, where);
else if (!code && expr->expr_type != EXPR_CONSTANT)
- gfc_error ("'%s' in LINEAR clause at %L requires "
+ gfc_error ("%qs in LINEAR clause at %L requires "
"a constant integer linear-step expression",
n->sym->name, where);
}
break;
/* Workaround for PR middle-end/26316, nothing really needs
@@ -2929,11 +2929,11 @@ resolve_omp_atomic (gfc_code *code)
&& arg->expr->symtree->n.sym == var)
var_arg = arg;
else if (expr_references_sym (arg->expr, var, NULL))
{
gfc_error ("!$OMP ATOMIC intrinsic arguments except one must "
- "not reference '%s' at %L",
+ "not reference %qs at %L",
var->name, &arg->expr->where);
return;
}
if (arg->expr->rank != 0)
{
@@ -2944,11 +2944,11 @@ resolve_omp_atomic (gfc_code *code)
}
if (var_arg == NULL)
{
gfc_error ("First or last !$OMP ATOMIC intrinsic argument must "
- "be '%s' at %L", var->name, &expr2->where);
+ "be %qs at %L", var->name, &expr2->where);
return;
}
if (var_arg != expr2->value.function.actual)
{
@@ -3412,11 +3412,11 @@ gfc_resolve_omp_declare_simd (gfc_namesp
for (ods = ns->omp_declare_simd; ods; ods = ods->next)
{
if (ods->proc_name != ns->proc_name)
gfc_error ("!$OMP DECLARE SIMD should refer to containing procedure "
- "'%s' at %L", ns->proc_name->name, &ods->where);
+ "%qs at %L", ns->proc_name->name, &ods->where);
if (ods->clauses)
resolve_omp_clauses (NULL, &ods->where, ods->clauses, ns);
}
}
Index: gcc/fortran/interface.c
===================================================================
--- gcc/fortran/interface.c (revision 218457)
+++ gcc/fortran/interface.c (working copy)
@@ -217,11 +217,11 @@ gfc_match_interface (void)
&& !gfc_add_generic (&sym->attr, sym->name, NULL))
return MATCH_ERROR;
if (sym->attr.dummy)
{
- gfc_error ("Dummy procedure '%s' at %C cannot have a "
+ gfc_error ("Dummy procedure %qs at %C cannot have a "
"generic interface", sym->name);
return MATCH_ERROR;
}
current_interface.sym = gfc_new_block = sym;
@@ -1559,14 +1559,14 @@ check_interface0 (gfc_interface *p, cons
if (((!p->sym->attr.function && !p->sym->attr.subroutine)
|| !p->sym->attr.if_source)
&& p->sym->attr.flavor != FL_DERIVED)
{
if (p->sym->attr.external)
- gfc_error ("Procedure '%s' in %s at %L has no explicit interface",
+ gfc_error ("Procedure %qs in %s at %L has no explicit interface",
p->sym->name, interface_name, &p->sym->declared_at);
else
- gfc_error ("Procedure '%s' in %s at %L is neither function nor "
+ gfc_error ("Procedure %qs in %s at %L is neither function nor "
"subroutine", p->sym->name, interface_name,
&p->sym->declared_at);
return 1;
}
@@ -1643,11 +1643,11 @@ check_interface1 (gfc_interface *p, gfc_
&& q->sym->attr.flavor != FL_DERIVED
&& gfc_compare_interfaces (p->sym, q->sym, q->sym->name,
generic_flag, 0, NULL, 0, NULL, NULL))
{
if (referenced)
- gfc_error ("Ambiguous interfaces '%s' and '%s' in %s at %L",
+ gfc_error ("Ambiguous interfaces %qs and %qs in %s at %L",
p->sym->name, q->sym->name, interface_name,
&p->where);
else if (!p->sym->attr.use_assoc && q->sym->attr.use_assoc)
gfc_warning ("Ambiguous interfaces %qs and %qs in %s at %L",
p->sym->name, q->sym->name, interface_name,
@@ -1685,11 +1685,11 @@ check_sym_interfaces (gfc_symbol *sym)
{
if (p->sym->attr.mod_proc
&& (p->sym->attr.if_source != IFSRC_DECL
|| p->sym->attr.procedure))
{
- gfc_error ("'%s' at %L is not a module procedure",
+ gfc_error ("%qs at %L is not a module procedure",
p->sym->name, &p->where);
return;
}
}
@@ -1890,25 +1890,25 @@ argument_rank_mismatch (const char *name
/* TS 29113, C407b. */
if (rank2 == -1)
{
gfc_error ("The assumed-rank array at %L requires that the dummy argument"
- " '%s' has assumed-rank", where, name);
+ " %qs has assumed-rank", where, name);
}
else if (rank1 == 0)
{
- gfc_error ("Rank mismatch in argument '%s' at %L "
+ gfc_error ("Rank mismatch in argument %qs at %L "
"(scalar and rank-%d)", name, where, rank2);
}
else if (rank2 == 0)
{
- gfc_error ("Rank mismatch in argument '%s' at %L "
+ gfc_error ("Rank mismatch in argument %qs at %L "
"(rank-%d and scalar)", name, where, rank1);
}
else
{
- gfc_error ("Rank mismatch in argument '%s' at %L "
+ gfc_error ("Rank mismatch in argument %qs at %L "
"(rank-%d and rank-%d)", name, where, rank1, rank2);
}
}
@@ -1954,11 +1954,11 @@ compare_parameter (gfc_symbol *formal, g
if (!gfc_compare_interfaces (formal, act_sym, act_sym->name, 0, 1, err,
sizeof(err), NULL, NULL))
{
if (where)
- gfc_error ("Interface mismatch in dummy procedure '%s' at %L: %s",
+ gfc_error ("Interface mismatch in dummy procedure %qs at %L: %s",
formal->name, &actual->where, err);
return 0;
}
if (formal->attr.function && !act_sym->attr.function)
@@ -1979,11 +1979,11 @@ compare_parameter (gfc_symbol *formal, g
/* F2008, C1241. */
if (formal->attr.pointer && formal->attr.contiguous
&& !gfc_is_simply_contiguous (actual, true))
{
if (where)
- gfc_error ("Actual argument to contiguous pointer dummy '%s' at %L "
+ gfc_error ("Actual argument to contiguous pointer dummy %qs at %L "
"must be simply contiguous", formal->name, &actual->where);
return 0;
}
if ((actual->expr_type != EXPR_NULL || actual->ts.type != BT_UNKNOWN)
@@ -1994,21 +1994,21 @@ compare_parameter (gfc_symbol *formal, g
&& !(formal->ts.type == BT_DERIVED && actual->ts.type == BT_CLASS
&& gfc_compare_derived_types (formal->ts.u.derived,
CLASS_DATA (actual)->ts.u.derived)))
{
if (where)
- gfc_error ("Type mismatch in argument '%s' at %L; passed %s to %s",
+ gfc_error ("Type mismatch in argument %qs at %L; passed %s to %s",
formal->name, &actual->where, gfc_typename (&actual->ts),
gfc_typename (&formal->ts));
return 0;
}
if (actual->ts.type == BT_ASSUMED && formal->ts.type != BT_ASSUMED)
{
if (where)
gfc_error ("Assumed-type actual argument at %L requires that dummy "
- "argument '%s' is of assumed type", &actual->where,
+ "argument %qs is of assumed type", &actual->where,
formal->name);
return 0;
}
/* F2008, 12.5.2.5; IR F08/0073. */
@@ -2019,11 +2019,11 @@ compare_parameter (gfc_symbol *formal, g
|| CLASS_DATA (formal)->attr.allocatable))
{
if (actual->ts.type != BT_CLASS)
{
if (where)
- gfc_error ("Actual argument to '%s' at %L must be polymorphic",
+ gfc_error ("Actual argument to %qs at %L must be polymorphic",
formal->name, &actual->where);
return 0;
}
if (!gfc_expr_attr (actual).class_ok)
@@ -2032,11 +2032,11 @@ compare_parameter (gfc_symbol *formal, g
if ((!UNLIMITED_POLY (formal) || !UNLIMITED_POLY(actual))
&& !gfc_compare_derived_types (CLASS_DATA (actual)->ts.u.derived,
CLASS_DATA (formal)->ts.u.derived))
{
if (where)
- gfc_error ("Actual argument to '%s' at %L must have the same "
+ gfc_error ("Actual argument to %qs at %L must have the same "
"declared type", formal->name, &actual->where);
return 0;
}
}
@@ -2047,22 +2047,22 @@ compare_parameter (gfc_symbol *formal, g
if (UNLIMITED_POLY (formal) && !UNLIMITED_POLY (actual)
&& (CLASS_DATA (formal)->attr.allocatable
||CLASS_DATA (formal)->attr.class_pointer))
{
if (where)
- gfc_error ("Actual argument to '%s' at %L must be unlimited "
+ gfc_error ("Actual argument to %qs at %L must be unlimited "
"polymorphic since the formal argument is a "
"pointer or allocatable unlimited polymorphic "
"entity [F2008: 12.5.2.5]", formal->name,
&actual->where);
return 0;
}
if (formal->attr.codimension && !gfc_is_coarray (actual))
{
if (where)
- gfc_error ("Actual argument to '%s' at %L must be a coarray",
+ gfc_error ("Actual argument to %qs at %L must be a coarray",
formal->name, &actual->where);
return 0;
}
if (formal->attr.codimension && formal->attr.allocatable)
@@ -2077,11 +2077,11 @@ compare_parameter (gfc_symbol *formal, g
if ((last && last->u.c.component->as->corank != formal->as->corank)
|| (!last
&& actual->symtree->n.sym->as->corank != formal->as->corank))
{
if (where)
- gfc_error ("Corank mismatch in argument '%s' at %L (%d and %d)",
+ gfc_error ("Corank mismatch in argument %qs at %L (%d and %d)",
formal->name, &actual->where, formal->as->corank,
last ? last->u.c.component->as->corank
: actual->symtree->n.sym->as->corank);
return 0;
}
@@ -2094,11 +2094,11 @@ compare_parameter (gfc_symbol *formal, g
&& (formal->attr.contiguous || formal->as->type != AS_ASSUMED_SHAPE)
&& gfc_expr_attr (actual).dimension
&& !gfc_is_simply_contiguous (actual, true))
{
if (where)
- gfc_error ("Actual argument to '%s' at %L must be simply "
+ gfc_error ("Actual argument to %qs at %L must be simply "
"contiguous", formal->name, &actual->where);
return 0;
}
/* F2008, C1303 and C1304. */
@@ -2108,11 +2108,11 @@ compare_parameter (gfc_symbol *formal, g
&& formal->ts.u.derived->intmod_sym_id == ISOFORTRAN_LOCK_TYPE)
|| formal->attr.lock_comp))
{
if (where)
- gfc_error ("Actual argument to non-INTENT(INOUT) dummy '%s' at %L, "
+ gfc_error ("Actual argument to non-INTENT(INOUT) dummy %qs at %L, "
"which is LOCK_TYPE or has a LOCK_TYPE component",
formal->name, &actual->where);
return 0;
}
}
@@ -2126,11 +2126,11 @@ compare_parameter (gfc_symbol *formal, g
&& ((formal->as->type != AS_ASSUMED_SHAPE
&& formal->as->type != AS_ASSUMED_RANK && !formal->attr.pointer)
|| formal->attr.contiguous))
{
if (where)
- gfc_error ("Dummy argument '%s' has to be a pointer, assumed-shape or "
+ gfc_error ("Dummy argument %qs has to be a pointer, assumed-shape or "
"assumed-rank array without CONTIGUOUS attribute - as actual"
" argument at %L is not simply contiguous and both are "
"ASYNCHRONOUS or VOLATILE", formal->name, &actual->where);
return 0;
}
@@ -2140,11 +2140,11 @@ compare_parameter (gfc_symbol *formal, g
{
if (formal->attr.intent == INTENT_OUT)
{
if (where)
gfc_error ("Passing coarray at %L to allocatable, noncoarray, "
- "INTENT(OUT) dummy argument '%s'", &actual->where,
+ "INTENT(OUT) dummy argument %qs", &actual->where,
formal->name);
return 0;
}
else if (warn_surprising && where && formal->attr.intent != INTENT_IN)
gfc_warning (OPT_Wsurprising,
@@ -2209,21 +2209,21 @@ compare_parameter (gfc_symbol *formal, g
}
if (actual->ts.type == BT_CLASS && actual->expr_type != EXPR_NULL)
{
if (where)
- gfc_error ("Polymorphic scalar passed to array dummy argument '%s' "
+ gfc_error ("Polymorphic scalar passed to array dummy argument %qs "
"at %L", formal->name, &actual->where);
return 0;
}
if (actual->expr_type != EXPR_NULL && ref && actual->ts.type != BT_CHARACTER
&& (is_pointer || ref->u.ar.as->type == AS_ASSUMED_SHAPE))
{
if (where)
gfc_error ("Element of assumed-shaped or pointer "
- "array passed to array dummy argument '%s' at %L",
+ "array passed to array dummy argument %qs at %L",
formal->name, &actual->where);
return 0;
}
if (actual->ts.type == BT_CHARACTER && actual->expr_type != EXPR_NULL
@@ -2232,18 +2232,18 @@ compare_parameter (gfc_symbol *formal, g
if (formal->ts.kind != 1 && (gfc_option.allow_std & GFC_STD_GNU) == 0)
{
if (where)
gfc_error ("Extension: Scalar non-default-kind, non-C_CHAR-kind "
"CHARACTER actual argument with array dummy argument "
- "'%s' at %L", formal->name, &actual->where);
+ "%qs at %L", formal->name, &actual->where);
return 0;
}
if (where && (gfc_option.allow_std & GFC_STD_F2003) == 0)
{
gfc_error ("Fortran 2003: Scalar CHARACTER actual argument with "
- "array dummy argument '%s' at %L",
+ "array dummy argument %qs at %L",
formal->name, &actual->where);
return 0;
}
else if ((gfc_option.allow_std & GFC_STD_F2003) == 0)
return 0;
@@ -2553,19 +2553,19 @@ compare_actual_formal (gfc_actual_arglis
}
if (f == NULL)
{
if (where)
- gfc_error ("Keyword argument '%s' at %L is not in "
+ gfc_error ("Keyword argument %qs at %L is not in "
"the procedure", a->name, &a->expr->where);
return 0;
}
if (new_arg[i] != NULL)
{
if (where)
- gfc_error ("Keyword argument '%s' at %L is already associated "
+ gfc_error ("Keyword argument %qs at %L is already associated "
"with another actual argument", a->name,
&a->expr->where);
return 0;
}
}
@@ -2618,15 +2618,15 @@ compare_actual_formal (gfc_actual_arglis
if (where
&& (!f->sym->attr.optional
|| (f->sym->ts.type != BT_CLASS && f->sym->attr.allocatable)
|| (f->sym->ts.type == BT_CLASS
&& CLASS_DATA (f->sym)->attr.allocatable)))
- gfc_error ("Unexpected NULL() intrinsic at %L to dummy '%s'",
+ gfc_error ("Unexpected NULL() intrinsic at %L to dummy %qs",
where, f->sym->name);
else if (where)
gfc_error ("Fortran 2008: Null pointer at %L to non-pointer "
- "dummy '%s'", where, f->sym->name);
+ "dummy %qs", where, f->sym->name);
return 0;
}
if (!compare_parameter (f->sym, a->expr, ranks_must_agree,
@@ -2688,11 +2688,11 @@ compare_actual_formal (gfc_actual_arglis
&& f->sym->ts.deferred != a->expr->ts.deferred
&& a->expr->ts.type == BT_CHARACTER)
{
if (where)
gfc_error ("Actual argument at %L to allocatable or "
- "pointer dummy argument '%s' must have a deferred "
+ "pointer dummy argument %qs must have a deferred "
"length type parameter if and only if the dummy has one",
&a->expr->where, f->sym->name);
return 0;
}
@@ -2728,22 +2728,22 @@ compare_actual_formal (gfc_actual_arglis
|| (a->expr->expr_type == EXPR_FUNCTION
&& a->expr->symtree->n.sym->result->attr.proc_pointer)
|| gfc_is_proc_ptr_comp (a->expr)))
{
if (where)
- gfc_error ("Expected a procedure pointer for argument '%s' at %L",
+ gfc_error ("Expected a procedure pointer for argument %qs at %L",
f->sym->name, &a->expr->where);
return 0;
}
/* Satisfy F03:12.4.1.3 by ensuring that a procedure actual argument is
provided for a procedure formal argument. */
if (f->sym->attr.flavor == FL_PROCEDURE
&& gfc_expr_attr (a->expr).flavor != FL_PROCEDURE)
{
if (where)
- gfc_error ("Expected a procedure for argument '%s' at %L",
+ gfc_error ("Expected a procedure for argument %qs at %L",
f->sym->name, &a->expr->where);
return 0;
}
if (f->sym->as && f->sym->as->type == AS_ASSUMED_SHAPE
@@ -2753,41 +2753,41 @@ compare_actual_formal (gfc_actual_arglis
&& (a->expr->ref == NULL
|| (a->expr->ref->type == REF_ARRAY
&& a->expr->ref->u.ar.type == AR_FULL)))
{
if (where)
- gfc_error ("Actual argument for '%s' cannot be an assumed-size"
+ gfc_error ("Actual argument for %qs cannot be an assumed-size"
" array at %L", f->sym->name, where);
return 0;
}
if (a->expr->expr_type != EXPR_NULL
&& compare_pointer (f->sym, a->expr) == 0)
{
if (where)
- gfc_error ("Actual argument for '%s' must be a pointer at %L",
+ gfc_error ("Actual argument for %qs must be a pointer at %L",
f->sym->name, &a->expr->where);
return 0;
}
if (a->expr->expr_type != EXPR_NULL
&& (gfc_option.allow_std & GFC_STD_F2008) == 0
&& compare_pointer (f->sym, a->expr) == 2)
{
if (where)
gfc_error ("Fortran 2008: Non-pointer actual argument at %L to "
- "pointer dummy '%s'", &a->expr->where,f->sym->name);
+ "pointer dummy %qs", &a->expr->where,f->sym->name);
return 0;
}
/* Fortran 2008, C1242. */
if (f->sym->attr.pointer && gfc_is_coindexed (a->expr))
{
if (where)
gfc_error ("Coindexed actual argument at %L to pointer "
- "dummy '%s'",
+ "dummy %qs",
&a->expr->where, f->sym->name);
return 0;
}
/* Fortran 2008, 12.5.2.5 (no constraint). */
@@ -2796,11 +2796,11 @@ compare_actual_formal (gfc_actual_arglis
&& f->sym->attr.allocatable
&& gfc_is_coindexed (a->expr))
{
if (where)
gfc_error ("Coindexed actual argument at %L to allocatable "
- "dummy '%s' requires INTENT(IN)",
+ "dummy %qs requires INTENT(IN)",
&a->expr->where, f->sym->name);
return 0;
}
/* Fortran 2008, C1237. */
@@ -2810,11 +2810,11 @@ compare_actual_formal (gfc_actual_arglis
&& (a->expr->symtree->n.sym->attr.volatile_
|| a->expr->symtree->n.sym->attr.asynchronous))
{
if (where)
gfc_error ("Coindexed ASYNCHRONOUS or VOLATILE actual argument at "
- "%L requires that dummy '%s' has neither "
+ "%L requires that dummy %qs has neither "
"ASYNCHRONOUS nor VOLATILE", &a->expr->where,
f->sym->name);
return 0;
}
@@ -2824,32 +2824,32 @@ compare_actual_formal (gfc_actual_arglis
&& gfc_is_coindexed (a->expr)
&& gfc_has_ultimate_allocatable (a->expr))
{
if (where)
gfc_error ("Coindexed actual argument at %L with allocatable "
- "ultimate component to dummy '%s' requires either VALUE "
+ "ultimate component to dummy %qs requires either VALUE "
"or INTENT(IN)", &a->expr->where, f->sym->name);
return 0;
}
if (f->sym->ts.type == BT_CLASS
&& CLASS_DATA (f->sym)->attr.allocatable
&& gfc_is_class_array_ref (a->expr, &full_array)
&& !full_array)
{
if (where)
- gfc_error ("Actual CLASS array argument for '%s' must be a full "
+ gfc_error ("Actual CLASS array argument for %qs must be a full "
"array at %L", f->sym->name, &a->expr->where);
return 0;
}
if (a->expr->expr_type != EXPR_NULL
&& compare_allocatable (f->sym, a->expr) == 0)
{
if (where)
- gfc_error ("Actual argument for '%s' must be ALLOCATABLE at %L",
+ gfc_error ("Actual argument for %qs must be ALLOCATABLE at %L",
f->sym->name, &a->expr->where);
return 0;
}
/* Check intent = OUT/INOUT for definable actual argument. */
@@ -2877,11 +2877,11 @@ compare_actual_formal (gfc_actual_arglis
{
if (where)
gfc_error ("Array-section actual argument with vector "
"subscripts at %L is incompatible with INTENT(OUT), "
"INTENT(INOUT), VOLATILE or ASYNCHRONOUS attribute "
- "of the dummy argument '%s'",
+ "of the dummy argument %qs",
&a->expr->where, f->sym->name);
return 0;
}
/* C1232 (R1221) For an actual argument which is an array section or
@@ -2894,11 +2894,11 @@ compare_actual_formal (gfc_actual_arglis
&& !(f->sym->as && f->sym->as->type == AS_ASSUMED_SHAPE))
{
if (where)
gfc_error ("Assumed-shape actual argument at %L is "
"incompatible with the non-assumed-shape "
- "dummy argument '%s' due to VOLATILE attribute",
+ "dummy argument %qs due to VOLATILE attribute",
&a->expr->where,f->sym->name);
return 0;
}
if (f->sym->attr.volatile_
@@ -2906,11 +2906,11 @@ compare_actual_formal (gfc_actual_arglis
&& !(f->sym->as && f->sym->as->type == AS_ASSUMED_SHAPE))
{
if (where)
gfc_error ("Array-section actual argument at %L is "
"incompatible with the non-assumed-shape "
- "dummy argument '%s' due to VOLATILE attribute",
+ "dummy argument %qs due to VOLATILE attribute",
&a->expr->where,f->sym->name);
return 0;
}
/* C1233 (R1221) For an actual argument which is a pointer array, the
@@ -2925,11 +2925,11 @@ compare_actual_formal (gfc_actual_arglis
|| f->sym->attr.pointer)))
{
if (where)
gfc_error ("Pointer-array actual argument at %L requires "
"an assumed-shape or pointer-array dummy "
- "argument '%s' due to VOLATILE attribute",
+ "argument %qs due to VOLATILE attribute",
&a->expr->where,f->sym->name);
return 0;
}
match:
@@ -2953,11 +2953,11 @@ compare_actual_formal (gfc_actual_arglis
return 0;
}
if (!f->sym->attr.optional)
{
if (where)
- gfc_error ("Missing actual argument for argument '%s' at %L",
+ gfc_error ("Missing actual argument for argument %qs at %L",
f->sym->name, where);
return 0;
}
}
@@ -3224,11 +3224,11 @@ check_intents (gfc_formal_arglist *f, gf
/* F2008, Section 12.5.2.4. */
if (expr->ts.type == BT_CLASS && f->sym->ts.type == BT_CLASS
&& gfc_is_coindexed (expr))
{
gfc_error ("Coindexed polymorphic actual argument at %L is passed "
- "polymorphic dummy argument '%s'",
+ "polymorphic dummy argument %qs",
&expr->where, f->sym->name);
return false;
}
}
@@ -3251,11 +3251,11 @@ gfc_procedure_use (gfc_symbol *sym, gfc_
explicitly declared at all if requested. */
if (sym->attr.if_source == IFSRC_UNKNOWN && !sym->attr.is_iso_c)
{
if (sym->ns->has_implicit_none_export && sym->attr.proc == PROC_UNKNOWN)
{
- gfc_error ("Procedure '%s' called at %L is not explicitly declared",
+ gfc_error ("Procedure %qs called at %L is not explicitly declared",
sym->name, where);
return false;
}
if (warn_implicit_interface)
gfc_warning (OPT_Wimplicit_interface,
@@ -3271,38 +3271,38 @@ gfc_procedure_use (gfc_symbol *sym, gfc_
{
gfc_actual_arglist *a;
if (sym->attr.pointer)
{
- gfc_error("The pointer object '%s' at %L must have an explicit "
- "function interface or be declared as array",
- sym->name, where);
+ gfc_error ("The pointer object %qs at %L must have an explicit "
+ "function interface or be declared as array",
+ sym->name, where);
return false;
}
if (sym->attr.allocatable && !sym->attr.external)
{
- gfc_error("The allocatable object '%s' at %L must have an explicit "
- "function interface or be declared as array",
- sym->name, where);
+ gfc_error ("The allocatable object %qs at %L must have an explicit "
+ "function interface or be declared as array",
+ sym->name, where);
return false;
}
if (sym->attr.allocatable)
{
- gfc_error("Allocatable function '%s' at %L must have an explicit "
- "function interface", sym->name, where);
+ gfc_error ("Allocatable function %qs at %L must have an explicit "
+ "function interface", sym->name, where);
return false;
}
for (a = *ap; a; a = a->next)
{
/* Skip g77 keyword extensions like %VAL, %REF, %LOC. */
if (a->name != NULL && a->name[0] != '%')
{
- gfc_error("Keyword argument requires explicit interface "
- "for procedure '%s' at %L", sym->name, &a->expr->where);
+ gfc_error ("Keyword argument requires explicit interface "
+ "for procedure %qs at %L", sym->name, &a->expr->where);
break;
}
/* TS 29113, 6.2. */
if (a->expr && a->expr->ts.type == BT_ASSUMED
@@ -3319,13 +3319,13 @@ gfc_procedure_use (gfc_symbol *sym, gfc_
&& (a->expr->ts.type == BT_DERIVED || a->expr->ts.type == BT_CLASS)
&& ((a->expr->ts.u.derived->from_intmod == INTMOD_ISO_FORTRAN_ENV
&& a->expr->ts.u.derived->intmod_sym_id == ISOFORTRAN_LOCK_TYPE)
|| gfc_expr_attr (a->expr).lock_comp))
{
- gfc_error("Actual argument of LOCK_TYPE or with LOCK_TYPE "
- "component at %L requires an explicit interface for "
- "procedure '%s'", &a->expr->where, sym->name);
+ gfc_error ("Actual argument of LOCK_TYPE or with LOCK_TYPE "
+ "component at %L requires an explicit interface for "
+ "procedure %qs", &a->expr->where, sym->name);
break;
}
if (a->expr && a->expr->expr_type == EXPR_NULL
&& a->expr->ts.type == BT_UNKNOWN)
@@ -3385,13 +3385,13 @@ gfc_ppc_use (gfc_component *comp, gfc_ac
for (a = *ap; a; a = a->next)
{
/* Skip g77 keyword extensions like %VAL, %REF, %LOC. */
if (a->name != NULL && a->name[0] != '%')
{
- gfc_error("Keyword argument requires explicit interface "
- "for procedure pointer component '%s' at %L",
- comp->name, &a->expr->where);
+ gfc_error ("Keyword argument requires explicit interface "
+ "for procedure pointer component %qs at %L",
+ comp->name, &a->expr->where);
break;
}
}
return;
@@ -3911,11 +3911,11 @@ gfc_check_new_interface (gfc_interface *
for (ip = base; ip; ip = ip->next)
{
if (ip->sym == new_sym)
{
- gfc_error ("Entity '%s' at %L is already present in the interface",
+ gfc_error ("Entity %qs at %L is already present in the interface",
new_sym->name, &loc);
return false;
}
}
@@ -4122,11 +4122,11 @@ gfc_check_typebound_override (gfc_symtre
gcc_assert (!proc->n.tb->is_generic);
/* If the overwritten procedure is GENERIC, this is an error. */
if (old->n.tb->is_generic)
{
- gfc_error ("Can't overwrite GENERIC '%s' at %L",
+ gfc_error ("Can't overwrite GENERIC %qs at %L",
old->name, &proc->n.tb->where);
return false;
}
where = proc->n.tb->where;
@@ -4134,81 +4134,81 @@ gfc_check_typebound_override (gfc_symtre
old_target = old->n.tb->u.specific->n.sym;
/* Check that overridden binding is not NON_OVERRIDABLE. */
if (old->n.tb->non_overridable)
{
- gfc_error ("'%s' at %L overrides a procedure binding declared"
+ gfc_error ("%qs at %L overrides a procedure binding declared"
" NON_OVERRIDABLE", proc->name, &where);
return false;
}
/* It's an error to override a non-DEFERRED procedure with a DEFERRED one. */
if (!old->n.tb->deferred && proc->n.tb->deferred)
{
- gfc_error ("'%s' at %L must not be DEFERRED as it overrides a"
+ gfc_error ("%qs at %L must not be DEFERRED as it overrides a"
" non-DEFERRED binding", proc->name, &where);
return false;
}
/* If the overridden binding is PURE, the overriding must be, too. */
if (old_target->attr.pure && !proc_target->attr.pure)
{
- gfc_error ("'%s' at %L overrides a PURE procedure and must also be PURE",
+ gfc_error ("%qs at %L overrides a PURE procedure and must also be PURE",
proc->name, &where);
return false;
}
/* If the overridden binding is ELEMENTAL, the overriding must be, too. If it
is not, the overriding must not be either. */
if (old_target->attr.elemental && !proc_target->attr.elemental)
{
- gfc_error ("'%s' at %L overrides an ELEMENTAL procedure and must also be"
+ gfc_error ("%qs at %L overrides an ELEMENTAL procedure and must also be"
" ELEMENTAL", proc->name, &where);
return false;
}
if (!old_target->attr.elemental && proc_target->attr.elemental)
{
- gfc_error ("'%s' at %L overrides a non-ELEMENTAL procedure and must not"
+ gfc_error ("%qs at %L overrides a non-ELEMENTAL procedure and must not"
" be ELEMENTAL, either", proc->name, &where);
return false;
}
/* If the overridden binding is a SUBROUTINE, the overriding must also be a
SUBROUTINE. */
if (old_target->attr.subroutine && !proc_target->attr.subroutine)
{
- gfc_error ("'%s' at %L overrides a SUBROUTINE and must also be a"
+ gfc_error ("%qs at %L overrides a SUBROUTINE and must also be a"
" SUBROUTINE", proc->name, &where);
return false;
}
/* If the overridden binding is a FUNCTION, the overriding must also be a
FUNCTION and have the same characteristics. */
if (old_target->attr.function)
{
if (!proc_target->attr.function)
{
- gfc_error ("'%s' at %L overrides a FUNCTION and must also be a"
+ gfc_error ("%qs at %L overrides a FUNCTION and must also be a"
" FUNCTION", proc->name, &where);
return false;
}
if (!check_result_characteristics (proc_target, old_target, err,
sizeof(err)))
{
gfc_error ("Result mismatch for the overriding procedure "
- "'%s' at %L: %s", proc->name, &where, err);
+ "%qs at %L: %s", proc->name, &where, err);
return false;
}
}
/* If the overridden binding is PUBLIC, the overriding one must not be
PRIVATE. */
if (old->n.tb->access == ACCESS_PUBLIC
&& proc->n.tb->access == ACCESS_PRIVATE)
{
- gfc_error ("'%s' at %L overrides a PUBLIC procedure and must not be"
+ gfc_error ("%qs at %L overrides a PUBLIC procedure and must not be"
" PRIVATE", proc->name, &where);
return false;
}
/* Compare the formal argument lists of both procedures. This is also abused
@@ -4234,11 +4234,11 @@ gfc_check_typebound_override (gfc_symtre
old_pass_arg = argpos;
/* Check that the names correspond. */
if (strcmp (proc_formal->sym->name, old_formal->sym->name))
{
- gfc_error ("Dummy argument '%s' of '%s' at %L should be named '%s' as"
+ gfc_error ("Dummy argument %qs of %qs at %L should be named %qs as"
" to match the corresponding argument of the overridden"
" procedure", proc_formal->sym->name, proc->name, &where,
old_formal->sym->name);
return false;
}
@@ -4246,46 +4246,46 @@ gfc_check_typebound_override (gfc_symtre
check_type = proc_pass_arg != argpos && old_pass_arg != argpos;
if (!check_dummy_characteristics (proc_formal->sym, old_formal->sym,
check_type, err, sizeof(err)))
{
gfc_error ("Argument mismatch for the overriding procedure "
- "'%s' at %L: %s", proc->name, &where, err);
+ "%qs at %L: %s", proc->name, &where, err);
return false;
}
++argpos;
}
if (proc_formal || old_formal)
{
- gfc_error ("'%s' at %L must have the same number of formal arguments as"
+ gfc_error ("%qs at %L must have the same number of formal arguments as"
" the overridden procedure", proc->name, &where);
return false;
}
/* If the overridden binding is NOPASS, the overriding one must also be
NOPASS. */
if (old->n.tb->nopass && !proc->n.tb->nopass)
{
- gfc_error ("'%s' at %L overrides a NOPASS binding and must also be"
+ gfc_error ("%qs at %L overrides a NOPASS binding and must also be"
" NOPASS", proc->name, &where);
return false;
}
/* If the overridden binding is PASS(x), the overriding one must also be
PASS and the passed-object dummy arguments must correspond. */
if (!old->n.tb->nopass)
{
if (proc->n.tb->nopass)
{
- gfc_error ("'%s' at %L overrides a binding with PASS and must also be"
+ gfc_error ("%qs at %L overrides a binding with PASS and must also be"
" PASS", proc->name, &where);
return false;
}
if (proc_pass_arg != old_pass_arg)
{
- gfc_error ("Passed-object dummy argument of '%s' at %L must be at"
+ gfc_error ("Passed-object dummy argument of %qs at %L must be at"
" the same position as the passed-object dummy argument of"
" the overridden procedure", proc->name, &where);
return false;
}
}
Index: gcc/fortran/intrinsic.c
===================================================================
--- gcc/fortran/intrinsic.c (revision 218457)
+++ gcc/fortran/intrinsic.c (working copy)
@@ -3813,11 +3813,11 @@ sort_actual (const char *name, gfc_actua
}
if (a == NULL)
goto do_sort;
- gfc_error ("Too many arguments in call to '%s' at %L", name, where);
+ gfc_error ("Too many arguments in call to %qs at %L", name, where);
return false;
keywords:
/* Associate the remaining actual arguments, all of which have
to be keyword arguments. */
@@ -3831,18 +3831,18 @@ keywords:
{
if (a->name[0] == '%')
gfc_error ("The argument list functions %%VAL, %%LOC or %%REF "
"are not allowed in this context at %L", where);
else
- gfc_error ("Can't find keyword named '%s' in call to '%s' at %L",
+ gfc_error ("Can't find keyword named %qs in call to %qs at %L",
a->name, name, where);
return false;
}
if (f->actual != NULL)
{
- gfc_error ("Argument '%s' appears twice in call to '%s' at %L",
+ gfc_error ("Argument %qs appears twice in call to %qs at %L",
f->name, name, where);
return false;
}
f->actual = a;
@@ -3852,11 +3852,11 @@ optional:
/* At this point, all unmatched formal args must be optional. */
for (f = formal; f; f = f->next)
{
if (f->actual == NULL && f->optional == 0)
{
- gfc_error ("Missing actual argument '%s' in call to '%s' at %L",
+ gfc_error ("Missing actual argument %qs in call to %qs at %L",
f->name, name, where);
return false;
}
}
@@ -3924,11 +3924,11 @@ check_arglist (gfc_actual_arglist **ap,
ts.kind = actual->expr->ts.kind;
if (!gfc_compare_types (&ts, &actual->expr->ts))
{
if (error_flag)
- gfc_error ("Type of argument '%s' in call to '%s' at %L should "
+ gfc_error ("Type of argument %qs in call to %qs at %L should "
"be %s, not %s", gfc_current_intrinsic_arg[i]->name,
gfc_current_intrinsic, &actual->expr->where,
gfc_typename (&formal->ts),
gfc_typename (&actual->expr->ts));
return false;
@@ -4532,18 +4532,18 @@ gfc_intrinsic_sub_interface (gfc_code *c
c->resolved_sym->attr.elemental = isym->elemental;
}
if (gfc_do_concurrent_flag && !isym->pure)
{
- gfc_error ("Subroutine call to intrinsic '%s' in DO CONCURRENT "
+ gfc_error ("Subroutine call to intrinsic %qs in DO CONCURRENT "
"block at %L is not PURE", name, &c->loc);
return MATCH_ERROR;
}
if (!isym->pure && gfc_pure (NULL))
{
- gfc_error ("Subroutine call to intrinsic '%s' at %L is not PURE", name,
+ gfc_error ("Subroutine call to intrinsic %qs at %L is not PURE", name,
&c->loc);
return MATCH_ERROR;
}
if (!isym->pure)
Index: gcc/fortran/symbol.c
===================================================================
--- gcc/fortran/symbol.c (revision 218457)
+++ gcc/fortran/symbol.c (working copy)
@@ -1699,22 +1699,22 @@ gfc_add_type (gfc_symbol *sym, gfc_types
type = sym->ns->proc_name->ts.type;
if (type != BT_UNKNOWN && !(sym->attr.function && sym->attr.implicit_type))
{
if (sym->attr.use_assoc)
- gfc_error ("Symbol '%s' at %L conflicts with symbol from module '%s', "
+ gfc_error_1 ("Symbol '%s' at %L conflicts with symbol from module '%s', "
"use-associated at %L", sym->name, where, sym->module,
&sym->declared_at);
else
- gfc_error ("Symbol '%s' at %L already has basic type of %s", sym->name,
+ gfc_error ("Symbol %qs at %L already has basic type of %s", sym->name,
where, gfc_basic_typename (type));
return false;
}
if (sym->attr.procedure && sym->ts.interface)
{
- gfc_error ("Procedure '%s' at %L may not have basic type of %s",
+ gfc_error ("Procedure %qs at %L may not have basic type of %s",
sym->name, where, gfc_basic_typename (ts->type));
return false;
}
flavor = sym->attr.flavor;
@@ -1893,22 +1893,22 @@ gfc_add_component (gfc_symbol *sym, cons
for (p = sym->components; p; p = p->next)
{
if (strcmp (p->name, name) == 0)
{
- gfc_error ("Component '%s' at %C already declared at %L",
+ gfc_error_1 ("Component '%s' at %C already declared at %L",
name, &p->loc);
return false;
}
tail = p;
}
if (sym->attr.extension
&& gfc_find_component (sym->components->ts.u.derived, name, true, true))
{
- gfc_error ("Component '%s' at %C already in the parent type "
+ gfc_error_1 ("Component '%s' at %C already in the parent type "
"at %L", name, &sym->components->ts.u.derived->declared_at);
return false;
}
/* Allocate a new component. */
@@ -2059,11 +2059,11 @@ gfc_find_component (gfc_symbol *sym, con
(p->attr.access != ACCESS_PUBLIC
&& sym->component_access == ACCESS_PRIVATE
&& !is_parent_comp))
{
if (!silent)
- gfc_error ("Component '%s' at %C is a PRIVATE component of '%s'",
+ gfc_error ("Component %qs at %C is a PRIVATE component of %qs",
name, sym->name);
return NULL;
}
}
@@ -2077,11 +2077,11 @@ gfc_find_component (gfc_symbol *sym, con
if (p == NULL)
return p;
}
if (p == NULL && !silent)
- gfc_error ("'%s' at %C is not a member of the '%s' structure",
+ gfc_error ("%qs at %C is not a member of the %qs structure",
name, sym->name);
return p;
}
@@ -2216,11 +2216,11 @@ gfc_define_st_label (gfc_st_label *lp, g
int labelno;
labelno = lp->value;
if (lp->defined != ST_LABEL_UNKNOWN)
- gfc_error ("Duplicate statement label %d at %L and %L", labelno,
+ gfc_error_1 ("Duplicate statement label %d at %L and %L", labelno,
&lp->where, label_locus);
else
{
lp->where = *label_locus;
@@ -2626,14 +2626,14 @@ gfc_new_symbol (const char *name, gfc_na
static void
ambiguous_symbol (const char *name, gfc_symtree *st)
{
if (st->n.sym->module)
- gfc_error ("Name '%s' at %C is an ambiguous reference to '%s' "
- "from module '%s'", name, st->n.sym->name, st->n.sym->module);
+ gfc_error ("Name %qs at %C is an ambiguous reference to %qs "
+ "from module %qs", name, st->n.sym->name, st->n.sym->module);
else
- gfc_error ("Name '%s' at %C is an ambiguous reference to '%s' "
+ gfc_error ("Name %qs at %C is an ambiguous reference to %qs "
"from current program unit", name, st->n.sym->name);
}
/* If we're in a SELECT TYPE block, check if the variable 'st' matches any
@@ -2850,11 +2850,11 @@ gfc_get_sym_tree (const char *name, gfc_
&& !(allow_subroutine && p->attr.subroutine)
&& !(ns->proc_name && ns->proc_name->attr.if_source == IFSRC_IFBODY
&& (ns->has_import_set || p->attr.imported)))
{
/* Symbol is from another namespace. */
- gfc_error ("Symbol '%s' at %C has already been host associated",
+ gfc_error ("Symbol %qs at %C has already been host associated",
name);
return 2;
}
p->mark = 1;
@@ -3893,32 +3893,32 @@ verify_bind_c_derived_type (gfc_symbol *
{
/* The components cannot be pointers (fortran sense).
J3/04-007, Section 15.2.3, C1505. */
if (curr_comp->attr.pointer != 0)
{
- gfc_error ("Component '%s' at %L cannot have the "
+ gfc_error_1 ("Component '%s' at %L cannot have the "
"POINTER attribute because it is a member "
"of the BIND(C) derived type '%s' at %L",
curr_comp->name, &(curr_comp->loc),
derived_sym->name, &(derived_sym->declared_at));
retval = false;
}
if (curr_comp->attr.proc_pointer != 0)
{
- gfc_error ("Procedure pointer component '%s' at %L cannot be a member"
+ 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,
&curr_comp->loc, derived_sym->name,
&derived_sym->declared_at);
retval = false;
}
/* The components cannot be allocatable.
J3/04-007, Section 15.2.3, C1505. */
if (curr_comp->attr.allocatable != 0)
{
- gfc_error ("Component '%s' at %L cannot have the "
+ gfc_error_1 ("Component '%s' at %L cannot have the "
"ALLOCATABLE attribute because it is a member "
"of the BIND(C) derived type '%s' at %L",
curr_comp->name, &(curr_comp->loc),
derived_sym->name, &(derived_sym->declared_at));
retval = false;
Index: gcc/fortran/class.c
===================================================================
--- gcc/fortran/class.c (revision 218457)
+++ gcc/fortran/class.c (working copy)
@@ -664,11 +664,11 @@ gfc_build_class_symbol (gfc_typespec *ts
{
/* Since the extension field is 8 bit wide, we can only have
up to 255 extension levels. */
if (ts->u.derived->attr.extension == 255)
{
- gfc_error ("Maximum extension level reached with type '%s' at %L",
+ gfc_error ("Maximum extension level reached with type %qs at %L",
ts->u.derived->name, &ts->u.derived->declared_at);
return false;
}
fclass->attr.extension = ts->u.derived->attr.extension + 1;
@@ -2684,11 +2684,11 @@ find_typebound_proc_uop (gfc_symbol* der
if (!noaccess && derived->attr.use_assoc
&& res->n.tb->access == ACCESS_PRIVATE)
{
if (where)
- gfc_error ("'%s' of '%s' is PRIVATE at %L",
+ gfc_error ("%qs of %qs is PRIVATE at %L",
name, derived->name, where);
if (t)
*t = false;
}
@@ -2758,11 +2758,11 @@ gfc_find_typebound_intrinsic_op (gfc_sym
if (!noaccess && derived->attr.use_assoc
&& res->access == ACCESS_PRIVATE)
{
if (where)
- gfc_error ("'%s' of '%s' is PRIVATE at %L",
+ gfc_error ("%qs of %qs is PRIVATE at %L",
gfc_op2string (op), derived->name, where);
if (t)
*t = false;
}
Index: gcc/fortran/decl.c
===================================================================
--- gcc/fortran/decl.c (revision 218457)
+++ gcc/fortran/decl.c (working copy)
@@ -259,11 +259,11 @@ var_element (gfc_data_variable *new_var)
return MATCH_ERROR;
if (!sym->attr.function && gfc_current_ns->parent
&& gfc_current_ns->parent == sym->ns)
{
- gfc_error ("Host associated variable '%s' may not be in the DATA "
+ gfc_error ("Host associated variable %qs may not be in the DATA "
"statement at %C", sym->name);
return MATCH_ERROR;
}
if (gfc_current_state () != COMP_BLOCK_DATA
@@ -377,11 +377,11 @@ match_data_constant (gfc_expr **result)
if (sym == NULL
|| (sym->attr.flavor != FL_PARAMETER
&& (!dt_sym || dt_sym->attr.flavor != FL_DERIVED)))
{
- gfc_error ("Symbol '%s' must be a PARAMETER in DATA statement at %C",
+ gfc_error ("Symbol %qs must be a PARAMETER in DATA statement at %C",
name);
return MATCH_ERROR;
}
else if (dt_sym && dt_sym->attr.flavor == FL_DERIVED)
return gfc_match_structure_constructor (dt_sym, result);
@@ -1015,19 +1015,19 @@ gfc_verify_c_interop_param (gfc_symbol *
if (is_c_interop != 1)
{
/* Make personalized messages to give better feedback. */
if (sym->ts.type == BT_DERIVED)
- gfc_error ("Variable '%s' at %L is a dummy argument to the "
- "BIND(C) procedure '%s' but is not C interoperable "
- "because derived type '%s' is not C interoperable",
+ gfc_error ("Variable %qs at %L is a dummy argument to the "
+ "BIND(C) procedure %qs but is not C interoperable "
+ "because derived type %qs is not C interoperable",
sym->name, &(sym->declared_at),
sym->ns->proc_name->name,
sym->ts.u.derived->name);
else if (sym->ts.type == BT_CLASS)
- gfc_error ("Variable '%s' at %L is a dummy argument to the "
- "BIND(C) procedure '%s' but is not C interoperable "
+ gfc_error ("Variable %qs at %L is a dummy argument to the "
+ "BIND(C) procedure %qs but is not C interoperable "
"because it is polymorphic",
sym->name, &(sym->declared_at),
sym->ns->proc_name->name);
else if (warn_c_binding_type)
gfc_warning (OPT_Wc_binding_type,
@@ -1044,13 +1044,13 @@ gfc_verify_c_interop_param (gfc_symbol *
{
gfc_charlen *cl = sym->ts.u.cl;
if (!cl || !cl->length || cl->length->expr_type != EXPR_CONSTANT
|| mpz_cmp_si (cl->length->value.integer, 1) != 0)
{
- gfc_error ("Character argument '%s' at %L "
+ gfc_error ("Character argument %qs at %L "
"must be length 1 because "
- "procedure '%s' is BIND(C)",
+ "procedure %qs is BIND(C)",
sym->name, &sym->declared_at,
sym->ns->proc_name->name);
retval = false;
}
}
@@ -1074,21 +1074,21 @@ gfc_verify_c_interop_param (gfc_symbol *
sym->ns->proc_name->name))
retval = false;
if ((sym->attr.allocatable || sym->attr.pointer) && !sym->as)
{
- gfc_error ("Scalar variable '%s' at %L with POINTER or "
- "ALLOCATABLE in procedure '%s' with BIND(C) is not yet"
+ gfc_error ("Scalar variable %qs at %L with POINTER or "
+ "ALLOCATABLE in procedure %qs with BIND(C) is not yet"
" supported", sym->name, &(sym->declared_at),
sym->ns->proc_name->name);
retval = false;
}
if (sym->attr.optional == 1 && sym->attr.value)
{
- gfc_error ("Variable '%s' at %L cannot have both the OPTIONAL "
- "and the VALUE attribute because procedure '%s' "
+ gfc_error ("Variable %qs at %L cannot have both the OPTIONAL "
+ "and the VALUE attribute because procedure %qs "
"is BIND(C)", sym->name, &(sym->declared_at),
sym->ns->proc_name->name);
retval = false;
}
else if (sym->attr.optional == 1
@@ -1321,11 +1321,11 @@ add_init_expr_to_sym (const char *name,
then an initialization expression is not allowed. */
if (attr.flavor == FL_PARAMETER
&& sym->value != NULL
&& *initp != NULL)
{
- gfc_error ("Initializer not allowed for PARAMETER '%s' at %C",
+ gfc_error ("Initializer not allowed for PARAMETER %qs at %C",
sym->name);
return false;
}
if (init == NULL)
@@ -1341,11 +1341,11 @@ add_init_expr_to_sym (const char *name,
{
/* If a variable appears in a DATA block, it cannot have an
initializer. */
if (sym->attr.data)
{
- gfc_error ("Variable '%s' at %C with an initializer already "
+ gfc_error ("Variable %qs at %C with an initializer already "
"appears in a DATA statement", sym->name);
return false;
}
/* Check if the assignment can happen. This has to be put off
@@ -1781,11 +1781,11 @@ check_function_name (char *name)
gfc_symbol *block = gfc_current_block ();
if (block && block->result && block->result != block
&& strcmp (block->result->name, "ppr@") != 0
&& strcmp (block->name, name) == 0)
{
- gfc_error ("Function name '%s' not allowed at %C", name);
+ gfc_error ("Function name %qs not allowed at %C", name);
return false;
}
}
return true;
@@ -1848,11 +1848,11 @@ variable_decl (int elem)
if (as)
{
if (as->type == AS_IMPLIED_SHAPE && current_attr.flavor != FL_PARAMETER)
{
m = MATCH_ERROR;
- gfc_error ("Non-PARAMETER symbol '%s' at %L can't be implied-shape",
+ gfc_error ("Non-PARAMETER symbol %qs at %L can't be implied-shape",
name, &var_locus);
goto cleanup;
}
if (as->type == AS_ASSUMED_SIZE && as->rank == 1
@@ -2817,11 +2817,11 @@ gfc_match_decl_type_spec (gfc_typespec *
if (ts->kind != -1)
{
gfc_get_ha_symbol (name, &sym);
if (sym->generic && gfc_find_symbol (dt_name, NULL, 0, &dt_sym))
{
- gfc_error ("Type name '%s' at %C is ambiguous", name);
+ gfc_error ("Type name %qs at %C is ambiguous", name);
return MATCH_ERROR;
}
if (sym->generic && !dt_sym)
dt_sym = gfc_find_dt_in_generic (sym);
}
@@ -2830,11 +2830,11 @@ gfc_match_decl_type_spec (gfc_typespec *
int iface = gfc_state_stack->previous->state != COMP_INTERFACE
|| gfc_current_ns->has_import_set;
gfc_find_symbol (name, NULL, iface, &sym);
if (sym && sym->generic && gfc_find_symbol (dt_name, NULL, 1, &dt_sym))
{
- gfc_error ("Type name '%s' at %C is ambiguous", name);
+ gfc_error ("Type name %qs at %C is ambiguous", name);
return MATCH_ERROR;
}
if (sym && sym->generic && !dt_sym)
dt_sym = gfc_find_dt_in_generic (sym);
@@ -2845,13 +2845,13 @@ gfc_match_decl_type_spec (gfc_typespec *
if ((sym->attr.flavor != FL_UNKNOWN
&& !(sym->attr.flavor == FL_PROCEDURE && sym->attr.generic))
|| sym->attr.subroutine)
{
- gfc_error ("Type name '%s' at %C conflicts with previously declared "
- "entity at %L, which has the same name", name,
- &sym->declared_at);
+ gfc_error_1 ("Type name '%s' at %C conflicts with previously declared "
+ "entity at %L, which has the same name", name,
+ &sym->declared_at);
return MATCH_ERROR;
}
gfc_set_sym_referenced (sym);
if (!sym->attr.generic
@@ -3272,25 +3272,25 @@ gfc_match_import (void)
{
case MATCH_YES:
if (gfc_current_ns->parent != NULL
&& gfc_find_symbol (name, gfc_current_ns->parent, 1, &sym))
{
- gfc_error ("Type name '%s' at %C is ambiguous", name);
+ gfc_error ("Type name %qs at %C is ambiguous", name);
return MATCH_ERROR;
}
else if (!sym && gfc_current_ns->proc_name->ns->parent != NULL
&& gfc_find_symbol (name,
gfc_current_ns->proc_name->ns->parent,
1, &sym))
{
- gfc_error ("Type name '%s' at %C is ambiguous", name);
+ gfc_error ("Type name %qs at %C is ambiguous", name);
return MATCH_ERROR;
}
if (sym == NULL)
{
- gfc_error ("Cannot IMPORT '%s' from host scoping unit "
+ gfc_error ("Cannot IMPORT %qs from host scoping unit "
"at %C - does not exist.", name);
return MATCH_ERROR;
}
if (gfc_find_symtree (gfc_current_ns->sym_root, name))
@@ -4062,27 +4062,27 @@ verify_bind_c_sym (gfc_symbol *tmp_sym,
&(tmp_sym->declared_at), com_block->name);
}
else
{
if (tmp_sym->ts.type == BT_DERIVED || ts->type == BT_DERIVED)
- gfc_error ("Type declaration '%s' at %L is not C "
+ gfc_error ("Type declaration %qs at %L is not C "
"interoperable but it is BIND(C)",
tmp_sym->name, &(tmp_sym->declared_at));
else if (warn_c_binding_type)
gfc_warning (OPT_Wc_binding_type, "Variable %qs at %L "
"may not be a C interoperable "
- "kind but it is bind(c)",
+ "kind but it is BIND(C)",
tmp_sym->name, &(tmp_sym->declared_at));
}
}
/* Variables declared w/in a common block can't be bind(c)
since there's no way for C to see these variables, so there's
semantically no reason for the attribute. */
if (is_in_common == 1 && tmp_sym->attr.is_bind_c == 1)
{
- gfc_error ("Variable '%s' in common block '%s' at "
+ gfc_error ("Variable %qs in common block %qs at "
"%L cannot be declared with BIND(C) "
"since it is not a global",
tmp_sym->name, com_block->name,
&(tmp_sym->declared_at));
retval = false;
@@ -4092,19 +4092,19 @@ verify_bind_c_sym (gfc_symbol *tmp_sym,
or allocatable attributes. */
if (tmp_sym->attr.is_bind_c == 1)
{
if (tmp_sym->attr.pointer == 1)
{
- gfc_error ("Variable '%s' at %L cannot have both the "
+ gfc_error ("Variable %qs at %L cannot have both the "
"POINTER and BIND(C) attributes",
tmp_sym->name, &(tmp_sym->declared_at));
retval = false;
}
if (tmp_sym->attr.allocatable == 1)
{
- gfc_error ("Variable '%s' at %L cannot have both the "
+ gfc_error ("Variable %qs at %L cannot have both the "
"ALLOCATABLE and BIND(C) attributes",
tmp_sym->name, &(tmp_sym->declared_at));
retval = false;
}
@@ -4112,19 +4112,19 @@ verify_bind_c_sym (gfc_symbol *tmp_sym,
/* If it is a BIND(C) function, make sure the return value is a
scalar value. The previous tests in this function made sure
the type is interoperable. */
if (bind_c_function && tmp_sym->as != NULL)
- gfc_error ("Return type of BIND(C) function '%s' at %L cannot "
+ gfc_error ("Return type of BIND(C) function %qs at %L cannot "
"be an array", tmp_sym->name, &(tmp_sym->declared_at));
/* BIND(C) functions can not return a character string. */
if (bind_c_function && tmp_sym->ts.type == BT_CHARACTER)
if (tmp_sym->ts.u.cl == NULL || tmp_sym->ts.u.cl->length == NULL
|| tmp_sym->ts.u.cl->length->expr_type != EXPR_CONSTANT
|| mpz_cmp_si (tmp_sym->ts.u.cl->length->value.integer, 1) != 0)
- gfc_error ("Return type of BIND(C) function '%s' at %L cannot "
+ gfc_error ("Return type of BIND(C) function %qs at %L cannot "
"be a character string", tmp_sym->name,
&(tmp_sym->declared_at));
}
/* See if the symbol has been marked as private. If it has, make sure
@@ -4595,11 +4595,11 @@ gfc_match_formal_arglist (gfc_symbol *pr
so check for it explicitly. After the statement is accepted,
the name is checked for especially in gfc_get_symbol(). */
if (gfc_new_block != NULL && sym != NULL
&& strcmp (sym->name, gfc_new_block->name) == 0)
{
- gfc_error ("Name '%s' at %C is the name of the procedure",
+ gfc_error ("Name %qs at %C is the name of the procedure",
sym->name);
m = MATCH_ERROR;
goto cleanup;
}
@@ -4624,11 +4624,11 @@ ok:
continue;
for (q = p->next; q; q = q->next)
if (p->sym == q->sym)
{
- gfc_error ("Duplicate symbol '%s' in formal argument list "
+ gfc_error ("Duplicate symbol %qs in formal argument list "
"at %C", p->sym->name);
m = MATCH_ERROR;
goto cleanup;
}
@@ -4999,11 +4999,11 @@ match_procedure_decl (void)
/* Set interface. */
if (proc_if != NULL)
{
if (sym->ts.type != BT_UNKNOWN)
{
- gfc_error ("Procedure '%s' at %L already has basic type of %s",
+ gfc_error ("Procedure %qs at %L already has basic type of %s",
sym->name, &gfc_current_locus,
gfc_basic_typename (sym->ts.type));
return MATCH_ERROR;
}
sym->ts.interface = proc_if;
@@ -6275,11 +6275,11 @@ gfc_match_end (gfc_statement *st)
return MATCH_YES;
if (!block_name)
return MATCH_YES;
- gfc_error ("Expected block name of '%s' in %s statement at %L",
+ gfc_error ("Expected block name of %qs in %s statement at %L",
block_name, gfc_ascii_statement (*st), &old_loc);
return MATCH_ERROR;
}
@@ -6301,19 +6301,19 @@ gfc_match_end (gfc_statement *st)
if (block_name == NULL)
goto syntax;
if (strcmp (name, block_name) != 0 && strcmp (block_name, "ppr@") != 0)
{
- gfc_error ("Expected label '%s' for %s statement at %C", block_name,
+ gfc_error ("Expected label %qs for %s statement at %C", block_name,
gfc_ascii_statement (*st));
goto cleanup;
}
/* Procedure pointer as function result. */
else if (strcmp (block_name, "ppr@") == 0
&& strcmp (name, gfc_current_block ()->ns->proc_name->name) != 0)
{
- gfc_error ("Expected label '%s' for %s statement at %C",
+ gfc_error ("Expected label %qs for %s statement at %C",
gfc_current_block ()->ns->proc_name->name,
gfc_ascii_statement (*st));
goto cleanup;
}
@@ -7313,11 +7313,11 @@ gfc_match_volatile (void)
case MATCH_YES:
/* F2008, C560+C561. VOLATILE for host-/use-associated variable or
for variable in a BLOCK which is defined outside of the BLOCK. */
if (sym->ns != gfc_current_ns && sym->attr.codimension)
{
- gfc_error ("Specifying VOLATILE for coarray variable '%s' at "
+ gfc_error ("Specifying VOLATILE for coarray variable %qs at "
"%C, which is use-/host-associated", sym->name);
return MATCH_ERROR;
}
if (!gfc_add_volatile (&sym->attr, sym->name, &gfc_current_locus))
return MATCH_ERROR;
@@ -7529,31 +7529,31 @@ check_extended_derived_type (char *name)
extended = gfc_find_dt_in_generic (extended);
/* F08:C428. */
if (!extended)
{
- gfc_error ("Symbol '%s' at %C has not been previously defined", name);
+ gfc_error ("Symbol %qs at %C has not been previously defined", name);
return NULL;
}
if (extended->attr.flavor != FL_DERIVED)
{
- gfc_error ("'%s' in EXTENDS expression at %C is not a "
+ gfc_error ("%qs in EXTENDS expression at %C is not a "
"derived type", name);
return NULL;
}
if (extended->attr.is_bind_c)
{
- gfc_error ("'%s' cannot be extended at %C because it "
+ gfc_error ("%qs cannot be extended at %C because it "
"is BIND(C)", extended->name);
return NULL;
}
if (extended->attr.sequence)
{
- gfc_error ("'%s' cannot be extended at %C because it "
+ gfc_error ("%qs cannot be extended at %C because it "
"is a SEQUENCE type", extended->name);
return NULL;
}
return extended;
@@ -7680,21 +7680,21 @@ gfc_match_derived_decl (void)
return m;
/* Make sure the name is not the name of an intrinsic type. */
if (gfc_is_intrinsic_typename (name))
{
- gfc_error ("Type name '%s' at %C cannot be the same as an intrinsic "
+ gfc_error ("Type name %qs at %C cannot be the same as an intrinsic "
"type", name);
return MATCH_ERROR;
}
if (gfc_get_symbol (name, NULL, &gensym))
return MATCH_ERROR;
if (!gensym->attr.generic && gensym->ts.type != BT_UNKNOWN)
{
- gfc_error ("Derived type name '%s' at %C already has a basic type "
+ gfc_error ("Derived type name %qs at %C already has a basic type "
"of %s", gensym->name, gfc_typename (&gensym->ts));
return MATCH_ERROR;
}
if (!gensym->attr.generic
@@ -7707,11 +7707,11 @@ gfc_match_derived_decl (void)
sym = gfc_find_dt_in_generic (gensym);
if (sym && (sym->components != NULL || sym->attr.zero_comp))
{
- gfc_error ("Derived type definition of '%s' at %C has already been "
+ gfc_error ("Derived type definition of %qs at %C has already been "
"defined", sym->name);
return MATCH_ERROR;
}
if (!sym)
@@ -7778,11 +7778,11 @@ gfc_match_derived_decl (void)
/* Set extension level. */
if (extended->attr.extension == 255)
{
/* Since the extension field is 8 bit wide, we can only have
up to 255 extension levels. */
- gfc_error ("Maximum extension level reached with type '%s' at %L",
+ gfc_error ("Maximum extension level reached with type %qs at %L",
extended->name, &extended->declared_at);
return MATCH_ERROR;
}
sym->attr.extension = extended->attr.extension + 1;
@@ -8373,23 +8373,23 @@ match_procedure_in_type (void)
gcc_assert (ns);
/* If the binding is DEFERRED, check that the containing type is ABSTRACT. */
if (tb.deferred && !block->attr.abstract)
{
- gfc_error ("Type '%s' containing DEFERRED binding at %C "
+ gfc_error ("Type %qs containing DEFERRED binding at %C "
"is not ABSTRACT", block->name);
return MATCH_ERROR;
}
/* See if we already have a binding with this name in the symtree which
would be an error. If a GENERIC already targeted this binding, it may
be already there but then typebound is still NULL. */
stree = gfc_find_symtree (ns->tb_sym_root, name);
if (stree && stree->n.tb)
{
- gfc_error ("There is already a procedure with binding name '%s' for "
- "the derived type '%s' at %C", name, block->name);
+ gfc_error ("There is already a procedure with binding name %qs for "
+ "the derived type %qs at %C", name, block->name);
return MATCH_ERROR;
}
/* Insert it and set attributes. */
@@ -8534,19 +8534,19 @@ gfc_match_generic (void)
{
if (!tb->is_generic)
{
gcc_assert (op_type == INTERFACE_GENERIC);
gfc_error ("There's already a non-generic procedure with binding name"
- " '%s' for the derived type '%s' at %C",
+ " %qs for the derived type %qs at %C",
bind_name, block->name);
goto error;
}
if (tb->access != tbattr.access)
{
gfc_error ("Binding at %C must have the same access as already"
- " defined binding '%s'", bind_name);
+ " defined binding %qs", bind_name);
goto error;
}
}
else
{
@@ -8600,12 +8600,12 @@ gfc_match_generic (void)
/* See if this is a duplicate specification. */
for (target = tb->u.generic; target; target = target->next)
if (target_st == target->specific_st)
{
- gfc_error ("'%s' already defined as specific binding for the"
- " generic '%s' at %C", name, bind_name);
+ gfc_error ("%qs already defined as specific binding for the"
+ " generic %qs at %C", name, bind_name);
goto error;
}
target = gfc_get_tbp_generic ();
target->specific_st = target_st;
@@ -8709,11 +8709,11 @@ gfc_match_final_decl (void)
return MATCH_ERROR;
}
if (gfc_get_symbol (name, module_ns, &sym))
{
- gfc_error ("Unknown procedure name \"%s\" at %C", name);
+ gfc_error ("Unknown procedure name %qs at %C", name);
return MATCH_ERROR;
}
/* Mark the symbol as module procedure. */
if (sym->attr.proc != PROC_MODULE
@@ -8722,11 +8722,11 @@ gfc_match_final_decl (void)
/* Check if we already have this symbol in the list, this is an error. */
for (f = block->f2k_derived->finalizers; f; f = f->next)
if (f->proc_sym == sym)
{
- gfc_error ("'%s' at %C is already defined as FINAL procedure!",
+ gfc_error ("%qs at %C is already defined as FINAL procedure!",
name);
return MATCH_ERROR;
}
/* Add this symbol to the list of finalizers. */
Index: gcc/fortran/trans-common.c
===================================================================
--- gcc/fortran/trans-common.c (revision 218457)
+++ gcc/fortran/trans-common.c (working copy)
@@ -906,11 +906,11 @@ confirm_condition (segment_info *s1, gfc
offset1 = calculate_offset (eq1->expr);
offset2 = calculate_offset (eq2->expr);
if (s1->offset + offset1 != s2->offset + offset2)
- gfc_error ("Inconsistent equivalence rules involving '%s' at %L and "
+ gfc_error_1 ("Inconsistent equivalence rules involving '%s' at %L and "
"'%s' at %L", s1->sym->name, &s1->sym->declared_at,
s2->sym->name, &s2->sym->declared_at);
}
Index: gcc/fortran/array.c
===================================================================
--- gcc/fortran/array.c (revision 218457)
+++ gcc/fortran/array.c (working copy)
@@ -98,11 +98,11 @@ match_subscript (gfc_array_ref *ar, int
if (gfc_match_char (':') == MATCH_NO)
goto matched;
if (star)
{
- gfc_error ("Unexpected '*' in coarray subscript at %C");
+ gfc_error ("Unexpected %<*%> in coarray subscript at %C");
return MATCH_ERROR;
}
/* Get an optional end element. Because we've seen the colon, we
definitely have a range along this dimension. */
@@ -244,19 +244,19 @@ coarray:
}
if (gfc_match_char (',') != MATCH_YES)
{
if (gfc_match_char ('*') == MATCH_YES)
- gfc_error ("Unexpected '*' for codimension %d of %d at %C",
+ gfc_error ("Unexpected %<*%> for codimension %d of %d at %C",
ar->codimen + 1, corank);
else
gfc_error ("Invalid form of coarray reference at %C");
return MATCH_ERROR;
}
else if (ar->dimen_type[ar->codimen + ar->dimen] == DIMEN_STAR)
{
- gfc_error ("Unexpected '*' for codimension %d of %d at %C",
+ gfc_error ("Unexpected %<*%> for codimension %d of %d at %C",
ar->codimen + 1, corank);
return MATCH_ERROR;
}
if (ar->codimen >= corank)
@@ -311,11 +311,11 @@ resolve_array_bound (gfc_expr *e, int ch
return false;
if (check_constant && !gfc_is_constant_expr (e))
{
if (e->expr_type == EXPR_VARIABLE)
- gfc_error ("Variable '%s' at %L in this context must be constant",
+ gfc_error ("Variable %qs at %L in this context must be constant",
e->symtree->n.sym->name, &e->where);
else
gfc_error ("Expression at %L in this context must be constant",
&e->where);
return false;
@@ -750,11 +750,11 @@ gfc_set_array_spec (gfc_symbol *sym, gfc
}
if ((sym->as->type == AS_ASSUMED_RANK && as->corank)
|| (as->type == AS_ASSUMED_RANK && sym->as->corank))
{
- gfc_error ("The assumed-rank array '%s' at %L shall not have a "
+ gfc_error ("The assumed-rank array %qs at %L shall not have a "
"codimension", sym->name, error_loc);
return false;
}
if (as->corank)
@@ -910,11 +910,11 @@ check_duplicate_iterator (gfc_constructo
if (c->iterator == NULL)
continue;
if (c->iterator->var->symtree->n.sym == master)
{
- gfc_error ("DO-iterator '%s' at %L is inside iterator of the "
+ gfc_error ("DO-iterator %qs at %L is inside iterator of the "
"same name", master->name, &c->where);
return 1;
}
}
@@ -1660,11 +1660,11 @@ gfc_expand_constructor (gfc_expr *e, boo
gfc_free_expr (f);
if (fatal)
{
gfc_error ("The number of elements in the array constructor "
"at %L requires an increase of the allowed %d "
- "upper limit. See -fmax-array-constructor "
+ "upper limit. See %<-fmax-array-constructor%> "
"option", &e->where,
gfc_option.flag_max_array_constructor);
return false;
}
return true;
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h (revision 218457)
+++ gcc/fortran/gfortran.h (working copy)
@@ -2680,10 +2680,11 @@ bool gfc_warning_now (const char *, ...)
bool gfc_warning_now (int opt, const char *, ...) ATTRIBUTE_GCC_GFC(2,3);
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);
@@ -2696,13 +2697,14 @@ bool gfc_notify_std (int, const char *,
/* A general purpose syntax error. */
#define gfc_syntax_error(ST) \
gfc_error ("Syntax error in %s statement at %C", gfc_ascii_statement (ST));
-void gfc_push_error (gfc_error_buf *);
-void gfc_pop_error (gfc_error_buf *);
-void gfc_free_error (gfc_error_buf *);
+#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 *);
void gfc_get_errors (int *, int *);
void gfc_errors_to_warnings (bool);
/* arith.c */
Index: gcc/fortran/error.c
===================================================================
--- gcc/fortran/error.c (revision 218457)
+++ gcc/fortran/error.c (working copy)
@@ -40,27 +40,34 @@ along with GCC; see the file COPYING3.
#include "diagnostic.h"
#include "diagnostic-color.h"
#include "tree-diagnostic.h" /* tree_diagnostics_defaults */
+#include <new> /* For placement-new */
+
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;
/* True if the error/warnings should be buffered. */
static bool buffered_p;
-
/* These are always buffered buffers (.flush_p == false) to be used by
the pretty-printer. */
-static output_buffer pp_warning_buffer;
+static output_buffer *pp_error_buffer, *pp_warning_buffer;
static int warningcount_buffered, werrorcount_buffered;
-#include <new> /* For placement-new */
+/* Return true if there output_buffer is empty. */
+
+static bool
+gfc_output_buffer_empty_p (const output_buffer * buf)
+{
+ return output_buffer_last_position_in_text (buf) == NULL;
+}
/* Go one level deeper suppressing errors. */
void
gfc_push_suppress_errors (void)
@@ -129,11 +136,10 @@ gfc_error_init_1 (void)
void
gfc_buffer_error (bool flag)
{
buffered_p = flag;
- pp_warning_buffer.flush_p = !flag;
}
/* Add a single character to the error buffer or output depending on
buffered_p. */
@@ -873,15 +879,15 @@ gfc_warning (int opt, const char *gmsgid
diagnostic_info diagnostic;
bool fatal_errors = global_dc->fatal_errors;
pretty_printer *pp = global_dc->printer;
output_buffer *tmp_buffer = pp->buffer;
- gfc_clear_pp_buffer (&pp_warning_buffer);
+ gfc_clear_pp_buffer (pp_warning_buffer);
if (buffered_p)
{
- pp->buffer = &pp_warning_buffer;
+ pp->buffer = pp_warning_buffer;
global_dc->fatal_errors = false;
/* To prevent -fmax-errors= triggering. */
--werrorcount;
}
@@ -1278,14 +1284,13 @@ gfc_fatal_error (const char *gmsgid, ...
void
gfc_clear_warning (void)
{
warning_buffer.flag = 0;
- gfc_clear_pp_buffer (&pp_warning_buffer);
+ gfc_clear_pp_buffer (pp_warning_buffer);
warningcount_buffered = 0;
werrorcount_buffered = 0;
- pp_warning_buffer.flush_p = false;
}
/* Check to see if any warnings have been saved.
If so, print the warning. */
@@ -1296,33 +1301,36 @@ gfc_warning_check (void)
if (warning_buffer.flag)
{
warnings++;
if (warning_buffer.message != NULL)
fputs (warning_buffer.message, stderr);
- warning_buffer.flag = 0;
+ gfc_clear_warning ();
}
-
/* This is for the new diagnostics machinery. */
- pretty_printer *pp = global_dc->printer;
- output_buffer *tmp_buffer = pp->buffer;
- pp->buffer = &pp_warning_buffer;
- if (pp_last_position_in_text (pp) != NULL)
+ else if (! gfc_output_buffer_empty_p (pp_warning_buffer))
{
+ pretty_printer *pp = global_dc->printer;
+ output_buffer *tmp_buffer = pp->buffer;
+ pp->buffer = pp_warning_buffer;
pp_really_flush (pp);
- pp_warning_buffer.flush_p = true;
warningcount += warningcount_buffered;
werrorcount += werrorcount_buffered;
+ gcc_assert (warningcount_buffered + werrorcount_buffered == 1);
+ diagnostic_action_after_output (global_dc,
+ warningcount_buffered
+ ? DK_WARNING : DK_ERROR);
+ pp->buffer = tmp_buffer;
}
-
- pp->buffer = tmp_buffer;
}
/* 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 (const char *gmsgid, ...)
+gfc_error_1 (const char *gmsgid, ...)
{
va_list argp;
if (warnings_not_errors)
goto warning;
@@ -1366,10 +1374,63 @@ warning:
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. */
+
+void
+gfc_error (const char *gmsgid, ...)
+{
+ va_list argp;
+ va_start (argp, gmsgid);
+
+ if (warnings_not_errors)
+ {
+ gfc_warning (/*opt=*/0, gmsgid, argp);
+ va_end (argp);
+ return;
+ }
+
+ if (suppress_errors)
+ {
+ va_end (argp);
+ return;
+ }
+
+ diagnostic_info diagnostic;
+ bool fatal_errors = global_dc->fatal_errors;
+ pretty_printer *pp = global_dc->printer;
+ output_buffer *tmp_buffer = pp->buffer;
+
+ gfc_clear_pp_buffer (pp_error_buffer);
+
+ if (buffered_p)
+ {
+ pp->buffer = pp_error_buffer;
+ global_dc->fatal_errors = false;
+ /* To prevent -fmax-errors= triggering, we decrease it before
+ report_diagnostic increases it. */
+ --errorcount;
+ }
+
+ diagnostic_set_info (&diagnostic, gmsgid, &argp, UNKNOWN_LOCATION, DK_ERROR);
+ report_diagnostic (&diagnostic);
+
+ if (buffered_p)
+ {
+ pp->buffer = tmp_buffer;
+ global_dc->fatal_errors = fatal_errors;
+ }
+
+ va_end (argp);
+}
+
+
/* 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. */
@@ -1423,19 +1484,21 @@ gfc_internal_error (const char *gmsgid,
void
gfc_clear_error (void)
{
error_buffer.flag = 0;
warnings_not_errors = false;
+ gfc_clear_pp_buffer (pp_error_buffer);
}
/* Tests the state of error_flag. */
bool
gfc_error_flag_test (void)
{
- return error_buffer.flag;
+ return error_buffer.flag
+ || !gfc_output_buffer_empty_p (pp_error_buffer);
}
/* Check to see if any errors have been saved.
If so, print the error. Returns the state of error_flag. */
@@ -1448,57 +1511,96 @@ gfc_error_check (void)
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))
+ {
+ error_raised = true;
+ pretty_printer *pp = global_dc->printer;
+ output_buffer *tmp_buffer = pp->buffer;
+ pp->buffer = pp_error_buffer;
+ pp_really_flush (pp);
+ ++errorcount;
+ gcc_assert (gfc_output_buffer_empty_p (pp_error_buffer));
+ diagnostic_action_after_output (global_dc, DK_ERROR);
+ pp->buffer = tmp_buffer;
+ }
return error_raised;
}
+/* Move the text buffered from FROM to TO, then clear
+ FROM. Independently if there was text in FROM, TO is also
+ cleared. */
+
+static void
+gfc_move_output_buffer_from_to (output_buffer *from, output_buffer *to)
+{
+ gfc_clear_pp_buffer (to);
+ /* We make sure this is always buffered. */
+ to->flush_p = false;
+
+ if (! gfc_output_buffer_empty_p (from))
+ {
+ const char *str = output_buffer_formatted_text (from);
+ output_buffer_append_r (to, str, strlen (str));
+ gfc_clear_pp_buffer (from);
+ }
+}
/* Save the existing error state. */
void
-gfc_push_error (gfc_error_buf *err)
+gfc_push_error (output_buffer *buffer_err, gfc_error_buf *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);
}
/* Restore a previous pushed error state. */
void
-gfc_pop_error (gfc_error_buf *err)
+gfc_pop_error (output_buffer *buffer_err, gfc_error_buf *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);
}
/* Free a pushed error state, but keep the current error state. */
void
-gfc_free_error (gfc_error_buf *err)
+gfc_free_error (output_buffer *buffer_err, gfc_error_buf *err)
{
if (err->flag)
free (err->message);
+
+ gfc_clear_pp_buffer (buffer_err);
}
/* Report the number of warnings and errors that occurred to the caller. */
@@ -1525,11 +1627,14 @@ gfc_diagnostics_init (void)
{
diagnostic_starter (global_dc) = gfc_diagnostic_starter;
diagnostic_finalizer (global_dc) = gfc_diagnostic_finalizer;
diagnostic_format_decoder (global_dc) = gfc_format_decoder;
global_dc->caret_char = '^';
- new (&pp_warning_buffer) output_buffer ();
+ 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->flush_p = false;
}
void
gfc_diagnostics_finish (void)
{
Index: gcc/fortran/data.c
===================================================================
--- gcc/fortran/data.c (revision 218457)
+++ gcc/fortran/data.c (working copy)
@@ -251,13 +251,13 @@ gfc_assign_data_value (gfc_expr *lvalue,
continue;
}
if (init && expr->expr_type != EXPR_ARRAY)
{
- gfc_error ("'%s' at %L already is initialized at %L",
- lvalue->symtree->n.sym->name, &lvalue->where,
- &init->where);
+ gfc_error_1 ("'%s' at %L already is initialized at %L",
+ lvalue->symtree->n.sym->name, &lvalue->where,
+ &init->where);
goto abort;
}
if (init == NULL)
{
Index: gcc/fortran/expr.c
===================================================================
--- gcc/fortran/expr.c (revision 218457)
+++ gcc/fortran/expr.c (working copy)
@@ -2202,13 +2202,13 @@ check_alloc_comp_init (gfc_expr *e)
comp; comp = comp->next, ctor = gfc_constructor_next (ctor))
{
if (comp->attr.allocatable
&& ctor->expr->expr_type != EXPR_NULL)
{
- gfc_error("Invalid initialization expression for ALLOCATABLE "
- "component '%s' in structure constructor at %L",
- comp->name, &ctor->expr->where);
+ gfc_error ("Invalid initialization expression for ALLOCATABLE "
+ "component %qs in structure constructor at %L",
+ comp->name, &ctor->expr->where);
return false;
}
}
return true;
@@ -2313,11 +2313,11 @@ check_inquiry (gfc_expr *e, int not_rest
if (i == 5 && not_restricted
&& ap->expr->symtree->n.sym->ts.type == BT_CHARACTER
&& (ap->expr->symtree->n.sym->ts.u.cl->length == NULL
|| ap->expr->symtree->n.sym->ts.deferred))
{
- gfc_error ("Assumed or deferred character length variable '%s' "
+ gfc_error ("Assumed or deferred character length variable %qs "
" in constant expression at %L",
ap->expr->symtree->n.sym->name,
&ap->expr->where);
return MATCH_ERROR;
}
@@ -2379,12 +2379,12 @@ check_transformational (gfc_expr *e)
if (strcmp (functions[i], name) == 0)
break;
if (functions[i] == NULL)
{
- gfc_error("transformational intrinsic '%s' at %L is not permitted "
- "in an initialization expression", name, &e->where);
+ gfc_error ("transformational intrinsic %qs at %L is not permitted "
+ "in an initialization expression", name, &e->where);
return MATCH_ERROR;
}
return check_init_expr_arguments (e);
}
@@ -2479,11 +2479,11 @@ gfc_check_init_expr (gfc_expr *e)
}
if (!gfc_is_intrinsic (sym, 0, e->where)
|| (m = gfc_intrinsic_func_interface (e, 0)) != MATCH_YES)
{
- gfc_error ("Function '%s' in initialization expression at %L "
+ gfc_error ("Function %qs in initialization expression at %L "
"must be an intrinsic function",
e->symtree->n.sym->name, &e->where);
break;
}
@@ -2491,11 +2491,11 @@ gfc_check_init_expr (gfc_expr *e)
&& (m = check_inquiry (e, 1)) == MATCH_NO
&& (m = check_null (e)) == MATCH_NO
&& (m = check_transformational (e)) == MATCH_NO
&& (m = check_elemental (e)) == MATCH_NO)
{
- gfc_error ("Intrinsic function '%s' at %L is not permitted "
+ gfc_error ("Intrinsic function %qs at %L is not permitted "
"in an initialization expression",
e->symtree->n.sym->name, &e->where);
m = MATCH_ERROR;
}
@@ -2526,12 +2526,12 @@ gfc_check_init_expr (gfc_expr *e)
/* A PARAMETER shall not be used to define itself, i.e.
REAL, PARAMETER :: x = transfer(0, x)
is invalid. */
if (!e->symtree->n.sym->value)
{
- gfc_error("PARAMETER '%s' is used at %L before its definition "
- "is complete", e->symtree->n.sym->name, &e->where);
+ gfc_error ("PARAMETER %qs is used at %L before its definition "
+ "is complete", e->symtree->n.sym->name, &e->where);
t = false;
}
else
t = simplify_parameter_variable (e, 0);
@@ -2546,39 +2546,39 @@ gfc_check_init_expr (gfc_expr *e)
if (e->symtree->n.sym->as)
{
switch (e->symtree->n.sym->as->type)
{
case AS_ASSUMED_SIZE:
- gfc_error ("Assumed size array '%s' at %L is not permitted "
+ gfc_error ("Assumed size array %qs at %L is not permitted "
"in an initialization expression",
e->symtree->n.sym->name, &e->where);
break;
case AS_ASSUMED_SHAPE:
- gfc_error ("Assumed shape array '%s' at %L is not permitted "
+ gfc_error ("Assumed shape array %qs at %L is not permitted "
"in an initialization expression",
e->symtree->n.sym->name, &e->where);
break;
case AS_DEFERRED:
- gfc_error ("Deferred array '%s' at %L is not permitted "
+ gfc_error ("Deferred array %qs at %L is not permitted "
"in an initialization expression",
e->symtree->n.sym->name, &e->where);
break;
case AS_EXPLICIT:
- gfc_error ("Array '%s' at %L is a variable, which does "
+ gfc_error ("Array %qs at %L is a variable, which does "
"not reduce to a constant expression",
e->symtree->n.sym->name, &e->where);
break;
default:
gcc_unreachable();
}
}
else
- gfc_error ("Parameter '%s' at %L has not been declared or is "
+ gfc_error ("Parameter %qs at %L has not been declared or is "
"a variable, which does not reduce to a constant "
"expression", e->symtree->n.sym->name, &e->where);
break;
@@ -2727,32 +2727,32 @@ external_spec_function (gfc_expr *e)
f = e->value.function.esym;
if (f->attr.proc == PROC_ST_FUNCTION)
{
- gfc_error ("Specification function '%s' at %L cannot be a statement "
+ gfc_error ("Specification function %qs at %L cannot be a statement "
"function", f->name, &e->where);
return false;
}
if (f->attr.proc == PROC_INTERNAL)
{
- gfc_error ("Specification function '%s' at %L cannot be an internal "
+ gfc_error ("Specification function %qs at %L cannot be an internal "
"function", f->name, &e->where);
return false;
}
if (!f->attr.pure && !f->attr.elemental)
{
- gfc_error ("Specification function '%s' at %L must be PURE", f->name,
+ gfc_error ("Specification function %qs at %L must be PURE", f->name,
&e->where);
return false;
}
if (f->attr.recursive)
{
- gfc_error ("Specification function '%s' at %L cannot be RECURSIVE",
+ gfc_error ("Specification function %qs at %L cannot be RECURSIVE",
f->name, &e->where);
return false;
}
return restricted_args (e->value.function.actual);
@@ -2882,25 +2882,25 @@ check_restricted (gfc_expr *e)
don't need to jump through hoops to distinguish valid from
invalid cases. */
if (sym->attr.dummy && sym->ns == gfc_current_ns
&& sym->ns->proc_name && sym->ns->proc_name->attr.elemental)
{
- gfc_error ("Dummy argument '%s' not allowed in expression at %L",
+ gfc_error ("Dummy argument %qs not allowed in expression at %L",
sym->name, &e->where);
break;
}
if (sym->attr.optional)
{
- gfc_error ("Dummy argument '%s' at %L cannot be OPTIONAL",
+ gfc_error ("Dummy argument %qs at %L cannot be OPTIONAL",
sym->name, &e->where);
break;
}
if (sym->attr.intent == INTENT_OUT)
{
- gfc_error ("Dummy argument '%s' at %L cannot be INTENT(OUT)",
+ gfc_error ("Dummy argument %qs at %L cannot be INTENT(OUT)",
sym->name, &e->where);
break;
}
/* Check reference chain if any. */
@@ -2927,11 +2927,11 @@ check_restricted (gfc_expr *e)
{
t = true;
break;
}
- gfc_error ("Variable '%s' cannot appear in the expression at %L",
+ gfc_error ("Variable %qs cannot appear in the expression at %L",
sym->name, &e->where);
/* Prevent a repetition of the error. */
e->error = 1;
break;
@@ -2990,11 +2990,11 @@ gfc_specification_expr (gfc_expr *e)
&& !e->value.function.isym
&& !e->value.function.esym
&& !gfc_pure (e->symtree->n.sym)
&& (!comp || !comp->attr.pure))
{
- gfc_error ("Function '%s' at %L must be PURE",
+ gfc_error ("Function %qs at %L must be PURE",
e->symtree->n.sym->name, &e->where);
/* Prevent repeat error messages. */
e->symtree->n.sym->attr.pure = 1;
return false;
}
@@ -3136,11 +3136,11 @@ gfc_check_assign (gfc_expr *lvalue, gfc_
&& sym != gfc_current_ns->parent->proc_name->result)
bad_proc = true;
if (bad_proc)
{
- gfc_error ("'%s' at %L is not a VALUE", sym->name, &lvalue->where);
+ gfc_error ("%qs at %L is not a VALUE", sym->name, &lvalue->where);
return false;
}
}
if (rvalue->rank != 0 && lvalue->rank != rvalue->rank)
@@ -3329,11 +3329,11 @@ gfc_check_pointer_assign (gfc_expr *lval
}
if (lhs_attr.flavor == FL_PROCEDURE && lhs_attr.use_assoc
&& !lhs_attr.proc_pointer)
{
- gfc_error ("'%s' in the pointer assignment at %L cannot be an "
+ gfc_error ("%qs in the pointer assignment at %L cannot be an "
"l-value since it is a procedure",
lvalue->symtree->n.sym->name, &lvalue->where);
return false;
}
@@ -3352,11 +3352,11 @@ gfc_check_pointer_assign (gfc_expr *lval
if (ref->u.ar.type == AR_FULL)
break;
if (ref->u.ar.type != AR_SECTION)
{
- gfc_error ("Expected bounds specification for '%s' at %L",
+ gfc_error ("Expected bounds specification for %qs at %L",
lvalue->symtree->n.sym->name, &lvalue->where);
return false;
}
if (!gfc_notify_std (GFC_STD_F2003, "Bounds specification "
@@ -3459,30 +3459,30 @@ gfc_check_pointer_assign (gfc_expr *lval
gfc_namespace *ns;
for (ns = gfc_current_ns; ns; ns = ns->parent)
if (sym == ns->proc_name)
{
- gfc_error ("Function result '%s' is invalid as proc-target "
+ gfc_error ("Function result %qs is invalid as proc-target "
"in procedure pointer assignment at %L",
sym->name, &rvalue->where);
return false;
}
}
}
if (attr.abstract)
{
- gfc_error ("Abstract interface '%s' is invalid "
+ gfc_error ("Abstract interface %qs is invalid "
"in procedure pointer assignment at %L",
rvalue->symtree->name, &rvalue->where);
return false;
}
/* Check for F08:C729. */
if (attr.flavor == FL_PROCEDURE)
{
if (attr.proc == PROC_ST_FUNCTION)
{
- gfc_error ("Statement function '%s' is invalid "
+ gfc_error ("Statement function %qs is invalid "
"in procedure pointer assignment at %L",
rvalue->symtree->name, &rvalue->where);
return false;
}
if (attr.proc == PROC_INTERNAL &&
@@ -3491,19 +3491,19 @@ gfc_check_pointer_assign (gfc_expr *lval
"at %L", rvalue->symtree->name, &rvalue->where))
return false;
if (attr.intrinsic && gfc_intrinsic_actual_ok (rvalue->symtree->name,
attr.subroutine) == 0)
{
- gfc_error ("Intrinsic '%s' at %L is invalid in procedure pointer "
+ gfc_error ("Intrinsic %qs at %L is invalid in procedure pointer "
"assignment", rvalue->symtree->name, &rvalue->where);
return false;
}
}
/* Check for F08:C730. */
if (attr.elemental && !attr.intrinsic)
{
- gfc_error ("Nonintrinsic elemental procedure '%s' is invalid "
+ gfc_error ("Nonintrinsic elemental procedure %qs is invalid "
"in procedure pointer assignment at %L",
rvalue->symtree->name, &rvalue->where);
return false;
}
@@ -3578,18 +3578,18 @@ gfc_check_pointer_assign (gfc_expr *lval
/* F08:7.2.2.4 (4) */
if (s1->attr.if_source == IFSRC_UNKNOWN
&& gfc_explicit_interface_required (s2, err, sizeof(err)))
{
- gfc_error ("Explicit interface required for '%s' at %L: %s",
+ gfc_error ("Explicit interface required for %qs at %L: %s",
s1->name, &lvalue->where, err);
return false;
}
if (s2->attr.if_source == IFSRC_UNKNOWN
&& gfc_explicit_interface_required (s1, err, sizeof(err)))
{
- gfc_error ("Explicit interface required for '%s' at %L: %s",
+ gfc_error ("Explicit interface required for %qs at %L: %s",
s2->name, &rvalue->where, err);
return false;
}
if (!gfc_compare_interfaces (s1, s2, name, 0, 1,
@@ -3602,11 +3602,11 @@ gfc_check_pointer_assign (gfc_expr *lval
/* Check F2008Cor2, C729. */
if (!s2->attr.intrinsic && s2->attr.if_source == IFSRC_UNKNOWN
&& !s2->attr.external && !s2->attr.subroutine && !s2->attr.function)
{
- gfc_error ("Procedure pointer target '%s' at %L must be either an "
+ gfc_error ("Procedure pointer target %qs at %L must be either an "
"intrinsic, host or use associated, referenced or have "
"the EXTERNAL attribute", s2->name, &rvalue->where);
return false;
}
@@ -4756,20 +4756,20 @@ gfc_check_vardef_context (gfc_expr* e, b
}
if (!pointer && sym->attr.flavor == FL_PARAMETER)
{
if (context)
- gfc_error ("Named constant '%s' in variable definition context (%s)"
+ gfc_error ("Named constant %qs in variable definition context (%s)"
" at %L", sym->name, context, &e->where);
return false;
}
if (!pointer && sym->attr.flavor != FL_VARIABLE
&& !(sym->attr.flavor == FL_PROCEDURE && sym == sym->result)
&& !(sym->attr.flavor == FL_PROCEDURE && sym->attr.proc_pointer))
{
if (context)
- gfc_error ("'%s' in variable definition context (%s) at %L is not"
+ gfc_error ("%qs in variable definition context (%s) at %L is not"
" a variable", sym->name, context, &e->where);
return false;
}
/* Find out whether the expr is a pointer; this also means following
@@ -4818,19 +4818,19 @@ gfc_check_vardef_context (gfc_expr* e, b
if (check_intentin && sym->attr.intent == INTENT_IN)
{
if (pointer && is_pointer)
{
if (context)
- gfc_error ("Dummy argument '%s' with INTENT(IN) in pointer"
+ gfc_error ("Dummy argument %qs with INTENT(IN) in pointer"
" association context (%s) at %L",
sym->name, context, &e->where);
return false;
}
if (!pointer && !is_pointer && !sym->attr.pointer)
{
if (context)
- gfc_error ("Dummy argument '%s' with INTENT(IN) in variable"
+ gfc_error ("Dummy argument %qs with INTENT(IN) in variable"
" definition context (%s) at %L",
sym->name, context, &e->where);
return false;
}
}
@@ -4839,19 +4839,19 @@ gfc_check_vardef_context (gfc_expr* e, b
if (sym->attr.is_protected && sym->attr.use_assoc && check_intentin)
{
if (pointer && is_pointer)
{
if (context)
- gfc_error ("Variable '%s' is PROTECTED and can not appear in a"
+ gfc_error ("Variable %qs is PROTECTED and can not appear in a"
" pointer association context (%s) at %L",
sym->name, context, &e->where);
return false;
}
if (!pointer && !is_pointer)
{
if (context)
- gfc_error ("Variable '%s' is PROTECTED and can not appear in a"
+ gfc_error ("Variable %qs is PROTECTED and can not appear in a"
" variable definition context (%s) at %L",
sym->name, context, &e->where);
return false;
}
}
@@ -4859,11 +4859,11 @@ gfc_check_vardef_context (gfc_expr* e, b
/* Variable not assignable from a PURE procedure but appears in
variable definition context. */
if (!pointer && !own_scope && gfc_pure (NULL) && gfc_impure_variable (sym))
{
if (context)
- gfc_error ("Variable '%s' can not appear in a variable definition"
+ gfc_error ("Variable %qs can not appear in a variable definition"
" context (%s) at %L in PURE procedure",
sym->name, context, &e->where);
return false;
}
@@ -4918,26 +4918,26 @@ gfc_check_vardef_context (gfc_expr* e, b
if (!assoc->variable)
{
if (context)
{
if (assoc->target->expr_type == EXPR_VARIABLE)
- gfc_error ("'%s' at %L associated to vector-indexed target can"
+ gfc_error ("%qs at %L associated to vector-indexed target can"
" not be used in a variable definition context (%s)",
name, &e->where, context);
else
- gfc_error ("'%s' at %L associated to expression can"
+ gfc_error ("%qs at %L associated to expression can"
" not be used in a variable definition context (%s)",
name, &e->where, context);
}
return false;
}
/* Target must be allowed to appear in a variable definition context. */
if (!gfc_check_vardef_context (assoc->target, pointer, false, false, NULL))
{
if (context)
- gfc_error ("Associate-name '%s' can not appear in a variable"
+ gfc_error_1 ("Associate-name '%s' can not appear in a variable"
" definition context (%s) at %L because its target"
" at %L can not, either",
name, context, &e->where,
&assoc->target->where);
return false;
Index: gcc/fortran/scanner.c
===================================================================
--- gcc/fortran/scanner.c (revision 218457)
+++ gcc/fortran/scanner.c (working copy)
@@ -2043,10 +2043,11 @@ load_file (const char *realfilename, con
/* Add line. */
b = XCNEWVAR (gfc_linebuf, gfc_linebuf_header_size
+ (len + 1) * sizeof (gfc_char_t));
+
b->location
= linemap_line_start (line_table, current_file->line++, len);
/* ??? We add the location for the maximum column possible here,
because otherwise if the next call creates a new line-map, it
will not reserve space for any offset. */
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c (revision 218457)
+++ gcc/fortran/resolve.c (working copy)
@@ -467,28 +467,28 @@ resolve_formal_arglist (gfc_symbol *proc
if (sym->attr.pointer
|| (sym->ts.type == BT_CLASS && CLASS_DATA (sym)
&& CLASS_DATA (sym)->attr.class_pointer))
{
- gfc_error ("Argument '%s' of elemental procedure at %L cannot "
+ gfc_error ("Argument %qs of elemental procedure at %L cannot "
"have the POINTER attribute", sym->name,
&sym->declared_at);
continue;
}
if (sym->attr.flavor == FL_PROCEDURE)
{
- gfc_error ("Dummy procedure '%s' not allowed in elemental "
- "procedure '%s' at %L", sym->name, proc->name,
+ gfc_error ("Dummy procedure %qs not allowed in elemental "
+ "procedure %qs at %L", sym->name, proc->name,
&sym->declared_at);
continue;
}
/* Fortran 2008 Corrigendum 1, C1290a. */
if (sym->attr.intent == INTENT_UNKNOWN && !sym->attr.value)
{
- gfc_error ("Argument '%s' of elemental procedure '%s' at %L must "
+ gfc_error ("Argument %qs of elemental procedure %qs at %L must "
"have its INTENT specified or have the VALUE "
"attribute", sym->name, proc->name,
&sym->declared_at);
continue;
}
@@ -497,21 +497,21 @@ resolve_formal_arglist (gfc_symbol *proc
/* Each dummy shall be specified to be scalar. */
if (proc->attr.proc == PROC_ST_FUNCTION)
{
if (sym->as != NULL)
{
- gfc_error ("Argument '%s' of statement function at %L must "
+ gfc_error ("Argument %qs of statement function at %L must "
"be scalar", sym->name, &sym->declared_at);
continue;
}
if (sym->ts.type == BT_CHARACTER)
{
gfc_charlen *cl = sym->ts.u.cl;
if (!cl || !cl->length || cl->length->expr_type != EXPR_CONSTANT)
{
- gfc_error ("Character-valued argument '%s' of statement "
+ gfc_error ("Character-valued argument %qs of statement "
"function at %L must have constant length",
sym->name, &sym->declared_at);
continue;
}
}
@@ -565,14 +565,14 @@ resolve_contained_fntype (gfc_symbol *sy
t = gfc_set_default_type (sym->result, 0, ns);
if (!t && !sym->result->attr.untyped)
{
if (sym->result == sym)
- gfc_error ("Contained function '%s' at %L has no IMPLICIT type",
+ gfc_error ("Contained function %qs at %L has no IMPLICIT type",
sym->name, &sym->declared_at);
else if (!sym->result->attr.proc_pointer)
- gfc_error ("Result '%s' of contained function '%s' at %L has "
+ gfc_error ("Result %qs of contained function %qs at %L has "
"no IMPLICIT type", sym->result->name, sym->name,
&sym->result->declared_at);
sym->result->attr.untyped = 1;
}
}
@@ -592,11 +592,11 @@ resolve_contained_fntype (gfc_symbol *sy
accordingly. */
bool module_proc;
gcc_assert (ns->parent && ns->parent->proc_name);
module_proc = (ns->parent->proc_name->attr.flavor == FL_MODULE);
- gfc_error ("Character-valued %s '%s' at %L must not be"
+ gfc_error ("Character-valued %s %qs at %L must not be"
" assumed length",
module_proc ? _("module procedure")
: _("internal function"),
sym->name, &sym->declared_at);
}
@@ -982,11 +982,11 @@ resolve_common_blocks (gfc_symtree *comm
|| strcmp (common_root->n.common->binding_label,
gsym->binding_label) != 0))
|| (!common_root->n.common->binding_label
&& gsym->binding_label)))
{
- gfc_error ("In Fortran 2003 COMMON '%s' block at %L is a global "
+ gfc_error_1 ("In Fortran 2003 COMMON '%s' 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,
&gsym->where,
common_root->n.common->binding_label
@@ -996,19 +996,19 @@ resolve_common_blocks (gfc_symtree *comm
}
if (gsym && gsym->type != GSYM_COMMON
&& !common_root->n.common->binding_label)
{
- gfc_error ("COMMON block '%s' at %L uses the same global identifier "
+ gfc_error_1 ("COMMON block '%s' at %L uses the same global identifier "
"as entity at %L",
common_root->n.common->name, &common_root->n.common->where,
&gsym->where);
return;
}
if (gsym && gsym->type != GSYM_COMMON)
{
- gfc_error ("Fortran 2008: COMMON block '%s' with binding label at "
+ gfc_error_1 ("Fortran 2008: COMMON block '%s' 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);
return;
}
@@ -1026,11 +1026,11 @@ resolve_common_blocks (gfc_symtree *comm
{
gsym = gfc_find_gsymbol (gfc_gsym_root,
common_root->n.common->binding_label);
if (gsym && gsym->type != GSYM_COMMON)
{
- gfc_error ("COMMON block at %L with binding label %s uses the same "
+ gfc_error_1 ("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);
return;
}
@@ -1047,19 +1047,19 @@ resolve_common_blocks (gfc_symtree *comm
gfc_find_symbol (common_root->name, gfc_current_ns, 0, &sym);
if (sym == NULL)
return;
if (sym->attr.flavor == FL_PARAMETER)
- gfc_error ("COMMON block '%s' at %L is used as PARAMETER at %L",
+ gfc_error_1 ("COMMON block '%s' at %L is used as PARAMETER at %L",
sym->name, &common_root->n.common->where, &sym->declared_at);
if (sym->attr.external)
- gfc_error ("COMMON block '%s' at %L can not have the EXTERNAL attribute",
+ gfc_error ("COMMON block %qs at %L can not have the EXTERNAL attribute",
sym->name, &common_root->n.common->where);
if (sym->attr.intrinsic)
- gfc_error ("COMMON block '%s' at %L is also an intrinsic procedure",
+ gfc_error ("COMMON block %qs at %L is also an intrinsic procedure",
sym->name, &common_root->n.common->where);
else if (sym->attr.result
|| gfc_is_function_return_value (sym, gfc_current_ns))
gfc_notify_std (GFC_STD_F2003, "COMMON block '%s' at %L "
"that is also a function result", sym->name,
@@ -1169,11 +1169,11 @@ resolve_structure_cons (gfc_expr *expr,
cons->expr->ts = comp->ts;
}
else if (comp->attr.pointer && cons->expr->ts.type != BT_UNKNOWN)
{
gfc_error ("The element in the structure constructor at %L, "
- "for pointer component '%s', is %s but should be %s",
+ "for pointer component %qs, is %s but should be %s",
&cons->expr->where, comp->name,
gfc_basic_typename (cons->expr->ts.type),
gfc_basic_typename (comp->ts.type));
t = false;
}
@@ -1254,11 +1254,11 @@ resolve_structure_cons (gfc_expr *expr,
&& (CLASS_DATA (comp)->attr.class_pointer
|| CLASS_DATA (comp)->attr.allocatable))))
{
t = false;
gfc_error ("The NULL in the structure constructor at %L is "
- "being applied to component '%s', which is neither "
+ "being applied to component %qs, which is neither "
"a POINTER nor ALLOCATABLE", &cons->expr->where,
comp->name);
}
if (comp->attr.proc_pointer && comp->ts.interface)
@@ -1288,11 +1288,11 @@ resolve_structure_cons (gfc_expr *expr,
if (s2 && !gfc_compare_interfaces (comp->ts.interface, s2, name, 0, 1,
err, sizeof (err), NULL, NULL))
{
gfc_error ("Interface mismatch for procedure-pointer component "
- "'%s' in structure constructor at %L: %s",
+ "%qs in structure constructor at %L: %s",
comp->name, &cons->expr->where, err);
return false;
}
}
@@ -1304,11 +1304,11 @@ resolve_structure_cons (gfc_expr *expr,
if (!a.pointer && !a.target)
{
t = false;
gfc_error ("The element in the structure constructor at %L, "
- "for pointer component '%s' should be a POINTER or "
+ "for pointer component %qs should be a POINTER or "
"a TARGET", &cons->expr->where, comp->name);
}
if (init)
{
@@ -1333,11 +1333,11 @@ resolve_structure_cons (gfc_expr *expr,
|| gfc_is_coindexed (cons->expr));
if (impure && gfc_pure (NULL))
{
t = false;
gfc_error ("Invalid expression in the structure constructor for "
- "pointer component '%s' at %L in PURE procedure",
+ "pointer component %qs at %L in PURE procedure",
comp->name, &cons->expr->where);
}
if (impure)
gfc_unset_implicit_pure (NULL);
@@ -1459,11 +1459,11 @@ check_assumed_size_reference (gfc_symbol
&& (e->ref->u.ar.as->type == AS_ASSUMED_SIZE)
&& (e->ref->u.ar.type == AR_FULL))
{
gfc_error ("The upper bound in the last dimension must "
"appear in the reference to the assumed size "
- "array '%s' at %L", sym->name, &e->where);
+ "array %qs at %L", sym->name, &e->where);
return true;
}
return false;
}
@@ -1519,15 +1519,15 @@ count_specific_procs (gfc_expr *e)
sym->name);
n++;
}
if (n > 1)
- gfc_error ("'%s' at %L is ambiguous", e->symtree->n.sym->name,
+ gfc_error ("%qs at %L is ambiguous", e->symtree->n.sym->name,
&e->where);
if (n == 0)
- gfc_error ("GENERIC procedure '%s' is not allowed as an actual "
+ gfc_error ("GENERIC procedure %qs is not allowed as an actual "
"argument at %L", sym->name, &e->where);
return n;
}
@@ -1657,22 +1657,22 @@ gfc_resolve_intrinsic (gfc_symbol *sym,
}
else if (isym || (isym = gfc_find_subroutine (sym->name)))
{
if (sym->ts.type != BT_UNKNOWN && !sym->attr.implicit_type)
{
- gfc_error ("Intrinsic subroutine '%s' at %L shall not have a type"
+ gfc_error ("Intrinsic subroutine %qs at %L shall not have a type"
" specifier", sym->name, &sym->declared_at);
return false;
}
if (!sym->attr.subroutine &&
!gfc_add_subroutine(&sym->attr, sym->name, loc))
return false;
}
else
{
- gfc_error ("'%s' declared INTRINSIC at %L does not exist", sym->name,
+ gfc_error ("%qs declared INTRINSIC at %L does not exist", sym->name,
&sym->declared_at);
return false;
}
gfc_copy_formal_args_intr (sym, isym, NULL);
@@ -1681,11 +1681,11 @@ gfc_resolve_intrinsic (gfc_symbol *sym,
sym->attr.elemental = isym->elemental;
/* Check it is actually available in the standard settings. */
if (!gfc_check_intrinsic_standard (isym, &symstd, false, sym->declared_at))
{
- gfc_error ("The intrinsic '%s' declared INTRINSIC at %L is not"
+ gfc_error ("The intrinsic %qs declared INTRINSIC at %L is not"
" available in the current standard settings but %s. Use"
" an appropriate -std=* option or enable -fall-intrinsics"
" in order to use it.",
sym->name, &sym->declared_at, symstd);
return false;
@@ -1798,19 +1798,19 @@ resolve_actual_arglist (gfc_actual_argli
if (gfc_is_intrinsic (sym, sym->attr.subroutine, e->where))
sym->attr.intrinsic = 1;
if (sym->attr.proc == PROC_ST_FUNCTION)
{
- gfc_error ("Statement function '%s' at %L is not allowed as an "
+ gfc_error ("Statement function %qs at %L is not allowed as an "
"actual argument", sym->name, &e->where);
}
actual_ok = gfc_intrinsic_actual_ok (sym->name,
sym->attr.subroutine);
if (sym->attr.intrinsic && actual_ok == 0)
{
- gfc_error ("Intrinsic '%s' at %L is not allowed as an "
+ gfc_error ("Intrinsic %qs at %L is not allowed as an "
"actual argument", sym->name, &e->where);
}
if (sym->attr.contained && !sym->attr.use_assoc
&& sym->ns->proc_name->attr.flavor != FL_MODULE)
@@ -1821,11 +1821,11 @@ resolve_actual_arglist (gfc_actual_argli
goto cleanup;
}
if (sym->attr.elemental && !sym->attr.intrinsic)
{
- gfc_error ("ELEMENTAL non-INTRINSIC procedure '%s' is not "
+ gfc_error ("ELEMENTAL non-INTRINSIC procedure %qs is not "
"allowed as an actual argument at %L", sym->name,
&e->where);
}
/* Check if a generic interface has a specific procedure
@@ -1849,11 +1849,11 @@ resolve_actual_arglist (gfc_actual_argli
isym = gfc_find_function (sym->name);
if (isym == NULL || !isym->specific)
{
gfc_error ("Unable to find a specific INTRINSIC procedure "
- "for the reference '%s' at %L", sym->name,
+ "for the reference %qs at %L", sym->name,
&e->where);
goto cleanup;
}
sym->ts = isym->ts;
sym->attr.intrinsic = 1;
@@ -1870,11 +1870,11 @@ resolve_actual_arglist (gfc_actual_argli
if (was_declared (sym) || sym->ns->parent == NULL)
goto got_variable;
if (gfc_find_sym_tree (sym->name, sym->ns->parent, 1, &parent_st))
{
- gfc_error ("Symbol '%s' at %L is ambiguous", sym->name, &e->where);
+ gfc_error ("Symbol %qs at %L is ambiguous", sym->name, &e->where);
goto cleanup;
}
if (parent_st == NULL)
goto got_variable;
@@ -2137,12 +2137,12 @@ resolve_elemental_actual (gfc_expr *expr
arg = arg->next, eformal = eformal->next)
if ((eformal->sym->attr.intent == INTENT_OUT
|| eformal->sym->attr.intent == INTENT_INOUT)
&& arg->expr && arg->expr->rank == 0)
{
- gfc_error ("Actual argument at %L for INTENT(%s) dummy '%s' of "
- "ELEMENTAL subroutine '%s' is a scalar, but another "
+ gfc_error ("Actual argument at %L for INTENT(%s) dummy %qs of "
+ "ELEMENTAL subroutine %qs is a scalar, but another "
"actual argument is an array", &arg->expr->where,
(eformal->sym->attr.intent == INTENT_OUT) ? "OUT"
: "INOUT", eformal->sym->name, esym->name);
return false;
}
@@ -2414,20 +2414,20 @@ resolve_global_procedure (gfc_symbol *sy
}
}
if (sym->attr.function && !gfc_compare_types (&sym->ts, &def_sym->ts))
{
- gfc_error ("Return type mismatch of function '%s' at %L (%s/%s)",
+ gfc_error ("Return type mismatch of function %qs at %L (%s/%s)",
sym->name, &sym->declared_at, gfc_typename (&sym->ts),
gfc_typename (&def_sym->ts));
goto done;
}
if (sym->attr.if_source == IFSRC_UNKNOWN
&& gfc_explicit_interface_required (def_sym, reason, sizeof(reason)))
{
- gfc_error ("Explicit interface required for '%s' at %L: %s",
+ gfc_error ("Explicit interface required for %qs at %L: %s",
sym->name, &sym->declared_at, reason);
goto done;
}
if (!pedantic && (gfc_option.allow_std & GFC_STD_GNU))
@@ -2435,11 +2435,11 @@ resolve_global_procedure (gfc_symbol *sy
gfc_errors_to_warnings (true);
if (!gfc_compare_interfaces (sym, def_sym, sym->name, 0, 1,
reason, sizeof(reason), NULL, NULL))
{
- gfc_error ("Interface mismatch in global procedure '%s' at %L: %s ",
+ gfc_error ("Interface mismatch in global procedure %qs at %L: %s ",
sym->name, &sym->declared_at, reason);
goto done;
}
if (!pedantic
@@ -2543,11 +2543,11 @@ generic:
/* Last ditch attempt. See if the reference is to an intrinsic
that possesses a matching interface. 14.1.2.4 */
if (sym && !intr && !gfc_is_intrinsic (sym, 0, expr->where))
{
- gfc_error ("There is no specific function for the generic '%s' "
+ gfc_error ("There is no specific function for the generic %qs "
"at %L", expr->symtree->n.sym->name, &expr->where);
return false;
}
if (intr)
@@ -2561,11 +2561,11 @@ generic:
m = gfc_intrinsic_func_interface (expr, 0);
if (m == MATCH_YES)
return true;
if (m == MATCH_NO)
- gfc_error ("Generic function '%s' at %L is not consistent with a "
+ gfc_error ("Generic function %qs at %L is not consistent with a "
"specific intrinsic interface", expr->symtree->n.sym->name,
&expr->where);
return false;
}
@@ -2599,11 +2599,11 @@ resolve_specific_f0 (gfc_symbol *sym, gf
{
m = gfc_intrinsic_func_interface (expr, 1);
if (m == MATCH_YES)
return MATCH_YES;
if (m == MATCH_NO)
- gfc_error ("Function '%s' at %L is INTRINSIC but is not compatible "
+ gfc_error ("Function %qs at %L is INTRINSIC but is not compatible "
"with an intrinsic", sym->name, &expr->where);
return MATCH_ERROR;
}
@@ -2650,11 +2650,11 @@ resolve_specific_f (gfc_expr *expr)
if (sym == NULL)
break;
}
- gfc_error ("Unable to resolve the specific function '%s' at %L",
+ gfc_error ("Unable to resolve the specific function %qs at %L",
expr->symtree->n.sym->name, &expr->where);
return true;
}
@@ -2706,11 +2706,11 @@ set_type:
{
ts = gfc_get_default_type (sym->name, sym->ns);
if (ts->type == BT_UNKNOWN)
{
- gfc_error ("Function '%s' at %L has no IMPLICIT type",
+ gfc_error ("Function %qs at %L has no IMPLICIT type",
sym->name, &expr->where);
return false;
}
else
expr->ts = *ts;
@@ -2827,19 +2827,19 @@ resolve_function (gfc_expr *expr)
&& !gfc_resolve_intrinsic (sym, &expr->where))
return false;
if (sym && (sym->attr.flavor == FL_VARIABLE || sym->attr.subroutine))
{
- gfc_error ("'%s' at %L is not a function", sym->name, &expr->where);
+ gfc_error ("%qs at %L is not a function", sym->name, &expr->where);
return false;
}
/* If this ia a deferred TBP with an abstract interface (which may
of course be referenced), expr->value.function.esym will be set. */
if (sym && sym->attr.abstract && !expr->value.function.esym)
{
- gfc_error ("ABSTRACT INTERFACE '%s' must not be referenced at %L",
+ gfc_error ("ABSTRACT INTERFACE %qs must not be referenced at %L",
sym->name, &expr->where);
return false;
}
/* Switch off assumed size checking and do this again for certain kinds
@@ -2878,11 +2878,11 @@ resolve_function (gfc_expr *expr)
&& !sym->ts.deferred
&& expr->value.function.esym == NULL
&& !sym->attr.contained)
{
/* Internal procedures are taken care of in resolve_contained_fntype. */
- gfc_error ("Function '%s' is declared CHARACTER(*) and cannot "
+ gfc_error ("Function %qs is declared CHARACTER(*) and cannot "
"be used at %L since it is not a dummy argument",
sym->name, &expr->where);
return false;
}
@@ -2932,11 +2932,11 @@ resolve_function (gfc_expr *expr)
if (omp_workshare_flag
&& expr->value.function.esym
&& ! gfc_elemental (expr->value.function.esym))
{
- gfc_error ("User defined non-ELEMENTAL function '%s' at %L not allowed "
+ gfc_error ("User defined non-ELEMENTAL function %qs at %L not allowed "
"in WORKSHARE construct", expr->value.function.esym->name,
&expr->where);
t = false;
}
@@ -2986,25 +2986,25 @@ resolve_function (gfc_expr *expr)
if (!pure_function (expr, &name) && name)
{
if (forall_flag)
{
- gfc_error ("Reference to non-PURE function '%s' at %L inside a "
+ gfc_error ("Reference to non-PURE function %qs at %L inside a "
"FORALL %s", name, &expr->where,
forall_flag == 2 ? "mask" : "block");
t = false;
}
else if (gfc_do_concurrent_flag)
{
- gfc_error ("Reference to non-PURE function '%s' at %L inside a "
+ gfc_error ("Reference to non-PURE function %qs at %L inside a "
"DO CONCURRENT %s", name, &expr->where,
gfc_do_concurrent_flag == 2 ? "mask" : "block");
t = false;
}
else if (gfc_pure (NULL))
{
- gfc_error ("Function reference to '%s' at %L is to a non-PURE "
+ gfc_error ("Function reference to %qs at %L is to a non-PURE "
"procedure within a PURE procedure", name, &expr->where);
t = false;
}
gfc_unset_implicit_pure (NULL);
@@ -3018,15 +3018,15 @@ resolve_function (gfc_expr *expr)
esym = expr->value.function.esym;
if (is_illegal_recursion (esym, gfc_current_ns))
{
if (esym->attr.entry && esym->ns->entries)
- gfc_error ("ENTRY '%s' at %L cannot be called recursively, as"
- " function '%s' is not RECURSIVE",
+ gfc_error ("ENTRY %qs at %L cannot be called recursively, as"
+ " function %qs is not RECURSIVE",
esym->name, &expr->where, esym->ns->entries->sym->name);
else
- gfc_error ("Function '%s' at %L cannot be called recursively, as it"
+ gfc_error ("Function %qs at %L cannot be called recursively, as it"
" is not RECURSIVE", esym->name, &expr->where);
t = false;
}
}
@@ -3061,17 +3061,17 @@ pure_subroutine (gfc_code *c, gfc_symbol
{
if (gfc_pure (sym))
return;
if (forall_flag)
- gfc_error ("Subroutine call to '%s' in FORALL block at %L is not PURE",
+ gfc_error ("Subroutine call to %qs in FORALL block at %L is not PURE",
sym->name, &c->loc);
else if (gfc_do_concurrent_flag)
- gfc_error ("Subroutine call to '%s' in DO CONCURRENT block at %L is not "
+ gfc_error ("Subroutine call to %qs in DO CONCURRENT block at %L is not "
"PURE", sym->name, &c->loc);
else if (gfc_pure (NULL))
- gfc_error ("Subroutine call to '%s' at %L is not PURE", sym->name,
+ gfc_error ("Subroutine call to %qs at %L is not PURE", sym->name,
&c->loc);
gfc_unset_implicit_pure (NULL);
}
@@ -3132,20 +3132,20 @@ generic:
that possesses a matching interface. 14.1.2.4 */
sym = c->symtree->n.sym;
if (!gfc_is_intrinsic (sym, 1, c->loc))
{
- gfc_error ("There is no specific subroutine for the generic '%s' at %L",
+ gfc_error ("There is no specific subroutine for the generic %qs at %L",
sym->name, &c->loc);
return false;
}
m = gfc_intrinsic_sub_interface (c, 0);
if (m == MATCH_YES)
return true;
if (m == MATCH_NO)
- gfc_error ("Generic subroutine '%s' at %L is not consistent with an "
+ gfc_error ("Generic subroutine %qs at %L is not consistent with an "
"intrinsic subroutine interface", sym->name, &c->loc);
return false;
}
@@ -3176,11 +3176,11 @@ resolve_specific_s0 (gfc_code *c, gfc_sy
{
m = gfc_intrinsic_sub_interface (c, 1);
if (m == MATCH_YES)
return MATCH_YES;
if (m == MATCH_NO)
- gfc_error ("Subroutine '%s' at %L is INTRINSIC but is not compatible "
+ gfc_error ("Subroutine %qs at %L is INTRINSIC but is not compatible "
"with an intrinsic", sym->name, &c->loc);
return MATCH_ERROR;
}
@@ -3220,11 +3220,11 @@ resolve_specific_s (gfc_code *c)
if (sym == NULL)
break;
}
sym = c->symtree->n.sym;
- gfc_error ("Unable to resolve the specific subroutine '%s' at %L",
+ gfc_error ("Unable to resolve the specific subroutine %qs at %L",
sym->name, &c->loc);
return false;
}
@@ -3280,11 +3280,11 @@ resolve_call (gfc_code *c)
csym = c->symtree ? c->symtree->n.sym : NULL;
if (csym && csym->ts.type != BT_UNKNOWN)
{
- gfc_error ("'%s' at %L has a type, which is not consistent with "
+ gfc_error_1 ("'%s' at %L has a type, which is not consistent with "
"the CALL at %L", csym->name, &csym->declared_at, &c->loc);
return false;
}
if (csym && gfc_current_ns->parent && csym->ns != gfc_current_ns)
@@ -3309,25 +3309,25 @@ resolve_call (gfc_code *c)
/* If this ia a deferred TBP, c->expr1 will be set. */
if (!c->expr1 && csym)
{
if (csym->attr.abstract)
{
- gfc_error ("ABSTRACT INTERFACE '%s' must not be referenced at %L",
+ gfc_error ("ABSTRACT INTERFACE %qs must not be referenced at %L",
csym->name, &c->loc);
return false;
}
/* Subroutines without the RECURSIVE attribution are not allowed to
call themselves. */
if (is_illegal_recursion (csym, gfc_current_ns))
{
if (csym->attr.entry && csym->ns->entries)
- gfc_error ("ENTRY '%s' at %L cannot be called recursively, "
- "as subroutine '%s' is not RECURSIVE",
+ gfc_error ("ENTRY %qs at %L cannot be called recursively, "
+ "as subroutine %qs is not RECURSIVE",
csym->name, &c->loc, csym->ns->entries->sym->name);
else
- gfc_error ("SUBROUTINE '%s' at %L cannot be called recursively, "
+ gfc_error ("SUBROUTINE %qs at %L cannot be called recursively, "
"as it is not RECURSIVE", csym->name, &c->loc);
t = false;
}
}
@@ -3400,11 +3400,11 @@ compare_shapes (gfc_expr *op1, gfc_expr
{
for (i = 0; i < op1->rank; i++)
{
if (mpz_cmp (op1->shape[i], op2->shape[i]) != 0)
{
- gfc_error ("Shapes for operands at %L and %L are not conformable",
+ gfc_error_1 ("Shapes for operands at %L and %L are not conformable",
&op1->where, &op2->where);
t = false;
break;
}
}
@@ -6674,11 +6674,11 @@ conformable_arrays (gfc_expr *e1, gfc_ex
mpz_set (s, tail->u.ar.start[i]->value.integer);
}
if (mpz_cmp (e1->shape[i], s) != 0)
{
- gfc_error ("Source-expr at %L and allocate-object at %L must "
+ gfc_error_1 ("Source-expr at %L and allocate-object at %L must "
"have the same shape", &e1->where, &e2->where);
mpz_clear (s);
return false;
}
}
@@ -6832,23 +6832,23 @@ resolve_allocate_expr (gfc_expr *e, gfc_
if (code->expr3)
{
/* Check F03:C631. */
if (!gfc_type_compatible (&e->ts, &code->expr3->ts))
{
- gfc_error ("Type of entity at %L is type incompatible with "
- "source-expr at %L", &e->where, &code->expr3->where);
+ gfc_error_1 ("Type of entity at %L is type incompatible with "
+ "source-expr at %L", &e->where, &code->expr3->where);
goto failure;
}
/* Check F03:C632 and restriction following Note 6.18. */
if (code->expr3->rank > 0 && !conformable_arrays (code->expr3, e))
goto failure;
/* Check F03:C633. */
if (code->expr3->ts.kind != e->ts.kind && !unlimited)
{
- gfc_error ("The allocate-object at %L and the source-expr at %L "
+ 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);
goto failure;
}
@@ -6858,11 +6858,11 @@ resolve_allocate_expr (gfc_expr *e, gfc_
|| (code->expr3->ts.u.derived->from_intmod
== INTMOD_ISO_FORTRAN_ENV
&& code->expr3->ts.u.derived->intmod_sym_id
== ISOFORTRAN_LOCK_TYPE)))
{
- gfc_error ("The source-expr at %L shall neither be of type "
+ gfc_error_1 ("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);
goto failure;
}
@@ -7202,24 +7202,24 @@ resolve_allocate_deallocate (gfc_code *c
c) One of them stops, which is also an error. */
while (1)
{
if (pr == NULL && qr == NULL)
{
- gfc_error ("Allocate-object at %L also appears at %L",
- &pe->where, &qe->where);
+ gfc_error_1 ("Allocate-object at %L also appears at %L",
+ &pe->where, &qe->where);
break;
}
else if (pr != NULL && qr == NULL)
{
- gfc_error ("Allocate-object at %L is subobject of"
- " object at %L", &pe->where, &qe->where);
+ gfc_error_1 ("Allocate-object at %L is subobject of"
+ " object at %L", &pe->where, &qe->where);
break;
}
else if (pr == NULL && qr != NULL)
{
- gfc_error ("Allocate-object at %L is subobject of"
- " object at %L", &qe->where, &pe->where);
+ gfc_error_1 ("Allocate-object at %L is subobject of"
+ " object at %L", &qe->where, &pe->where);
break;
}
/* Here, pr != NULL && qr != NULL */
gcc_assert(pr->type == qr->type);
if (pr->type == REF_ARRAY)
@@ -7418,11 +7418,11 @@ check_case_overlap (gfc_case *list)
{
/* The cases overlap, or they are the same
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 ("CASE label at %L overlaps with CASE "
+ gfc_error_1 ("CASE label at %L overlaps with CASE "
"label at %L", &p->where, &q->where);
overlap_seen = 1;
e = p;
p = p->right;
psize--;
@@ -7656,11 +7656,11 @@ resolve_select (gfc_code *code, bool sel
/* Intercept the DEFAULT case. */
if (cp->low == NULL && cp->high == NULL)
{
if (default_case != NULL)
{
- gfc_error ("The DEFAULT CASE at %L cannot be followed "
+ gfc_error_1 ("The DEFAULT CASE at %L cannot be followed "
"by a second DEFAULT CASE at %L",
&default_case->where, &cp->where);
t = false;
break;
}
@@ -8026,11 +8026,11 @@ resolve_select_type (gfc_code *code, gfc
if (c->ts.type == BT_UNKNOWN)
{
/* Check F03:C818. */
if (default_case)
{
- gfc_error ("The DEFAULT CASE at %L cannot be followed "
+ gfc_error_1 ("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++;
continue;
}
@@ -8584,11 +8584,11 @@ resolve_branch (gfc_st_label *label, gfc
return;
}
if (label->defined != ST_LABEL_TARGET && label->defined != ST_LABEL_DO_TARGET)
{
- gfc_error ("Statement at %L is not a valid branch target statement "
+ gfc_error_1 ("Statement at %L is not a valid branch target statement "
"for the branch statement at %L", &label->where, &code->loc);
return;
}
/* Step two: make sure this branch is not a branch to itself ;-) */
@@ -8610,15 +8610,15 @@ resolve_branch (gfc_st_label *label, gfc
which is invalid. */
for (stack = cs_base; stack; stack = stack->prev)
{
if (stack->current->op == EXEC_CRITICAL
&& bitmap_bit_p (stack->reachable_labels, label->value))
- gfc_error ("GOTO statement at %L leaves CRITICAL construct for "
+ gfc_error_1 ("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 ("GOTO statement at %L leaves DO CONCURRENT construct "
+ gfc_error_1 ("GOTO statement at %L leaves DO CONCURRENT construct "
"for label at %L", &code->loc, &label->where);
}
return;
}
@@ -8633,17 +8633,17 @@ resolve_branch (gfc_st_label *label, gfc
break;
if (stack->current->op == EXEC_CRITICAL)
{
/* Note: A label at END CRITICAL does not leave the CRITICAL
construct as END CRITICAL is still part of it. */
- gfc_error ("GOTO statement at %L leaves CRITICAL construct for label"
+ gfc_error_1 ("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 ("GOTO statement at %L leaves DO CONCURRENT construct for "
+ gfc_error_1 ("GOTO statement at %L leaves DO CONCURRENT construct for "
"label at %L", &code->loc, &label->where);
return;
}
}
@@ -9999,11 +9999,11 @@ gfc_resolve_code (gfc_code *code, gfc_na
{
if (code->expr1->ts.type != BT_INTEGER)
gfc_error ("ASSIGNED GOTO statement at %L requires an "
"INTEGER variable", &code->expr1->where);
else if (code->expr1->symtree->n.sym->attr.assign != 1)
- gfc_error ("Variable '%s' has not been assigned a target "
+ gfc_error ("Variable %qs has not been assigned a target "
"label at %L", code->expr1->symtree->n.sym->name,
&code->expr1->where);
}
else
resolve_branch (code->label1, code);
@@ -10384,11 +10384,11 @@ gfc_verify_binding_labels (gfc_symbol *s
return;
}
if (sym->attr.flavor == FL_VARIABLE && gsym->type != GSYM_UNKNOWN)
{
- gfc_error ("Variable %s with binding label %s at %L uses the same global "
+ gfc_error_1 ("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. */
sym->binding_label = NULL;
@@ -10397,12 +10397,12 @@ gfc_verify_binding_labels (gfc_symbol *s
&& (strcmp (module, gsym->mod_name) != 0
|| strcmp (sym->name, gsym->sym_name) != 0))
{
/* This can only happen if the variable is defined in a module - if it
isn't the same module, reject it. */
- 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",
+ gfc_error_1 ("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);
sym->binding_label = NULL;
}
else if ((sym->attr.function || sym->attr.subroutine)
@@ -10414,11 +10414,11 @@ gfc_verify_binding_labels (gfc_symbol *s
|| (module && strcmp (module, gsym->mod_name) != 0)))
{
/* 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 ("Procedure %s with binding label %s at %L uses the same "
+ gfc_error_1 ("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;
}
}
@@ -10914,11 +10914,11 @@ resolve_fl_variable_derived (gfc_symbol
gfc_find_symbol (sym->ts.u.derived->name, sym->ns, 0, &s);
if (s && s->attr.generic)
s = gfc_find_dt_in_generic (s);
if (s && s->attr.flavor != FL_DERIVED)
{
- gfc_error ("The type '%s' cannot be host associated at %L "
+ gfc_error_1 ("The type '%s' 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,
&s->declared_at);
return false;
@@ -12333,39 +12333,39 @@ resolve_fl_derived0 (gfc_symbol *sym)
/* F2008, C442. */
if ((!sym->attr.is_class || c != sym->components)
&& c->attr.codimension
&& (!c->attr.allocatable || (c->as && c->as->type != AS_DEFERRED)))
{
- gfc_error ("Coarray component '%s' at %L must be allocatable with "
+ gfc_error ("Coarray component %qs at %L must be allocatable with "
"deferred shape", c->name, &c->loc);
return false;
}
/* F2008, C443. */
if (c->attr.codimension && c->ts.type == BT_DERIVED
&& c->ts.u.derived->ts.is_iso_c)
{
- gfc_error ("Component '%s' at %L of TYPE(C_PTR) or TYPE(C_FUNPTR) "
+ gfc_error ("Component %qs at %L of TYPE(C_PTR) or TYPE(C_FUNPTR) "
"shall not be a coarray", c->name, &c->loc);
return false;
}
/* F2008, C444. */
if (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.coarray_comp
&& (c->attr.codimension || c->attr.pointer || c->attr.dimension
|| c->attr.allocatable))
{
- gfc_error ("Component '%s' at %L with coarray component "
+ gfc_error ("Component %qs at %L with coarray component "
"shall be a nonpointer, nonallocatable scalar",
c->name, &c->loc);
return false;
}
/* F2008, C448. */
if (c->attr.contiguous && (!c->attr.dimension || !c->attr.pointer))
{
- gfc_error ("Component '%s' at %L has the CONTIGUOUS attribute but "
+ gfc_error ("Component %qs at %L has the CONTIGUOUS attribute but "
"is not an array pointer", c->name, &c->loc);
return false;
}
if (c->attr.proc_pointer && c->ts.interface)
@@ -12454,12 +12454,12 @@ resolve_fl_derived0 (gfc_symbol *sym)
c->tb->pass_arg_num++;
}
if (!me_arg)
{
- gfc_error ("Procedure pointer component '%s' with PASS(%s) "
- "at %L has no argument '%s'", c->name,
+ gfc_error ("Procedure pointer component %qs with PASS(%s) "
+ "at %L has no argument %qs", c->name,
c->tb->pass_arg, &c->loc, c->tb->pass_arg);
c->tb->error = 1;
return false;
}
}
@@ -12468,11 +12468,11 @@ resolve_fl_derived0 (gfc_symbol *sym)
/* Otherwise, take the first one; there should in fact be at least
one. */
c->tb->pass_arg_num = 1;
if (!c->ts.interface->formal)
{
- gfc_error ("Procedure pointer component '%s' with PASS at %L "
+ gfc_error ("Procedure pointer component %qs with PASS at %L "
"must have at least one argument",
c->name, &c->loc);
c->tb->error = 1;
return false;
}
@@ -12484,47 +12484,47 @@ resolve_fl_derived0 (gfc_symbol *sym)
if ((me_arg->ts.type != BT_DERIVED && me_arg->ts.type != BT_CLASS)
|| (me_arg->ts.type == BT_DERIVED && me_arg->ts.u.derived != sym)
|| (me_arg->ts.type == BT_CLASS
&& CLASS_DATA (me_arg)->ts.u.derived != sym))
{
- gfc_error ("Argument '%s' of '%s' with PASS(%s) at %L must be of"
- " the derived type '%s'", me_arg->name, c->name,
+ gfc_error ("Argument %qs of %qs with PASS(%s) at %L must be of"
+ " the derived type %qs", me_arg->name, c->name,
me_arg->name, &c->loc, sym->name);
c->tb->error = 1;
return false;
}
/* Check for C453. */
if (me_arg->attr.dimension)
{
- gfc_error ("Argument '%s' of '%s' with PASS(%s) at %L "
+ gfc_error ("Argument %qs of %qs with PASS(%s) at %L "
"must be scalar", me_arg->name, c->name, me_arg->name,
&c->loc);
c->tb->error = 1;
return false;
}
if (me_arg->attr.pointer)
{
- gfc_error ("Argument '%s' of '%s' with PASS(%s) at %L "
+ gfc_error ("Argument %qs of %qs with PASS(%s) at %L "
"may not have the POINTER attribute", me_arg->name,
c->name, me_arg->name, &c->loc);
c->tb->error = 1;
return false;
}
if (me_arg->attr.allocatable)
{
- gfc_error ("Argument '%s' of '%s' with PASS(%s) at %L "
+ gfc_error ("Argument %qs of %qs with PASS(%s) at %L "
"may not be ALLOCATABLE", me_arg->name, c->name,
me_arg->name, &c->loc);
c->tb->error = 1;
return false;
}
if (gfc_type_is_extensible (sym) && me_arg->ts.type != BT_CLASS)
- gfc_error ("Non-polymorphic passed-object dummy argument of '%s'"
+ gfc_error ("Non-polymorphic passed-object dummy argument of %qs"
" at %L", c->name, &c->loc);
}
/* Check type-spec if this is not the parent-type component. */
@@ -12549,11 +12549,11 @@ resolve_fl_derived0 (gfc_symbol *sym)
/* If this type is an extension, see if this component has the same name
as an inherited type-bound procedure. */
if (super_type && !sym->attr.is_class
&& gfc_find_typebound_proc (super_type, NULL, c->name, true, NULL))
{
- gfc_error ("Component '%s' of '%s' at %L has the same name as an"
+ gfc_error ("Component %qs of %qs at %L has the same name as an"
" inherited type-bound procedure",
c->name, sym->name, &c->loc);
return false;
}
@@ -12562,22 +12562,22 @@ resolve_fl_derived0 (gfc_symbol *sym)
{
if (c->ts.u.cl->length == NULL
|| (!resolve_charlen(c->ts.u.cl))
|| !gfc_is_constant_expr (c->ts.u.cl->length))
{
- gfc_error ("Character length of component '%s' needs to "
+ gfc_error ("Character length of component %qs needs to "
"be a constant specification expression at %L",
c->name,
c->ts.u.cl->length ? &c->ts.u.cl->length->where : &c->loc);
return false;
}
}
if (c->ts.type == BT_CHARACTER && c->ts.deferred
&& !c->attr.pointer && !c->attr.allocatable)
{
- gfc_error ("Character component '%s' of '%s' at %L with deferred "
+ gfc_error ("Character component %qs of %qs at %L with deferred "
"length must be a POINTER or ALLOCATABLE",
c->name, sym->name, &c->loc);
return false;
}
@@ -12639,11 +12639,11 @@ resolve_fl_derived0 (gfc_symbol *sym)
if (!sym->attr.is_class && c->ts.type == BT_DERIVED && !sym->attr.vtype
&& c->attr.pointer && c->ts.u.derived->components == NULL
&& !c->ts.u.derived->attr.zero_comp)
{
- gfc_error ("The pointer component '%s' of '%s' at %L is a type "
+ gfc_error ("The pointer component %qs of %qs at %L is a type "
"that has not been declared", c->name, sym->name,
&c->loc);
return false;
}
@@ -12651,11 +12651,11 @@ resolve_fl_derived0 (gfc_symbol *sym)
&& CLASS_DATA (c)->attr.class_pointer
&& CLASS_DATA (c)->ts.u.derived->components == NULL
&& !CLASS_DATA (c)->ts.u.derived->attr.zero_comp
&& !UNLIMITED_POLY (c))
{
- gfc_error ("The pointer component '%s' of '%s' at %L is a type "
+ gfc_error ("The pointer component %qs of %qs at %L is a type "
"that has not been declared", c->name, sym->name,
&c->loc);
return false;
}
@@ -12663,11 +12663,11 @@ resolve_fl_derived0 (gfc_symbol *sym)
if (c->ts.type == BT_CLASS && c->attr.flavor != FL_PROCEDURE
&& (!c->attr.class_ok
|| !(CLASS_DATA (c)->attr.class_pointer
|| CLASS_DATA (c)->attr.allocatable)))
{
- gfc_error ("Component '%s' with CLASS at %L must be allocatable "
+ gfc_error ("Component %qs with CLASS at %L must be allocatable "
"or pointer", c->name, &c->loc);
/* Prevent a recurrence of the error. */
c->ts.type = BT_UNKNOWN;
return false;
}
@@ -13315,11 +13315,11 @@ resolve_symbol (gfc_symbol *sym)
/* First, make sure the variable is declared at the
module-level scope (J3/04-007, Section 15.3). */
if (sym->ns->proc_name->attr.flavor != FL_MODULE &&
sym->attr.in_common == 0)
{
- gfc_error ("Variable '%s' at %L cannot be BIND(C) because it "
+ gfc_error ("Variable %qs at %L cannot be BIND(C) because it "
"is neither a COMMON block nor declared at the "
"module level scope", sym->name, &(sym->declared_at));
t = false;
}
else if (sym->common_head != NULL)
Index: gcc/fortran/match.c
===================================================================
--- gcc/fortran/match.c (revision 218457)
+++ gcc/fortran/match.c (working copy)
@@ -3546,11 +3546,11 @@ alloc_opt_list:
}
/* The next 2 conditionals check C631. */
if (ts.type != BT_UNKNOWN)
{
- gfc_error ("SOURCE tag at %L conflicts with the typespec at %L",
+ gfc_error_1 ("SOURCE tag at %L conflicts with the typespec at %L",
&tmp->where, &old_locus);
goto cleanup;
}
if (head->next
@@ -3583,11 +3583,11 @@ alloc_opt_list:
}
/* Check F08:C637. */
if (ts.type != BT_UNKNOWN)
{
- gfc_error ("MOLD tag at %L conflicts with the typespec at %L",
+ gfc_error_1 ("MOLD tag at %L conflicts with the typespec at %L",
&tmp->where, &old_locus);
goto cleanup;
}
mold = tmp;
@@ -3609,11 +3609,11 @@ alloc_opt_list:
goto syntax;
/* Check F08:C637. */
if (source && mold)
{
- gfc_error ("MOLD tag at %L conflicts with SOURCE tag at %L",
+ gfc_error_1 ("MOLD tag at %L conflicts with SOURCE tag at %L",
&mold->where, &source->where);
goto cleanup;
}
/* Check F03:C623, */
@@ -4313,11 +4313,11 @@ gfc_match_common (void)
t->name);
}
if (sym->attr.in_common)
{
- gfc_error ("Symbol '%s' at %C is already in a COMMON block",
+ gfc_error ("Symbol %qs at %C is already in a COMMON block",
sym->name);
goto cleanup;
}
if (((sym->value != NULL && sym->value->expr_type != EXPR_NULL)
@@ -4836,20 +4836,22 @@ recursive_stmt_fcn (gfc_expr *e, gfc_sym
MATCH_NO that we suppress error message in most cases. */
match
gfc_match_st_function (void)
{
- gfc_error_buf old_error;
+ gfc_error_buf old_error_1;
+ output_buffer old_error;
+
gfc_symbol *sym;
gfc_expr *expr;
match m;
m = gfc_match_symbol (&sym, 0);
if (m != MATCH_YES)
return m;
- gfc_push_error (&old_error);
+ gfc_push_error (&old_error, &old_error_1);
if (!gfc_add_procedure (&sym->attr, PROC_ST_FUNCTION, sym->name, NULL))
goto undo_error;
if (gfc_match_formal_arglist (sym, 1, 0) != MATCH_YES)
@@ -4857,11 +4859,12 @@ gfc_match_st_function (void)
m = gfc_match (" = %e%t", &expr);
if (m == MATCH_NO)
goto undo_error;
- gfc_free_error (&old_error);
+ gfc_free_error (&old_error, &old_error_1);
+
if (m == MATCH_ERROR)
return m;
if (recursive_stmt_fcn (expr, sym))
{
@@ -4875,11 +4878,11 @@ gfc_match_st_function (void)
return MATCH_ERROR;
return MATCH_YES;
undo_error:
- gfc_pop_error (&old_error);
+ gfc_pop_error (&old_error, &old_error_1);
return MATCH_NO;
}
/***************** SELECT CASE subroutines ******************/
Index: gcc/fortran/arith.c
===================================================================
--- gcc/fortran/arith.c (revision 218457)
+++ gcc/fortran/arith.c (working copy)
@@ -1913,21 +1913,21 @@ arith_error (arith rc, gfc_typespec *fro
gfc_error ("Arithmetic OK converting %s to %s at %L",
gfc_typename (from), gfc_typename (to), where);
break;
case ARITH_OVERFLOW:
gfc_error ("Arithmetic overflow converting %s to %s at %L. This check "
- "can be disabled with the option -fno-range-check",
+ "can be disabled with the option %<-fno-range-check%>",
gfc_typename (from), gfc_typename (to), where);
break;
case ARITH_UNDERFLOW:
gfc_error ("Arithmetic underflow converting %s to %s at %L. This check "
- "can be disabled with the option -fno-range-check",
+ "can be disabled with the option %<-fno-range-check%>",
gfc_typename (from), gfc_typename (to), where);
break;
case ARITH_NAN:
gfc_error ("Arithmetic NaN converting %s to %s at %L. This check "
- "can be disabled with the option -fno-range-check",
+ "can be disabled with the option %<-fno-range-check%>",
gfc_typename (from), gfc_typename (to), where);
break;
case ARITH_DIV0:
gfc_error ("Division by zero converting %s to %s at %L",
gfc_typename (from), gfc_typename (to), where);
Index: gcc/fortran/parse.c
===================================================================
--- gcc/fortran/parse.c (revision 218457)
+++ gcc/fortran/parse.c (working copy)
@@ -105,17 +105,18 @@ match_word_omp_simd (const char *str, ma
/* Load symbols from all USE statements encountered in this scoping unit. */
static void
use_modules (void)
{
- gfc_error_buf old_error;
+ gfc_error_buf old_error_1;
+ output_buffer old_error;
- gfc_push_error (&old_error);
+ gfc_push_error (&old_error, &old_error_1);
gfc_buffer_error (false);
gfc_use_modules ();
gfc_buffer_error (true);
- gfc_pop_error (&old_error);
+ gfc_pop_error (&old_error, &old_error_1);
gfc_commit_symbols ();
gfc_warning_check ();
gfc_current_ns->old_cl_list = gfc_current_ns->cl_list;
gfc_current_ns->old_equiv = gfc_current_ns->equiv;
last_was_use_stmt = false;
@@ -2200,11 +2201,11 @@ verify_st_order (st_state *p, gfc_statem
p->last_statement = st;
return true;
order:
if (!silent)
- gfc_error ("%s statement at %C cannot follow %s statement at %L",
+ gfc_error_1 ("%s statement at %C cannot follow %s statement at %L",
gfc_ascii_statement (st),
gfc_ascii_statement (p->last_statement), &p->where);
return false;
}
@@ -2577,11 +2578,11 @@ endType:
"be a subcomponent of a coarray. (Variables of type %s may "
"not have a codimension as already a coarray "
"subcomponent exists)", c->name, &c->loc, sym->name);
if (sym->attr.lock_comp && coarray && !lock_type)
- gfc_error ("Noncoarray component %s at %L of type LOCK_TYPE or with "
+ gfc_error_1 ("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 "
"coarray subcomponent)", lock_comp->name, &lock_comp->loc,
sym->name, c->name, &c->loc);
@@ -3279,11 +3280,11 @@ parse_if_block (void)
unexpected_eof ();
case ST_ELSEIF:
if (seen_else)
{
- gfc_error ("ELSE IF statement at %C cannot follow ELSE "
+ gfc_error_1 ("ELSE IF statement at %C cannot follow ELSE "
"statement at %L", &else_locus);
reject_statement ();
break;
}
@@ -4672,14 +4673,14 @@ gfc_global_used (gfc_gsymbol *sym, locus
gfc_internal_error ("gfc_global_used(): Bad type");
name = NULL;
}
if (sym->binding_label)
- gfc_error ("Global binding name '%s' at %L is already being used as a %s "
+ gfc_error_1 ("Global binding name '%s' at %L is already being used as a %s "
"at %L", sym->binding_label, where, name, &sym->where);
else
- gfc_error ("Global name '%s' at %L is already being used as a %s at %L",
+ gfc_error_1 ("Global name '%s' at %L is already being used as a %s at %L",
sym->name, where, name, &sym->where);
}
/* Parse a block data program unit. */
Index: gcc/fortran/check.c
===================================================================
--- gcc/fortran/check.c (revision 218457)
+++ gcc/fortran/check.c (working copy)
@@ -41,11 +41,11 @@ static bool
scalar_check (gfc_expr *e, int n)
{
if (e->rank == 0)
return true;
- gfc_error ("'%s' argument of '%s' intrinsic at %L must be a scalar",
+ gfc_error ("%qs argument of %qs intrinsic at %L must be a scalar",
gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic,
&e->where);
return false;
}
@@ -57,11 +57,11 @@ static bool
type_check (gfc_expr *e, int n, bt type)
{
if (e->ts.type == type)
return true;
- gfc_error ("'%s' argument of '%s' intrinsic at %L must be %s",
+ gfc_error ("%qs argument of %qs intrinsic at %L must be %s",
gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic,
&e->where, gfc_basic_typename (type));
return false;
}
@@ -84,11 +84,11 @@ numeric_check (gfc_expr *e, int n)
{
e->ts = e->symtree->n.sym->ts;
return true;
}
- gfc_error ("'%s' argument of '%s' intrinsic at %L must be a numeric type",
+ gfc_error ("%qs argument of %qs intrinsic at %L must be a numeric type",
gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic,
&e->where);
return false;
}
@@ -99,11 +99,11 @@ numeric_check (gfc_expr *e, int n)
static bool
int_or_real_check (gfc_expr *e, int n)
{
if (e->ts.type != BT_INTEGER && e->ts.type != BT_REAL)
{
- gfc_error ("'%s' argument of '%s' intrinsic at %L must be INTEGER "
+ gfc_error ("%qs argument of %qs intrinsic at %L must be INTEGER "
"or REAL", gfc_current_intrinsic_arg[n]->name,
gfc_current_intrinsic, &e->where);
return false;
}
@@ -116,11 +116,11 @@ int_or_real_check (gfc_expr *e, int n)
static bool
real_or_complex_check (gfc_expr *e, int n)
{
if (e->ts.type != BT_REAL && e->ts.type != BT_COMPLEX)
{
- gfc_error ("'%s' argument of '%s' intrinsic at %L must be REAL "
+ gfc_error ("%qs argument of %qs intrinsic at %L must be REAL "
"or COMPLEX", gfc_current_intrinsic_arg[n]->name,
gfc_current_intrinsic, &e->where);
return false;
}
@@ -133,11 +133,11 @@ real_or_complex_check (gfc_expr *e, int
static bool
int_or_proc_check (gfc_expr *e, int n)
{
if (e->ts.type != BT_INTEGER && e->ts.type != BT_PROCEDURE)
{
- gfc_error ("'%s' argument of '%s' intrinsic at %L must be INTEGER "
+ gfc_error ("%qs argument of %qs intrinsic at %L must be INTEGER "
"or PROCEDURE", gfc_current_intrinsic_arg[n]->name,
gfc_current_intrinsic, &e->where);
return false;
}
@@ -162,11 +162,11 @@ kind_check (gfc_expr *k, int n, bt type)
if (!scalar_check (k, n))
return false;
if (!gfc_check_init_expr (k))
{
- gfc_error ("'%s' argument of '%s' intrinsic at %L must be a constant",
+ gfc_error ("%qs argument of %qs intrinsic at %L must be a constant",
gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic,
&k->where);
return false;
}
@@ -190,11 +190,11 @@ double_check (gfc_expr *d, int n)
if (!type_check (d, n, BT_REAL))
return false;
if (d->ts.kind != gfc_default_double_kind)
{
- gfc_error ("'%s' argument of '%s' intrinsic at %L must be double "
+ gfc_error ("%qs argument of %qs intrinsic at %L must be double "
"precision", gfc_current_intrinsic_arg[n]->name,
gfc_current_intrinsic, &d->where);
return false;
}
@@ -213,11 +213,11 @@ coarray_check (gfc_expr *e, int n)
return true;
}
if (!gfc_is_coarray (e))
{
- gfc_error ("Expected coarray variable as '%s' argument to the %s "
+ gfc_error ("Expected coarray variable as %qs argument to the %s "
"intrinsic at %L", gfc_current_intrinsic_arg[n]->name,
gfc_current_intrinsic, &e->where);
return false;
}
@@ -230,11 +230,11 @@ coarray_check (gfc_expr *e, int n)
static bool
logical_array_check (gfc_expr *array, int n)
{
if (array->ts.type != BT_LOGICAL || array->rank == 0)
{
- gfc_error ("'%s' argument of '%s' intrinsic at %L must be a logical "
+ gfc_error ("%qs argument of %qs intrinsic at %L must be a logical "
"array", gfc_current_intrinsic_arg[n]->name,
gfc_current_intrinsic, &array->where);
return false;
}
@@ -256,11 +256,11 @@ array_check (gfc_expr *e, int n)
}
if (e->rank != 0 && e->ts.type != BT_PROCEDURE)
return true;
- gfc_error ("'%s' argument of '%s' intrinsic at %L must be an array",
+ gfc_error ("%qs argument of %qs intrinsic at %L must be an array",
gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic,
&e->where);
return false;
}
@@ -277,11 +277,11 @@ nonnegative_check (const char *arg, gfc_
if (expr->expr_type == EXPR_CONSTANT)
{
gfc_extract_int (expr, &i);
if (i < 0)
{
- gfc_error ("'%s' at %L must be nonnegative", arg, &expr->where);
+ gfc_error ("%qs at %L must be nonnegative", arg, &expr->where);
return false;
}
}
return true;
@@ -309,31 +309,31 @@ less_than_bitsize1 (const char *arg1, gf
i2 = -i2;
if (i2 > gfc_integer_kinds[i3].bit_size)
{
gfc_error ("The absolute value of SHIFT at %L must be less "
- "than or equal to BIT_SIZE('%s')",
+ "than or equal to BIT_SIZE(%qs)",
&expr2->where, arg1);
return false;
}
}
if (or_equal)
{
if (i2 > gfc_integer_kinds[i3].bit_size)
{
- gfc_error ("'%s' at %L must be less than "
- "or equal to BIT_SIZE('%s')",
+ gfc_error ("%qs at %L must be less than "
+ "or equal to BIT_SIZE(%qs)",
arg2, &expr2->where, arg1);
return false;
}
}
else
{
if (i2 >= gfc_integer_kinds[i3].bit_size)
{
- gfc_error ("'%s' at %L must be less than BIT_SIZE('%s')",
+ gfc_error ("%qs at %L must be less than BIT_SIZE(%qs)",
arg2, &expr2->where, arg1);
return false;
}
}
}
@@ -356,11 +356,11 @@ less_than_bitsizekind (const char *arg,
i = gfc_validate_kind (BT_INTEGER, k, false);
gfc_extract_int (expr, &val);
if (val > gfc_integer_kinds[i].bit_size)
{
- gfc_error ("'%s' at %L must be less than or equal to the BIT_SIZE of "
+ gfc_error ("%qs at %L must be less than or equal to the BIT_SIZE of "
"INTEGER(KIND=%d)", arg, &expr->where, k);
return false;
}
return true;
@@ -383,11 +383,11 @@ less_than_bitsize2 (const char *arg1, gf
i2 += i3;
i3 = gfc_validate_kind (BT_INTEGER, expr1->ts.kind, false);
if (i2 > gfc_integer_kinds[i3].bit_size)
{
gfc_error ("'%s + %s' at %L must be less than or equal "
- "to BIT_SIZE('%s')",
+ "to BIT_SIZE(%qs)",
arg2, arg3, &expr2->where, arg1);
return false;
}
}
@@ -400,12 +400,12 @@ static bool
same_type_check (gfc_expr *e, int n, gfc_expr *f, int m)
{
if (gfc_compare_types (&e->ts, &f->ts))
return true;
- gfc_error ("'%s' argument of '%s' intrinsic at %L must be the same type "
- "and kind as '%s'", gfc_current_intrinsic_arg[m]->name,
+ gfc_error ("%qs argument of %qs intrinsic at %L must be the same type "
+ "and kind as %qs", gfc_current_intrinsic_arg[m]->name,
gfc_current_intrinsic, &f->where,
gfc_current_intrinsic_arg[n]->name);
return false;
}
@@ -417,11 +417,11 @@ static bool
rank_check (gfc_expr *e, int n, int rank)
{
if (e->rank == rank)
return true;
- gfc_error ("'%s' argument of '%s' intrinsic at %L must be of rank %d",
+ gfc_error ("%qs argument of %qs intrinsic at %L must be of rank %d",
gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic,
&e->where, rank);
return false;
}
@@ -432,11 +432,11 @@ rank_check (gfc_expr *e, int n, int rank
static bool
nonoptional_check (gfc_expr *e, int n)
{
if (e->expr_type == EXPR_VARIABLE && e->symtree->n.sym->attr.optional)
{
- gfc_error ("'%s' argument of '%s' intrinsic at %L must not be OPTIONAL",
+ gfc_error ("%qs argument of %qs intrinsic at %L must not be OPTIONAL",
gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic,
&e->where);
}
/* TODO: Recursive check on nonoptional variables? */
@@ -453,11 +453,11 @@ allocatable_check (gfc_expr *e, int n)
symbol_attribute attr;
attr = gfc_variable_attr (e, NULL);
if (!attr.allocatable || attr.associate_var)
{
- gfc_error ("'%s' argument of '%s' intrinsic at %L must be ALLOCATABLE",
+ gfc_error ("%qs argument of %qs intrinsic at %L must be ALLOCATABLE",
gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic,
&e->where);
return false;
}
@@ -471,11 +471,11 @@ static bool
kind_value_check (gfc_expr *e, int n, int k)
{
if (e->ts.kind == k)
return true;
- gfc_error ("'%s' argument of '%s' intrinsic at %L must be of kind %d",
+ gfc_error ("%qs argument of %qs intrinsic at %L must be of kind %d",
gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic,
&e->where, k);
return false;
}
@@ -509,11 +509,11 @@ variable_check (gfc_expr *e, int n, bool
break;
}
if (!ref)
{
- gfc_error ("'%s' argument of '%s' intrinsic at %L cannot be "
+ gfc_error ("%qs argument of %qs intrinsic at %L cannot be "
"INTENT(IN)", gfc_current_intrinsic_arg[n]->name,
gfc_current_intrinsic, &e->where);
return false;
}
}
@@ -530,11 +530,11 @@ variable_check (gfc_expr *e, int n, bool
for (ns = gfc_current_ns; ns; ns = ns->parent)
if (ns->proc_name == e->symtree->n.sym)
return true;
}
- gfc_error ("'%s' argument of '%s' intrinsic at %L must be a variable",
+ gfc_error ("%qs argument of %qs intrinsic at %L must be a variable",
gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic, &e->where);
return false;
}
@@ -579,11 +579,11 @@ dim_corank_check (gfc_expr *dim, gfc_exp
corank = gfc_get_corank (array);
if (mpz_cmp_ui (dim->value.integer, 1) < 0
|| mpz_cmp_ui (dim->value.integer, corank) > 0)
{
- gfc_error ("'dim' argument of '%s' intrinsic at %L is not a valid "
+ gfc_error ("'dim' argument of %qs intrinsic at %L is not a valid "
"codimension index", gfc_current_intrinsic, &dim->where);
return false;
}
@@ -629,11 +629,11 @@ dim_rank_check (gfc_expr *dim, gfc_expr
}
if (mpz_cmp_ui (dim->value.integer, 1) < 0
|| mpz_cmp_ui (dim->value.integer, rank) > 0)
{
- gfc_error ("'dim' argument of '%s' intrinsic at %L is not a valid "
+ gfc_error ("'dim' argument of %qs intrinsic at %L is not a valid "
"dimension index", gfc_current_intrinsic, &dim->where);
return false;
}
@@ -854,11 +854,11 @@ gfc_check_a_p (gfc_expr *a, gfc_expr *p)
if (!int_or_real_check (a, 0))
return false;
if (a->ts.type != p->ts.type)
{
- gfc_error ("'%s' and '%s' arguments of '%s' intrinsic at %L must "
+ gfc_error ("%qs and %qs arguments of %qs intrinsic at %L must "
"have the same type", gfc_current_intrinsic_arg[0]->name,
gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic,
&p->where);
return false;
}
@@ -899,20 +899,20 @@ gfc_check_associated (gfc_expr *pointer,
attr1 = gfc_expr_attr (pointer);
if (!attr1.pointer && !attr1.proc_pointer)
{
- gfc_error ("'%s' argument of '%s' intrinsic at %L must be a POINTER",
+ gfc_error ("%qs argument of %qs intrinsic at %L must be a POINTER",
gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic,
&pointer->where);
return false;
}
/* F2008, C1242. */
if (attr1.pointer && gfc_is_coindexed (pointer))
{
- gfc_error ("'%s' argument of '%s' intrinsic at %L shall not be "
+ gfc_error ("%qs argument of %qs intrinsic at %L shall not be "
"coindexed", gfc_current_intrinsic_arg[0]->name,
gfc_current_intrinsic, &pointer->where);
return false;
}
@@ -926,29 +926,29 @@ gfc_check_associated (gfc_expr *pointer,
if (target->expr_type == EXPR_VARIABLE || target->expr_type == EXPR_FUNCTION)
attr2 = gfc_expr_attr (target);
else
{
- gfc_error ("'%s' argument of '%s' intrinsic at %L must be a pointer "
+ gfc_error ("%qs argument of %qs intrinsic at %L must be a pointer "
"or target VARIABLE or FUNCTION",
gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic,
&target->where);
return false;
}
if (attr1.pointer && !attr2.pointer && !attr2.target)
{
- gfc_error ("'%s' argument of '%s' intrinsic at %L must be a POINTER "
+ gfc_error ("%qs argument of %qs intrinsic at %L must be a POINTER "
"or a TARGET", gfc_current_intrinsic_arg[1]->name,
gfc_current_intrinsic, &target->where);
return false;
}
/* F2008, C1242. */
if (attr1.pointer && gfc_is_coindexed (target))
{
- gfc_error ("'%s' argument of '%s' intrinsic at %L shall not be "
+ gfc_error ("%qs argument of %qs intrinsic at %L shall not be "
"coindexed", gfc_current_intrinsic_arg[1]->name,
gfc_current_intrinsic, &target->where);
return false;
}
@@ -972,11 +972,11 @@ gfc_check_associated (gfc_expr *pointer,
return t;
null_arg:
gfc_error ("NULL pointer at %L is not permitted as actual argument "
- "of '%s' intrinsic function", where, gfc_current_intrinsic);
+ "of %qs intrinsic function", where, gfc_current_intrinsic);
return false;
}
@@ -1029,11 +1029,11 @@ gfc_check_atomic (gfc_expr *atom, int at
return false;
}
if (atom->ts.type != value->ts.type)
{
- gfc_error ("'%s' argument of '%s' intrinsic at %L shall have the same "
+ 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_current_intrinsic, &value->where,
gfc_current_intrinsic_arg[atom_no]->name, &atom->where);
return false;
}
@@ -1375,20 +1375,20 @@ gfc_check_cmplx (gfc_expr *x, gfc_expr *
if (!numeric_check (y, 1))
return false;
if (x->ts.type == BT_COMPLEX)
{
- gfc_error ("'%s' argument of '%s' intrinsic at %L must not be "
+ gfc_error ("%qs argument of %qs intrinsic at %L must not be "
"present if 'x' is COMPLEX",
gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic,
&y->where);
return false;
}
if (y->ts.type == BT_COMPLEX)
{
- gfc_error ("'%s' argument of '%s' intrinsic at %L must have a type "
+ gfc_error ("%qs argument of %qs intrinsic at %L must have a type "
"of either REAL or INTEGER",
gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic,
&y->where);
return false;
}
@@ -1573,11 +1573,11 @@ gfc_check_co_reduce (gfc_expr *a, gfc_ex
if (sym->result->ts.type == BT_UNKNOWN)
gfc_set_default_type (sym->result, 0, NULL);
if (!gfc_compare_types (&a->ts, &sym->result->ts))
{
- gfc_error ("A argument at %L has type %s but the function passed as "
+ gfc_error_1 ("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));
return false;
}
@@ -1653,20 +1653,20 @@ gfc_check_co_reduce (gfc_expr *a, gfc_ex
if (actual_size
&& ((formal_size1 && actual_size != formal_size1)
|| (formal_size2 && actual_size != formal_size2)))
{
- gfc_error ("The character length of the A argument at %L and of the "
- "arguments of the OPERATOR at %L shall be the same",
+ 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",
&a->where, &op->where);
return false;
}
if (actual_size && result_size && actual_size != result_size)
{
- 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);
+ 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);
return false;
}
}
return true;
@@ -1678,14 +1678,14 @@ gfc_check_co_minmax (gfc_expr *a, gfc_ex
gfc_expr *errmsg)
{
if (a->ts.type != BT_INTEGER && a->ts.type != BT_REAL
&& a->ts.type != BT_CHARACTER)
{
- gfc_error ("'%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_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);
return false;
}
return check_co_collective (a, result_image, stat, errmsg, false);
}
@@ -1773,11 +1773,11 @@ gfc_check_cshift (gfc_expr *array, gfc_e
for (i = 0, j = 0; i < array->rank; i++)
if (i != d - 1)
{
if (!identical_dimen_shape (array, i, shift, j))
{
- gfc_error ("'%s' argument of '%s' intrinsic at %L has "
+ gfc_error ("%qs argument of %qs intrinsic at %L has "
"invalid shape in dimension %d (%ld/%ld)",
gfc_current_intrinsic_arg[1]->name,
gfc_current_intrinsic, &shift->where, i + 1,
mpz_get_si (array->shape[i]),
mpz_get_si (shift->shape[j]));
@@ -1788,11 +1788,11 @@ gfc_check_cshift (gfc_expr *array, gfc_e
}
}
}
else
{
- gfc_error ("'%s' argument of intrinsic '%s' at %L of must have rank "
+ gfc_error ("%qs argument of intrinsic %qs at %L of must have rank "
"%d or be a scalar", gfc_current_intrinsic_arg[1]->name,
gfc_current_intrinsic, &shift->where, array->rank - 1);
return false;
}
@@ -1832,20 +1832,20 @@ gfc_check_dcmplx (gfc_expr *x, gfc_expr
if (!numeric_check (y, 1))
return false;
if (x->ts.type == BT_COMPLEX)
{
- gfc_error ("'%s' argument of '%s' intrinsic at %L must not be "
+ gfc_error ("%qs argument of %qs intrinsic at %L must not be "
"present if 'x' is COMPLEX",
gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic,
&y->where);
return false;
}
if (y->ts.type == BT_COMPLEX)
{
- gfc_error ("'%s' argument of '%s' intrinsic at %L must have a type "
+ gfc_error ("%qs argument of %qs intrinsic at %L must have a type "
"of either REAL or INTEGER",
gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic,
&y->where);
return false;
}
@@ -1891,11 +1891,11 @@ gfc_check_dot_product (gfc_expr *vector_
if (!numeric_check (vector_b, 1))
return false;
break;
default:
- gfc_error ("'%s' argument of '%s' intrinsic at %L must be numeric "
+ gfc_error ("%qs argument of %qs intrinsic at %L must be numeric "
"or LOGICAL", gfc_current_intrinsic_arg[0]->name,
gfc_current_intrinsic, &vector_a->where);
return false;
}
@@ -1905,11 +1905,11 @@ gfc_check_dot_product (gfc_expr *vector_
if (!rank_check (vector_b, 1, 1))
return false;
if (! identical_dimen_shape (vector_a, 0, vector_b, 0))
{
- gfc_error ("Different shape for arguments '%s' and '%s' at %L for "
+ gfc_error ("Different shape for arguments %qs and %qs at %L for "
"intrinsic 'dot_product'", gfc_current_intrinsic_arg[0]->name,
gfc_current_intrinsic_arg[1]->name, &vector_a->where);
return false;
}
@@ -1924,19 +1924,19 @@ gfc_check_dprod (gfc_expr *x, gfc_expr *
|| !type_check (y, 1, BT_REAL))
return false;
if (x->ts.kind != gfc_default_real_kind)
{
- gfc_error ("'%s' argument of '%s' intrinsic at %L must be default "
+ gfc_error ("%qs argument of %qs intrinsic at %L must be default "
"real", gfc_current_intrinsic_arg[0]->name,
gfc_current_intrinsic, &x->where);
return false;
}
if (y->ts.kind != gfc_default_real_kind)
{
- gfc_error ("'%s' argument of '%s' intrinsic at %L must be default "
+ gfc_error ("%qs argument of %qs intrinsic at %L must be default "
"real", gfc_current_intrinsic_arg[1]->name,
gfc_current_intrinsic, &y->where);
return false;
}
@@ -1953,12 +1953,12 @@ gfc_check_dshift (gfc_expr *i, gfc_expr
if (!type_check (j, 1, BT_INTEGER))
return false;
if (i->is_boz && j->is_boz)
{
- gfc_error ("'I' at %L and 'J' at %L cannot both be BOZ literal "
- "constants", &i->where, &j->where);
+ gfc_error_1 ("'I' at %L and 'J' at %L cannot both be BOZ literal "
+ "constants", &i->where, &j->where);
return false;
}
if (!i->is_boz && !j->is_boz && !same_type_check (i, 0, j, 1))
return false;
@@ -2023,11 +2023,11 @@ gfc_check_eoshift (gfc_expr *array, gfc_
for (i = 0, j = 0; i < array->rank; i++)
if (i != d - 1)
{
if (!identical_dimen_shape (array, i, shift, j))
{
- gfc_error ("'%s' argument of '%s' intrinsic at %L has "
+ gfc_error ("%qs argument of %qs intrinsic at %L has "
"invalid shape in dimension %d (%ld/%ld)",
gfc_current_intrinsic_arg[1]->name,
gfc_current_intrinsic, &shift->where, i + 1,
mpz_get_si (array->shape[i]),
mpz_get_si (shift->shape[j]));
@@ -2038,11 +2038,11 @@ gfc_check_eoshift (gfc_expr *array, gfc_
}
}
}
else
{
- gfc_error ("'%s' argument of intrinsic '%s' at %L of must have rank "
+ gfc_error ("%qs argument of intrinsic %qs at %L of must have rank "
"%d or be a scalar", gfc_current_intrinsic_arg[1]->name,
gfc_current_intrinsic, &shift->where, array->rank - 1);
return false;
}
@@ -2066,11 +2066,11 @@ gfc_check_eoshift (gfc_expr *array, gfc_
gfc_current_intrinsic))
return false;
}
else
{
- gfc_error ("'%s' argument of intrinsic '%s' at %L of must have "
+ gfc_error ("%qs argument of intrinsic %qs at %L of must have "
"rank %d or be a scalar",
gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic,
&shift->where, array->rank - 1);
return false;
}
@@ -2367,12 +2367,12 @@ gfc_check_index (gfc_expr *string, gfc_e
gfc_current_intrinsic, &kind->where))
return false;
if (string->ts.kind != substring->ts.kind)
{
- gfc_error ("'%s' argument of '%s' intrinsic at %L must be the same "
- "kind as '%s'", gfc_current_intrinsic_arg[1]->name,
+ gfc_error ("%qs argument of %qs intrinsic at %L must be the same "
+ "kind as %qs", gfc_current_intrinsic_arg[1]->name,
gfc_current_intrinsic, &substring->where,
gfc_current_intrinsic_arg[0]->name);
return false;
}
@@ -2469,13 +2469,13 @@ gfc_check_ishftc (gfc_expr *i, gfc_expr
if (i2 < 0)
i2 = -i2;
if (i2 > i3)
{
- gfc_error ("The absolute value of SHIFT at %L must be less "
- "than or equal to SIZE at %L", &shift->where,
- &size->where);
+ gfc_error_1 ("The absolute value of SHIFT at %L must be less "
+ "than or equal to SIZE at %L", &shift->where,
+ &size->where);
return false;
}
}
}
}
@@ -2530,11 +2530,11 @@ gfc_check_kill_sub (gfc_expr *pid, gfc_e
bool
gfc_check_kind (gfc_expr *x)
{
if (x->ts.type == BT_DERIVED)
{
- gfc_error ("'%s' argument of '%s' intrinsic at %L must be a "
+ gfc_error ("%qs argument of %qs intrinsic at %L must be a "
"non-derived type", gfc_current_intrinsic_arg[0]->name,
gfc_current_intrinsic, &x->where);
return false;
}
@@ -2741,11 +2741,11 @@ min_max_args (gfc_actual_arglist *args)
int i, j, nargs, *nlabels, nlabelless;
bool a1 = false, a2 = false;
if (args == NULL || args->next == NULL)
{
- gfc_error ("Intrinsic '%s' at %L must have at least two arguments",
+ gfc_error ("Intrinsic %qs at %L must have at least two arguments",
gfc_current_intrinsic, gfc_current_intrinsic_where);
return false;
}
if (!args->name)
@@ -2789,11 +2789,11 @@ min_max_args (gfc_actual_arglist *args)
else
nlabelless++;
if (!a1 || !a2)
{
- gfc_error ("Missing '%s' argument to the %s intrinsic at %L",
+ gfc_error ("Missing %qs argument to the %s intrinsic at %L",
!a1 ? "a1" : "a2", gfc_current_intrinsic,
gfc_current_intrinsic_where);
return false;
}
@@ -2804,16 +2804,16 @@ min_max_args (gfc_actual_arglist *args)
goto duplicate;
return true;
duplicate:
- gfc_error ("Duplicate argument '%s' at %L to intrinsic %s", arg->name,
+ gfc_error ("Duplicate argument %qs at %L to intrinsic %s", arg->name,
&arg->expr->where, gfc_current_intrinsic);
return false;
unknown:
- gfc_error ("Unknown argument '%s' at %L to intrinsic %s", arg->name,
+ gfc_error ("Unknown argument %qs at %L to intrinsic %s", arg->name,
&arg->expr->where, gfc_current_intrinsic);
return false;
}
@@ -2838,11 +2838,11 @@ check_rest (bt type, int kind, gfc_actua
"kinds at %L", &x->where))
return false;
}
else
{
- gfc_error ("'a%d' argument of '%s' intrinsic at %L must be "
+ gfc_error ("'a%d' argument of %qs intrinsic at %L must be "
"%s(%d)", n, gfc_current_intrinsic, &x->where,
gfc_basic_typename (type), kind);
return false;
}
}
@@ -2876,11 +2876,11 @@ gfc_check_min_max (gfc_actual_arglist *a
gfc_current_intrinsic, &x->where))
return false;
}
else if (x->ts.type != BT_INTEGER && x->ts.type != BT_REAL)
{
- gfc_error ("'a1' argument of '%s' intrinsic at %L must be INTEGER, "
+ gfc_error ("'a1' argument of %qs intrinsic at %L must be INTEGER, "
"REAL or CHARACTER", gfc_current_intrinsic, &x->where);
return false;
}
return check_rest (x->ts.type, x->ts.kind, arg);
@@ -2926,28 +2926,28 @@ gfc_check_malloc (gfc_expr *size)
bool
gfc_check_matmul (gfc_expr *matrix_a, gfc_expr *matrix_b)
{
if ((matrix_a->ts.type != BT_LOGICAL) && !gfc_numeric_ts (&matrix_a->ts))
{
- gfc_error ("'%s' argument of '%s' intrinsic at %L must be numeric "
+ gfc_error ("%qs argument of %qs intrinsic at %L must be numeric "
"or LOGICAL", gfc_current_intrinsic_arg[0]->name,
gfc_current_intrinsic, &matrix_a->where);
return false;
}
if ((matrix_b->ts.type != BT_LOGICAL) && !gfc_numeric_ts (&matrix_b->ts))
{
- gfc_error ("'%s' argument of '%s' intrinsic at %L must be numeric "
+ gfc_error ("%qs argument of %qs intrinsic at %L must be numeric "
"or LOGICAL", gfc_current_intrinsic_arg[1]->name,
gfc_current_intrinsic, &matrix_b->where);
return false;
}
if ((matrix_a->ts.type == BT_LOGICAL && gfc_numeric_ts (&matrix_b->ts))
|| (gfc_numeric_ts (&matrix_a->ts) && matrix_b->ts.type == BT_LOGICAL))
{
- gfc_error ("Argument types of '%s' intrinsic at %L must match (%s/%s)",
+ gfc_error ("Argument types of %qs intrinsic at %L must match (%s/%s)",
gfc_current_intrinsic, &matrix_a->where,
gfc_typename(&matrix_a->ts), gfc_typename(&matrix_b->ts));
return false;
}
@@ -2957,12 +2957,12 @@ gfc_check_matmul (gfc_expr *matrix_a, gf
if (!rank_check (matrix_b, 1, 2))
return false;
/* Check for case matrix_a has shape(m), matrix_b has shape (m, k). */
if (!identical_dimen_shape (matrix_a, 0, matrix_b, 0))
{
- gfc_error ("Different shape on dimension 1 for arguments '%s' "
- "and '%s' at %L for intrinsic matmul",
+ gfc_error ("Different shape on dimension 1 for arguments %qs "
+ "and %qs at %L for intrinsic matmul",
gfc_current_intrinsic_arg[0]->name,
gfc_current_intrinsic_arg[1]->name, &matrix_a->where);
return false;
}
break;
@@ -2976,20 +2976,20 @@ gfc_check_matmul (gfc_expr *matrix_a, gf
/* matrix_b has rank 1 or 2 here. Common check for the cases
- matrix_a has shape (n,m) and matrix_b has shape (m, k)
- matrix_a has shape (n,m) and matrix_b has shape (m). */
if (!identical_dimen_shape (matrix_a, 1, matrix_b, 0))
{
- gfc_error ("Different shape on dimension 2 for argument '%s' and "
- "dimension 1 for argument '%s' at %L for intrinsic "
+ gfc_error ("Different shape on dimension 2 for argument %qs and "
+ "dimension 1 for argument %qs at %L for intrinsic "
"matmul", gfc_current_intrinsic_arg[0]->name,
gfc_current_intrinsic_arg[1]->name, &matrix_a->where);
return false;
}
break;
default:
- gfc_error ("'%s' argument of '%s' intrinsic at %L must be of rank "
+ gfc_error ("%qs argument of %qs intrinsic at %L must be of rank "
"1 or 2", gfc_current_intrinsic_arg[0]->name,
gfc_current_intrinsic, &matrix_a->where);
return false;
}
@@ -3160,11 +3160,11 @@ gfc_check_mask (gfc_expr *i, gfc_expr *k
bool
gfc_check_transf_bit_intrins (gfc_actual_arglist *ap)
{
if (ap->expr->ts.type != BT_INTEGER)
{
- gfc_error ("'%s' argument of '%s' intrinsic at %L must be INTEGER",
+ gfc_error ("%qs argument of %qs intrinsic at %L must be INTEGER",
gfc_current_intrinsic_arg[0]->name,
gfc_current_intrinsic, &ap->expr->where);
return false;
}
@@ -3335,11 +3335,11 @@ gfc_check_null (gfc_expr *mold)
attr = gfc_variable_attr (mold, NULL);
if (!attr.pointer && !attr.proc_pointer && !attr.allocatable)
{
- gfc_error ("'%s' argument of '%s' intrinsic at %L must be a POINTER, "
+ gfc_error ("%qs argument of %qs intrinsic at %L must be a POINTER, "
"ALLOCATABLE or procedure pointer",
gfc_current_intrinsic_arg[0]->name,
gfc_current_intrinsic, &mold->where);
return false;
}
@@ -3350,11 +3350,11 @@ gfc_check_null (gfc_expr *mold)
return false;
/* F2008, C1242. */
if (gfc_is_coindexed (mold))
{
- gfc_error ("'%s' argument of '%s' intrinsic at %L shall not be "
+ gfc_error ("%qs argument of %qs intrinsic at %L shall not be "
"coindexed", gfc_current_intrinsic_arg[0]->name,
gfc_current_intrinsic, &mold->where);
return false;
}
@@ -3422,13 +3422,13 @@ gfc_check_pack (gfc_expr *array, gfc_exp
else if (mask->expr_type == EXPR_CONSTANT && mask->value.logical)
mask_true_values = mpz_get_si (array_size);
if (mpz_get_si (vector_size) < mask_true_values)
{
- gfc_error ("'%s' argument of '%s' intrinsic at %L must "
+ gfc_error ("%qs argument of %qs intrinsic at %L must "
"provide at least as many elements as there "
- "are .TRUE. values in '%s' (%ld/%d)",
+ "are .TRUE. values in %qs (%ld/%d)",
gfc_current_intrinsic_arg[2]->name,
gfc_current_intrinsic, &vector->where,
gfc_current_intrinsic_arg[1]->name,
mpz_get_si (vector_size), mask_true_values);
return false;
@@ -3480,19 +3480,19 @@ gfc_check_present (gfc_expr *a)
return false;
sym = a->symtree->n.sym;
if (!sym->attr.dummy)
{
- gfc_error ("'%s' argument of '%s' intrinsic at %L must be of a "
+ gfc_error ("%qs argument of %qs intrinsic at %L must be of a "
"dummy variable", gfc_current_intrinsic_arg[0]->name,
gfc_current_intrinsic, &a->where);
return false;
}
if (!sym->attr.optional)
{
- gfc_error ("'%s' argument of '%s' intrinsic at %L must be of "
+ gfc_error ("%qs argument of %qs intrinsic at %L must be of "
"an OPTIONAL dummy variable",
gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic,
&a->where);
return false;
}
@@ -3507,12 +3507,12 @@ gfc_check_present (gfc_expr *a)
&& !(a->ref->next == NULL && a->ref->type == REF_ARRAY
&& (a->ref->u.ar.type == AR_FULL
|| (a->ref->u.ar.type == AR_ELEMENT
&& a->ref->u.ar.as->rank == 0))))
{
- gfc_error ("'%s' argument of '%s' intrinsic at %L must not be a "
- "subobject of '%s'", gfc_current_intrinsic_arg[0]->name,
+ gfc_error ("%qs argument of %qs intrinsic at %L must not be a "
+ "subobject of %qs", gfc_current_intrinsic_arg[0]->name,
gfc_current_intrinsic, &a->where, sym->name);
return false;
}
return true;
@@ -3669,11 +3669,11 @@ gfc_check_reshape (gfc_expr *source, gfc
shape_size = mpz_get_ui (size);
mpz_clear (size);
if (shape_size <= 0)
{
- gfc_error ("'%s' argument of '%s' intrinsic at %L is empty",
+ gfc_error ("%qs argument of %qs intrinsic at %L is empty",
gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic,
&shape->where);
return false;
}
else if (shape_size > GFC_MAX_DIMENSIONS)
@@ -3693,11 +3693,11 @@ gfc_check_reshape (gfc_expr *source, gfc
continue;
gfc_extract_int (e, &extent);
if (extent < 0)
{
- gfc_error ("'%s' argument of '%s' intrinsic at %L has "
+ gfc_error ("%qs argument of %qs intrinsic at %L has "
"negative element (%d)",
gfc_current_intrinsic_arg[1]->name,
gfc_current_intrinsic, &e->where, extent);
return false;
}
@@ -3733,11 +3733,11 @@ gfc_check_reshape (gfc_expr *source, gfc
order_size = mpz_get_ui (size);
mpz_clear (size);
if (order_size != shape_size)
{
- gfc_error ("'%s' argument of '%s' intrinsic at %L "
+ gfc_error ("%qs argument of %qs intrinsic at %L "
"has wrong number of elements (%d/%d)",
gfc_current_intrinsic_arg[3]->name,
gfc_current_intrinsic, &order->where,
order_size, shape_size);
return false;
@@ -3751,20 +3751,20 @@ gfc_check_reshape (gfc_expr *source, gfc
gfc_extract_int (e, &dim);
if (dim < 1 || dim > order_size)
{
- gfc_error ("'%s' argument of '%s' intrinsic at %L "
+ gfc_error ("%qs argument of %qs intrinsic at %L "
"has out-of-range dimension (%d)",
gfc_current_intrinsic_arg[3]->name,
gfc_current_intrinsic, &e->where, dim);
return false;
}
if (perm[dim-1] != 0)
{
- gfc_error ("'%s' argument of '%s' intrinsic at %L has "
+ gfc_error ("%qs argument of %qs intrinsic at %L has "
"invalid permutation of dimensions (dimension "
"'%d' duplicated)",
gfc_current_intrinsic_arg[3]->name,
gfc_current_intrinsic, &e->where, dim);
return false;
@@ -3813,40 +3813,40 @@ gfc_check_reshape (gfc_expr *source, gfc
bool
gfc_check_same_type_as (gfc_expr *a, gfc_expr *b)
{
if (a->ts.type != BT_DERIVED && a->ts.type != BT_CLASS)
{
- gfc_error ("'%s' argument of '%s' intrinsic at %L "
+ gfc_error ("%qs argument of %qs intrinsic at %L "
"cannot be of type %s",
gfc_current_intrinsic_arg[0]->name,
gfc_current_intrinsic,
&a->where, gfc_typename (&a->ts));
return false;
}
if (!(gfc_type_is_extensible (a->ts.u.derived) || UNLIMITED_POLY (a)))
{
- gfc_error ("'%s' argument of '%s' intrinsic at %L "
+ gfc_error ("%qs argument of %qs intrinsic at %L "
"must be of an extensible type",
gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic,
&a->where);
return false;
}
if (b->ts.type != BT_DERIVED && b->ts.type != BT_CLASS)
{
- gfc_error ("'%s' argument of '%s' intrinsic at %L "
+ gfc_error ("%qs argument of %qs intrinsic at %L "
"cannot be of type %s",
gfc_current_intrinsic_arg[0]->name,
gfc_current_intrinsic,
&b->where, gfc_typename (&b->ts));
return false;
}
if (!(gfc_type_is_extensible (b->ts.u.derived) || UNLIMITED_POLY (b)))
{
- gfc_error ("'%s' argument of '%s' intrinsic at %L "
+ gfc_error ("%qs argument of %qs intrinsic at %L "
"must be of an extensible type",
gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic,
&b->where);
return false;
}
@@ -4084,11 +4084,11 @@ gfc_check_size (gfc_expr *array, gfc_exp
bool
gfc_check_sizeof (gfc_expr *arg)
{
if (arg->ts.type == BT_PROCEDURE)
{
- gfc_error ("'%s' argument of '%s' intrinsic at %L shall not be a procedure",
+ gfc_error ("%qs argument of %qs intrinsic at %L shall not be a procedure",
gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic,
&arg->where);
return false;
}
@@ -4097,22 +4097,22 @@ gfc_check_sizeof (gfc_expr *arg)
&& (arg->symtree->n.sym->as == NULL
|| (arg->symtree->n.sym->as->type != AS_ASSUMED_SHAPE
&& arg->symtree->n.sym->as->type != AS_DEFERRED
&& arg->symtree->n.sym->as->type != AS_ASSUMED_RANK)))
{
- gfc_error ("'%s' argument of '%s' intrinsic at %L shall not be TYPE(*)",
+ gfc_error ("%qs argument of %qs intrinsic at %L shall not be TYPE(*)",
gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic,
&arg->where);
return false;
}
if (arg->rank && arg->expr_type == EXPR_VARIABLE
&& arg->symtree->n.sym->as != NULL
&& arg->symtree->n.sym->as->type == AS_ASSUMED_SIZE && arg->ref
&& arg->ref->type == REF_ARRAY && arg->ref->u.ar.type == AR_FULL)
{
- gfc_error ("'%s' argument of '%s' intrinsic at %L shall not be an "
+ gfc_error ("%qs argument of %qs intrinsic at %L shall not be an "
"assumed-size array", gfc_current_intrinsic_arg[0]->name,
gfc_current_intrinsic, &arg->where);
return false;
}
@@ -4227,20 +4227,20 @@ gfc_check_c_sizeof (gfc_expr *arg)
{
const char *msg;
if (!is_c_interoperable (arg, &msg, false, false))
{
- gfc_error ("'%s' argument of '%s' intrinsic at %L must be an "
+ gfc_error ("%qs argument of %qs intrinsic at %L must be an "
"interoperable data entity: %s",
gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic,
&arg->where, msg);
return false;
}
if (arg->ts.type == BT_ASSUMED)
{
- gfc_error ("'%s' argument of '%s' intrinsic at %L shall not be "
+ gfc_error ("%qs argument of %qs intrinsic at %L shall not be "
"TYPE(*)",
gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic,
&arg->where);
return false;
}
@@ -4248,11 +4248,11 @@ gfc_check_c_sizeof (gfc_expr *arg)
if (arg->rank && arg->expr_type == EXPR_VARIABLE
&& arg->symtree->n.sym->as != NULL
&& arg->symtree->n.sym->as->type == AS_ASSUMED_SIZE && arg->ref
&& arg->ref->type == REF_ARRAY && arg->ref->u.ar.type == AR_FULL)
{
- gfc_error ("'%s' argument of '%s' intrinsic at %L shall not be an "
+ gfc_error ("%qs argument of %qs intrinsic at %L shall not be an "
"assumed-size array", gfc_current_intrinsic_arg[0]->name,
gfc_current_intrinsic, &arg->where);
return false;
}
@@ -4447,11 +4447,11 @@ gfc_check_c_funloc (gfc_expr *x)
gfc_namespace *ns = gfc_current_ns;
for (ns = gfc_current_ns; ns; ns = ns->parent)
if (x->symtree->n.sym == ns->proc_name)
{
- gfc_error ("Function result '%s' at %L is invalid as X argument "
+ gfc_error ("Function result %qs at %L is invalid as X argument "
"to C_FUNLOC", x->symtree->n.sym->name, &x->where);
return false;
}
}
@@ -4573,11 +4573,11 @@ gfc_check_sngl (gfc_expr *a)
bool
gfc_check_spread (gfc_expr *source, gfc_expr *dim, gfc_expr *ncopies)
{
if (source->rank >= GFC_MAX_DIMENSIONS)
{
- gfc_error ("'%s' argument of '%s' intrinsic at %L must be less "
+ gfc_error ("%qs argument of %qs intrinsic at %L must be less "
"than rank %d", gfc_current_intrinsic_arg[0]->name,
gfc_current_intrinsic, &source->where, GFC_MAX_DIMENSIONS);
return false;
}
@@ -4592,11 +4592,11 @@ gfc_check_spread (gfc_expr *source, gfc_
if (dim
&& dim->expr_type == EXPR_CONSTANT
&& (mpz_cmp_ui (dim->value.integer, 1) < 0
|| mpz_cmp_ui (dim->value.integer, source->rank + 1) > 0))
{
- gfc_error ("'%s' argument of '%s' intrinsic at %L is not a valid "
+ gfc_error ("%qs argument of %qs intrinsic at %L is not a valid "
"dimension index", gfc_current_intrinsic_arg[1]->name,
gfc_current_intrinsic, &dim->where);
return false;
}
@@ -5187,13 +5187,13 @@ gfc_check_unpack (gfc_expr *vector, gfc_
mask_ctor = gfc_constructor_next (mask_ctor);
}
if (mpz_get_si (vector_size) < mask_true_count)
{
- gfc_error ("'%s' argument of '%s' intrinsic at %L must "
+ gfc_error ("%qs argument of %qs intrinsic at %L must "
"provide at least as many elements as there "
- "are .TRUE. values in '%s' (%ld/%d)",
+ "are .TRUE. values in %qs (%ld/%d)",
gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic,
&vector->where, gfc_current_intrinsic_arg[1]->name,
mpz_get_si (vector_size), mask_true_count);
return false;
}
@@ -5201,12 +5201,12 @@ gfc_check_unpack (gfc_expr *vector, gfc_
mpz_clear (vector_size);
}
if (mask->rank != field->rank && field->rank != 0)
{
- gfc_error ("'%s' argument of '%s' intrinsic at %L must have "
- "the same rank as '%s' or be a scalar",
+ gfc_error ("%qs argument of %qs intrinsic at %L must have "
+ "the same rank as %qs or be a scalar",
gfc_current_intrinsic_arg[2]->name, gfc_current_intrinsic,
&field->where, gfc_current_intrinsic_arg[1]->name);
return false;
}
@@ -5214,11 +5214,11 @@ gfc_check_unpack (gfc_expr *vector, gfc_
{
int i;
for (i = 0; i < field->rank; i++)
if (! identical_dimen_shape (mask, i, field, i))
{
- gfc_error ("'%s' and '%s' arguments of '%s' intrinsic at %L "
+ gfc_error ("%qs and %qs arguments of %qs intrinsic at %L "
"must have identical shape.",
gfc_current_intrinsic_arg[2]->name,
gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic,
&field->where);
}
@@ -5472,11 +5472,11 @@ gfc_check_random_seed (gfc_expr *size, g
if (!kind_value_check (put, 1, gfc_default_integer_kind))
return false;
if (gfc_array_size (put, &put_size)
&& mpz_get_ui (put_size) < kiss_size)
- gfc_error ("Size of '%s' argument of '%s' intrinsic at %L "
+ gfc_error ("Size of %qs argument of %qs intrinsic at %L "
"too small (%i/%i)",
gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic,
where, (int) mpz_get_ui (put_size), kiss_size);
}
@@ -5504,11 +5504,11 @@ gfc_check_random_seed (gfc_expr *size, g
if (!kind_value_check (get, 2, gfc_default_integer_kind))
return false;
if (gfc_array_size (get, &get_size)
&& mpz_get_ui (get_size) < kiss_size)
- gfc_error ("Size of '%s' argument of '%s' intrinsic at %L "
+ gfc_error ("Size of %qs argument of %qs intrinsic at %L "
"too small (%i/%i)",
gfc_current_intrinsic_arg[2]->name, gfc_current_intrinsic,
where, (int) mpz_get_ui (get_size), kiss_size);
}
@@ -5815,11 +5815,11 @@ gfc_check_getarg (gfc_expr *pos, gfc_exp
if (!type_check (pos, 0, BT_INTEGER))
return false;
if (pos->ts.kind > gfc_default_integer_kind)
{
- gfc_error ("'%s' argument of '%s' intrinsic at %L must be of a kind "
+ gfc_error ("%qs argument of %qs intrinsic at %L must be of a kind "
"not wider than the default kind (%d)",
gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic,
&pos->where, gfc_default_integer_kind);
return false;
}
@@ -6167,27 +6167,27 @@ gfc_check_system_sub (gfc_expr *cmd, gfc
bool
gfc_check_and (gfc_expr *i, gfc_expr *j)
{
if (i->ts.type != BT_INTEGER && i->ts.type != BT_LOGICAL)
{
- gfc_error ("'%s' argument of '%s' intrinsic at %L must be INTEGER "
+ gfc_error ("%qs argument of %qs intrinsic at %L must be INTEGER "
"or LOGICAL", gfc_current_intrinsic_arg[0]->name,
gfc_current_intrinsic, &i->where);
return false;
}
if (j->ts.type != BT_INTEGER && j->ts.type != BT_LOGICAL)
{
- gfc_error ("'%s' argument of '%s' intrinsic at %L must be INTEGER "
+ gfc_error ("%qs argument of %qs intrinsic at %L must be INTEGER "
"or LOGICAL", gfc_current_intrinsic_arg[1]->name,
gfc_current_intrinsic, &j->where);
return false;
}
if (i->ts.type != j->ts.type)
{
- gfc_error ("'%s' and '%s' arguments of '%s' intrinsic at %L must "
+ gfc_error ("%qs and %qs arguments of %qs intrinsic at %L must "
"have the same type", gfc_current_intrinsic_arg[0]->name,
gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic,
&j->where);
return false;
}
@@ -6205,19 +6205,19 @@ gfc_check_and (gfc_expr *i, gfc_expr *j)
bool
gfc_check_storage_size (gfc_expr *a, gfc_expr *kind)
{
if (a->ts.type == BT_ASSUMED)
{
- gfc_error ("'%s' argument of '%s' intrinsic at %L shall not be TYPE(*)",
+ gfc_error ("%qs argument of %qs intrinsic at %L shall not be TYPE(*)",
gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic,
&a->where);
return false;
}
if (a->ts.type == BT_PROCEDURE)
{
- gfc_error ("'%s' argument of '%s' intrinsic at %L shall not be a "
+ gfc_error ("%qs argument of %qs intrinsic at %L shall not be a "
"procedure", gfc_current_intrinsic_arg[0]->name,
gfc_current_intrinsic, &a->where);
return false;
}
@@ -6230,11 +6230,11 @@ gfc_check_storage_size (gfc_expr *a, gfc
if (!scalar_check (kind, 1))
return false;
if (kind->expr_type != EXPR_CONSTANT)
{
- gfc_error ("'%s' argument of '%s' intrinsic at %L must be a constant",
+ gfc_error ("%qs argument of %qs intrinsic at %L must be a constant",
gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic,
&kind->where);
return false;
}
Index: gcc/fortran/primary.c
===================================================================
--- gcc/fortran/primary.c (revision 218457)
+++ gcc/fortran/primary.c (working copy)
@@ -1272,11 +1272,12 @@ match_complex_part (gfc_expr **result)
static match
match_complex_constant (gfc_expr **result)
{
gfc_expr *e, *real, *imag;
- gfc_error_buf old_error;
+ gfc_error_buf old_error_1;
+ output_buffer old_error;
gfc_typespec target;
locus old_loc;
int kind;
match m;
@@ -1285,22 +1286,22 @@ match_complex_constant (gfc_expr **resul
m = gfc_match_char ('(');
if (m != MATCH_YES)
return m;
- gfc_push_error (&old_error);
+ gfc_push_error (&old_error, &old_error_1);
m = match_complex_part (&real);
if (m == MATCH_NO)
{
- gfc_free_error (&old_error);
+ gfc_free_error (&old_error, &old_error_1);
goto cleanup;
}
if (gfc_match_char (',') == MATCH_NO)
{
- gfc_pop_error (&old_error);
+ gfc_pop_error (&old_error, &old_error_1);
m = MATCH_NO;
goto cleanup;
}
/* If m is error, then something was wrong with the real part and we
@@ -1308,14 +1309,14 @@ match_complex_constant (gfc_expr **resul
ambiguous case here is the start of an iterator list of some
sort. These sort of lists are matched prior to coming here. */
if (m == MATCH_ERROR)
{
- gfc_free_error (&old_error);
+ gfc_free_error (&old_error, &old_error_1);
goto cleanup;
}
- gfc_pop_error (&old_error);
+ gfc_pop_error (&old_error, &old_error_1);
m = match_complex_part (&imag);
if (m == MATCH_NO)
goto syntax;
if (m == MATCH_ERROR)
@@ -2491,11 +2492,11 @@ gfc_convert_to_structure_constructor (gf
comp_iter = comp_iter->next)
{
gcc_assert (comp_iter);
if (!strcmp (comp_iter->name, comp_tail->name))
{
- gfc_error ("Component '%s' is initialized twice in the structure"
+ gfc_error ("Component %qs is initialized twice in the structure"
" constructor at %L!", comp_tail->name,
comp_tail->val ? &comp_tail->where
: &gfc_current_locus);
goto cleanup;
}
^ permalink raw reply [flat|nested] 3+ messages in thread
* Re: [PATCH fortran/diagnostics] Move gfc_error (buffered) to common diagnostics (try 2)
2014-12-10 22:59 [PATCH fortran/diagnostics] Move gfc_error (buffered) to common diagnostics (try 2) Manuel López-Ibáñez
@ 2014-12-11 8:09 ` Dodji Seketeli
2014-12-11 8:30 ` Tobias Burnus
0 siblings, 1 reply; 3+ messages in thread
From: Dodji Seketeli @ 2014-12-11 8:09 UTC (permalink / raw)
To: Manuel López-Ibáñez
Cc: Tobias Burnus, Gcc Patch List, fortran@gcc.gnu.org List
Manuel López-Ibáñez <lopezibanez@gmail.com> writes:
> New version using XNEW. Bootstrapped & tested on x86_64-linux-gnu.
>
> OK?
The diagnostics infrastructure changes are OK for me. Thanks!
Cheers,
--
Dodji
^ permalink raw reply [flat|nested] 3+ messages in thread
* Re: [PATCH fortran/diagnostics] Move gfc_error (buffered) to common diagnostics (try 2)
2014-12-11 8:09 ` Dodji Seketeli
@ 2014-12-11 8:30 ` Tobias Burnus
0 siblings, 0 replies; 3+ messages in thread
From: Tobias Burnus @ 2014-12-11 8:30 UTC (permalink / raw)
To: Dodji Seketeli, Manuel López-Ibáñez
Cc: Gcc Patch List, fortran@gcc.gnu.org List
Dodji Seketeli wrote:
> Manuel López-Ibáñez <lopezibanez@gmail.com> writes:
>> New version using XNEW. Bootstrapped & tested on x86_64-linux-gnu.
>> OK?
> The diagnostics infrastructure changes are OK for me. Thanks!
And the Fortran part was already approved before. (Otherwise, take this
as another rubber stamp.)
Thanks also from my side!
BTW: The terminal-width patch was committed as Rev. 218619.
Tobias
^ permalink raw reply [flat|nested] 3+ messages in thread
end of thread, other threads:[~2014-12-11 8:30 UTC | newest]
Thread overview: 3+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2014-12-10 22:59 [PATCH fortran/diagnostics] Move gfc_error (buffered) to common diagnostics (try 2) Manuel López-Ibáñez
2014-12-11 8:09 ` Dodji Seketeli
2014-12-11 8:30 ` Tobias Burnus
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).