2014-12-08 Tobias Burnus <burnus@net-b.de>
Manuel López-Ibáñez <manu@gcc.gnu.org>
fortran/
* error.c (gfc_error): Add variant which takes a va_list.
(gfc_notify_std): Convert to common diagnostic.
* array.c: Use %qs, %<...%> in more gfc_error calls and
for gfc_notify_std.
* check.c: Ditto.
* data.c: Ditto.
* decl.c: Ditto.
* expr.c: Ditto.
* interface.c: Ditto.
* intrinsic.c: Ditto.
* io.c: Ditto.
* match.c: Ditto.
* matchexp.c: Ditto.
* module.c: Ditto.
* openmp.c: Ditto.
* parse.c: Ditto.
* primary.c: Ditto.
* resolve.c: Ditto.
* simplify.c: Ditto.
* symbol.c: Ditto.
* trans-common.c: Ditto.
* trans-intrinsic.c: Ditto.
gcc/testsuite/
* gfortran.dg/realloc_on_assign_21.f90: Update dg-error.
* gfortran.dg/warnings_are_errors_1.f: Ditto.
* gfortran.dg/warnings_are_errors_1.f90: Ditto.
@@ -684,7 +684,7 @@ coarray:
if (current_type == AS_EXPLICIT)
{
- gfc_error ("Upper bound of last coarray dimension must be '*' at %C");
+ gfc_error ("Upper bound of last coarray dimension must be %<*%> at %C");
goto cleanup;
}
@@ -384,7 +384,7 @@ less_than_bitsize2 (const char *arg1, gfc_expr *expr1, const char *arg2,
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 "
+ gfc_error ("%<%s + %s%> at %L must be less than or equal "
"to BIT_SIZE(%qs)",
arg2, arg3, &expr2->where, arg1);
return false;
@@ -581,7 +581,7 @@ dim_corank_check (gfc_expr *dim, gfc_expr *array)
if (mpz_cmp_ui (dim->value.integer, 1) < 0
|| mpz_cmp_ui (dim->value.integer, corank) > 0)
{
- gfc_error ("'dim' argument of %qs 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;
@@ -631,7 +631,7 @@ dim_rank_check (gfc_expr *dim, gfc_expr *array, int allow_assumed)
if (mpz_cmp_ui (dim->value.integer, 1) < 0
|| mpz_cmp_ui (dim->value.integer, rank) > 0)
{
- gfc_error ("'dim' argument of %qs 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;
@@ -1378,7 +1378,7 @@ gfc_check_cmplx (gfc_expr *x, gfc_expr *y, gfc_expr *kind)
if (x->ts.type == BT_COMPLEX)
{
gfc_error ("%qs argument of %qs intrinsic at %L must not be "
- "present if 'x' is COMPLEX",
+ "present if %<x%> is COMPLEX",
gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic,
&y->where);
return false;
@@ -1428,7 +1428,7 @@ check_co_collective (gfc_expr *a, gfc_expr *image_idx, gfc_expr *stat,
/* Fortran 2008, 12.5.2.4, paragraph 18. */
if (gfc_has_vector_subscript (a))
{
- gfc_error ("Argument 'A' with INTENT(INOUT) at %L of the intrinsic "
+ gfc_error ("Argument %<A%> with INTENT(INOUT) at %L of the intrinsic "
"subroutine %s shall not have a vector subscript",
&a->where, gfc_current_intrinsic);
return false;
@@ -1728,7 +1728,7 @@ gfc_check_count (gfc_expr *mask, gfc_expr *dim, gfc_expr *kind)
return false;
if (!kind_check (kind, 2, BT_INTEGER))
return false;
- if (kind && !gfc_notify_std (GFC_STD_F2003, "'%s' intrinsic "
+ if (kind && !gfc_notify_std (GFC_STD_F2003, "%qs intrinsic "
"with KIND argument at %L",
gfc_current_intrinsic, &kind->where))
return false;
@@ -1835,7 +1835,7 @@ gfc_check_dcmplx (gfc_expr *x, gfc_expr *y)
if (x->ts.type == BT_COMPLEX)
{
gfc_error ("%qs argument of %qs intrinsic at %L must not be "
- "present if 'x' is COMPLEX",
+ "present if %<x%> is COMPLEX",
gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic,
&y->where);
return false;
@@ -1908,7 +1908,8 @@ gfc_check_dot_product (gfc_expr *vector_a, gfc_expr *vector_b)
if (! identical_dimen_shape (vector_a, 0, vector_b, 0))
{
gfc_error ("Different shape for arguments %qs and %qs at %L for "
- "intrinsic 'dot_product'", gfc_current_intrinsic_arg[0]->name,
+ "intrinsic %<dot_product%>",
+ gfc_current_intrinsic_arg[0]->name,
gfc_current_intrinsic_arg[1]->name, &vector_a->where);
return false;
}
@@ -2146,9 +2147,9 @@ gfc_check_fn_rc2008 (gfc_expr *a)
return false;
if (a->ts.type == BT_COMPLEX
- && !gfc_notify_std (GFC_STD_F2008, "COMPLEX argument '%s' "
- "of '%s' intrinsic at %L",
- gfc_current_intrinsic_arg[0]->name,
+ && !gfc_notify_std (GFC_STD_F2008, "COMPLEX argument %qs "
+ "of %qs intrinsic at %L",
+ gfc_current_intrinsic_arg[0]->name,
gfc_current_intrinsic, &a->where))
return false;
@@ -2259,7 +2260,7 @@ gfc_check_ichar_iachar (gfc_expr *c, gfc_expr *kind)
if (!kind_check (kind, 1, BT_INTEGER))
return false;
- if (kind && !gfc_notify_std (GFC_STD_F2003, "'%s' intrinsic "
+ if (kind && !gfc_notify_std (GFC_STD_F2003, "%qs intrinsic "
"with KIND argument at %L",
gfc_current_intrinsic, &kind->where))
return false;
@@ -2362,7 +2363,7 @@ gfc_check_index (gfc_expr *string, gfc_expr *substring, gfc_expr *back,
if (!kind_check (kind, 3, BT_INTEGER))
return false;
- if (kind && !gfc_notify_std (GFC_STD_F2003, "'%s' intrinsic "
+ if (kind && !gfc_notify_std (GFC_STD_F2003, "%qs intrinsic "
"with KIND argument at %L",
gfc_current_intrinsic, &kind->where))
return false;
@@ -2556,7 +2557,7 @@ gfc_check_lbound (gfc_expr *array, gfc_expr *dim, gfc_expr *kind)
if (!kind_check (kind, 2, BT_INTEGER))
return false;
- if (kind && !gfc_notify_std (GFC_STD_F2003, "'%s' intrinsic "
+ if (kind && !gfc_notify_std (GFC_STD_F2003, "%qs intrinsic "
"with KIND argument at %L",
gfc_current_intrinsic, &kind->where))
return false;
@@ -2601,7 +2602,7 @@ gfc_check_len_lentrim (gfc_expr *s, gfc_expr *kind)
if (!kind_check (kind, 1, BT_INTEGER))
return false;
- if (kind && !gfc_notify_std (GFC_STD_F2003, "'%s' intrinsic "
+ if (kind && !gfc_notify_std (GFC_STD_F2003, "%qs intrinsic "
"with KIND argument at %L",
gfc_current_intrinsic, &kind->where))
return false;
@@ -2840,7 +2841,7 @@ check_rest (bt type, int kind, gfc_actual_arglist *arglist)
}
else
{
- gfc_error ("'a%d' argument of %qs 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;
@@ -2848,9 +2849,9 @@ check_rest (bt type, int kind, gfc_actual_arglist *arglist)
}
for (tmp = arglist, m=1; tmp != arg; tmp = tmp->next, m++)
- if (!gfc_check_conformance (tmp->expr, x,
+ if (!gfc_check_conformance (tmp->expr, x,
"arguments 'a%d' and 'a%d' for "
- "intrinsic '%s'", m, n,
+ "intrinsic '%s'", m, n,
gfc_current_intrinsic))
return false;
}
@@ -2871,14 +2872,14 @@ gfc_check_min_max (gfc_actual_arglist *arg)
if (x->ts.type == BT_CHARACTER)
{
- if (!gfc_notify_std (GFC_STD_F2003, "'%s' intrinsic "
+ if (!gfc_notify_std (GFC_STD_F2003, "%qs intrinsic "
"with CHARACTER argument at %L",
gfc_current_intrinsic, &x->where))
return false;
}
else if (x->ts.type != BT_INTEGER && x->ts.type != BT_REAL)
{
- gfc_error ("'a1' argument of %qs 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;
}
@@ -3287,7 +3288,7 @@ gfc_check_nearest (gfc_expr *x, gfc_expr *s)
{
if (mpfr_sgn (s->value.real) == 0)
{
- gfc_error ("Argument 'S' of NEAREST at %L shall not be zero",
+ gfc_error ("Argument %<S%> of NEAREST at %L shall not be zero",
&s->where);
return false;
}
@@ -3661,7 +3662,7 @@ gfc_check_reshape (gfc_expr *source, gfc_expr *shape,
if (!gfc_array_size (shape, &size))
{
- gfc_error ("'shape' argument of 'reshape' intrinsic at %L must be an "
+ gfc_error ("%<shape%> argument of %<reshape%> intrinsic at %L must be an "
"array of constant size", &shape->where);
return false;
}
@@ -3678,7 +3679,7 @@ gfc_check_reshape (gfc_expr *source, gfc_expr *shape,
}
else if (shape_size > GFC_MAX_DIMENSIONS)
{
- gfc_error ("'shape' argument of 'reshape' intrinsic at %L has more "
+ gfc_error ("%<shape%> argument of %<reshape%> intrinsic at %L has more "
"than %d elements", &shape->where, GFC_MAX_DIMENSIONS);
return false;
}
@@ -3764,7 +3765,7 @@ gfc_check_reshape (gfc_expr *source, gfc_expr *shape,
{
gfc_error ("%qs argument of %qs intrinsic at %L has "
"invalid permutation of dimensions (dimension "
- "'%d' duplicated)",
+ "%<%d%> duplicated)",
gfc_current_intrinsic_arg[3]->name,
gfc_current_intrinsic, &e->where, dim);
return false;
@@ -3882,7 +3883,7 @@ gfc_check_scan (gfc_expr *x, gfc_expr *y, gfc_expr *z, gfc_expr *kind)
if (!kind_check (kind, 3, BT_INTEGER))
return false;
- if (kind && !gfc_notify_std (GFC_STD_F2003, "'%s' intrinsic "
+ if (kind && !gfc_notify_std (GFC_STD_F2003, "%qs intrinsic "
"with KIND argument at %L",
gfc_current_intrinsic, &kind->where))
return false;
@@ -3944,7 +3945,7 @@ gfc_check_selected_real_kind (gfc_expr *p, gfc_expr *r, gfc_expr *radix)
{
if (p == NULL && r == NULL
&& !gfc_notify_std (GFC_STD_F2008, "SELECTED_REAL_KIND with"
- " neither 'P' nor 'R' argument at %L",
+ " neither %<P%> nor %<R%> argument at %L",
gfc_current_intrinsic_where))
return false;
@@ -3974,7 +3975,7 @@ gfc_check_selected_real_kind (gfc_expr *p, gfc_expr *r, gfc_expr *radix)
if (!scalar_check (radix, 1))
return false;
- if (!gfc_notify_std (GFC_STD_F2008, "'%s' intrinsic with "
+ if (!gfc_notify_std (GFC_STD_F2008, "%qs intrinsic with "
"RADIX argument at %L", gfc_current_intrinsic,
&radix->where))
return false;
@@ -4009,14 +4010,14 @@ gfc_check_shape (gfc_expr *source, gfc_expr *kind)
if (ar->as && ar->as->type == AS_ASSUMED_SIZE && ar->type == AR_FULL)
{
- gfc_error ("'source' argument of 'shape' intrinsic at %L must not be "
+ gfc_error ("%<source%> argument of %<shape%> intrinsic at %L must not be "
"an assumed size array", &source->where);
return false;
}
if (!kind_check (kind, 1, BT_INTEGER))
return false;
- if (kind && !gfc_notify_std (GFC_STD_F2003, "'%s' intrinsic "
+ if (kind && !gfc_notify_std (GFC_STD_F2003, "%qs intrinsic "
"with KIND argument at %L",
gfc_current_intrinsic, &kind->where))
return false;
@@ -4071,7 +4072,7 @@ gfc_check_size (gfc_expr *array, gfc_expr *dim, gfc_expr *kind)
if (!kind_check (kind, 2, BT_INTEGER))
return false;
- if (kind && !gfc_notify_std (GFC_STD_F2003, "'%s' intrinsic "
+ if (kind && !gfc_notify_std (GFC_STD_F2003, "%qs intrinsic "
"with KIND argument at %L",
gfc_current_intrinsic, &kind->where))
return false;
@@ -5053,8 +5054,8 @@ gfc_check_transfer (gfc_expr *source, gfc_expr *mold, gfc_expr *size)
if (mold->ts.type == BT_HOLLERITH)
{
- gfc_error ("'MOLD' argument of 'TRANSFER' intrinsic at %L must not be %s",
- &mold->where, gfc_basic_typename (BT_HOLLERITH));
+ gfc_error ("%<MOLD%> argument of %<TRANSFER%> intrinsic at %L must not be"
+ " %s", &mold->where, gfc_basic_typename (BT_HOLLERITH));
return false;
}
@@ -5113,7 +5114,7 @@ gfc_check_ubound (gfc_expr *array, gfc_expr *dim, gfc_expr *kind)
if (!kind_check (kind, 2, BT_INTEGER))
return false;
- if (kind && !gfc_notify_std (GFC_STD_F2003, "'%s' intrinsic "
+ if (kind && !gfc_notify_std (GFC_STD_F2003, "%qs intrinsic "
"with KIND argument at %L",
gfc_current_intrinsic, &kind->where))
return false;
@@ -5242,7 +5243,7 @@ gfc_check_verify (gfc_expr *x, gfc_expr *y, gfc_expr *z, gfc_expr *kind)
if (!kind_check (kind, 3, BT_INTEGER))
return false;
- if (kind && !gfc_notify_std (GFC_STD_F2003, "'%s' intrinsic "
+ if (kind && !gfc_notify_std (GFC_STD_F2003, "%qs intrinsic "
"with KIND argument at %L",
gfc_current_intrinsic, &kind->where))
return false;
@@ -324,7 +324,7 @@ gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index,
> LOCATION_LINE (rvalue->where.lb->location))
? con->expr : rvalue;
if (gfc_notify_std (GFC_STD_GNU,
- "re-initialization of '%s' at %L",
+ "re-initialization of %qs at %L",
symbol->name, &exprd->where) == false)
return false;
}
@@ -490,7 +490,7 @@ gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index,
> LOCATION_LINE (rvalue->where.lb->location))
? init : rvalue;
if (gfc_notify_std (GFC_STD_GNU,
- "re-initialization of '%s' at %L",
+ "re-initialization of %qs at %L",
symbol->name, &expr->where) == false)
return false;
}
@@ -269,7 +269,7 @@ var_element (gfc_data_variable *new_var)
if (gfc_current_state () != COMP_BLOCK_DATA
&& sym->attr.in_common
&& !gfc_notify_std (GFC_STD_GNU, "initialization of "
- "common block variable '%s' in DATA statement at %C",
+ "common block variable %qs in DATA statement at %C",
sym->name))
return MATCH_ERROR;
@@ -1059,16 +1059,16 @@ gfc_verify_c_interop_param (gfc_symbol *sym)
not have the allocatable, pointer, or optional attributes,
according to J3/04-007, section 5.1. */
if (sym->attr.allocatable == 1
- && !gfc_notify_std (GFC_STD_F2008_TS, "Variable '%s' at %L with "
- "ALLOCATABLE attribute in procedure '%s' "
+ && !gfc_notify_std (GFC_STD_F2008_TS, "Variable %qs at %L with "
+ "ALLOCATABLE attribute in procedure %qs "
"with BIND(C)", sym->name,
&(sym->declared_at),
sym->ns->proc_name->name))
retval = false;
if (sym->attr.pointer == 1
- && !gfc_notify_std (GFC_STD_F2008_TS, "Variable '%s' at %L with "
- "POINTER attribute in procedure '%s' "
+ && !gfc_notify_std (GFC_STD_F2008_TS, "Variable %qs at %L with "
+ "POINTER attribute in procedure %qs "
"with BIND(C)", sym->name,
&(sym->declared_at),
sym->ns->proc_name->name))
@@ -1092,9 +1092,9 @@ gfc_verify_c_interop_param (gfc_symbol *sym)
retval = false;
}
else if (sym->attr.optional == 1
- && !gfc_notify_std (GFC_STD_F2008_TS, "Variable '%s' "
+ && !gfc_notify_std (GFC_STD_F2008_TS, "Variable %qs "
"at %L with OPTIONAL attribute in "
- "procedure '%s' which is BIND(C)",
+ "procedure %qs which is BIND(C)",
sym->name, &(sym->declared_at),
sym->ns->proc_name->name))
retval = false;
@@ -1103,7 +1103,7 @@ gfc_verify_c_interop_param (gfc_symbol *sym)
either assumed size or explicit shape. Deferred shape is already
covered by the pointer/allocatable attribute. */
if (sym->as != NULL && sym->as->type == AS_ASSUMED_SHAPE
- && !gfc_notify_std (GFC_STD_F2008_TS, "Assumed-shape array '%s' "
+ && !gfc_notify_std_1 (GFC_STD_F2008_TS, "Assumed-shape array '%s' "
"at %L as dummy argument to the BIND(C) "
"procedure '%s' at %L", sym->name,
&(sym->declared_at),
@@ -2031,8 +2031,8 @@ variable_decl (int elem)
{
if (current_attr.pointer)
{
- gfc_error ("Pointer initialization at %C requires '=>', "
- "not '='");
+ gfc_error ("Pointer initialization at %C requires %<=>%>, "
+ "not %<=%>");
m = MATCH_ERROR;
goto cleanup;
}
@@ -5096,7 +5096,7 @@ match_ppc_decl (void)
/* Match the colons (required). */
if (gfc_match (" ::") != MATCH_YES)
{
- gfc_error ("Expected '::' after binding-attributes at %C");
+ gfc_error ("Expected %<::%> after binding-attributes at %C");
return MATCH_ERROR;
}
@@ -6565,7 +6565,7 @@ cray_pointer_decl (void)
{
if (gfc_match_char ('(') != MATCH_YES)
{
- gfc_error ("Expected '(' at %C");
+ gfc_error ("Expected %<(%> at %C");
return MATCH_ERROR;
}
@@ -6680,7 +6680,7 @@ cray_pointer_decl (void)
if (m == MATCH_ERROR /* Failed when trying to find ',' above. */
|| gfc_match_eos () != MATCH_YES)
{
- gfc_error ("Expected \",\" or end of statement at %C");
+ gfc_error ("Expected %<,%> or end of statement at %C");
return MATCH_ERROR;
}
return MATCH_YES;
@@ -8272,13 +8272,13 @@ match_procedure_in_type (void)
return m;
if (m != MATCH_YES)
{
- gfc_error ("Interface-name expected after '(' at %C");
+ gfc_error ("Interface-name expected after %<(%> at %C");
return MATCH_ERROR;
}
if (gfc_match (" )") != MATCH_YES)
{
- gfc_error ("')' expected at %C");
+ gfc_error ("%<)%> expected at %C");
return MATCH_ERROR;
}
@@ -8314,7 +8314,7 @@ match_procedure_in_type (void)
seen_colons = (m == MATCH_YES);
if (seen_attrs && !seen_colons)
{
- gfc_error ("Expected '::' after binding-attributes at %C");
+ gfc_error ("Expected %<::%> after binding-attributes at %C");
return MATCH_ERROR;
}
@@ -8342,13 +8342,13 @@ match_procedure_in_type (void)
{
if (tb.deferred)
{
- gfc_error ("'=> target' is invalid for DEFERRED binding at %C");
+ gfc_error ("%<=> target%> is invalid for DEFERRED binding at %C");
return MATCH_ERROR;
}
if (!seen_colons)
{
- gfc_error ("'::' needed in PROCEDURE binding with explicit target"
+ gfc_error ("%<::%> needed in PROCEDURE binding with explicit target"
" at %C");
return MATCH_ERROR;
}
@@ -8358,7 +8358,7 @@ match_procedure_in_type (void)
return m;
if (m == MATCH_NO)
{
- gfc_error ("Expected binding target after '=>' at %C");
+ gfc_error ("Expected binding target after %<=>%> at %C");
return MATCH_ERROR;
}
target = target_buf;
@@ -8455,7 +8455,7 @@ gfc_match_generic (void)
/* Now the colons, those are required. */
if (gfc_match (" ::") != MATCH_YES)
{
- gfc_error ("Expected '::' at %C");
+ gfc_error ("Expected %<::%> at %C");
goto error;
}
@@ -8493,7 +8493,7 @@ gfc_match_generic (void)
/* Match the required =>. */
if (gfc_match (" =>") != MATCH_YES)
{
- gfc_error ("Expected '=>' at %C");
+ gfc_error ("Expected %<=>%> at %C");
goto error;
}
@@ -8705,7 +8705,7 @@ gfc_match_final_decl (void)
last = true;
if (!last && gfc_match_char (',') != MATCH_YES)
{
- gfc_error ("Expected ',' at %C");
+ gfc_error ("Expected %<,%> at %C");
return MATCH_ERROR;
}
@@ -59,6 +59,12 @@ static int warningcount_buffered, werrorcount_buffered;
#include <new> /* For placement-new */
+static void
+gfc_error (const char *gmsgid, va_list ap) ATTRIBUTE_GCC_GFC(1,0);
+
+static bool
+gfc_warning (int opt, const char *gmsgid, va_list ap) ATTRIBUTE_GCC_GFC(2,0);
+
/* Return true if there output_buffer is empty. */
@@ -870,9 +876,6 @@ gfc_warning_1 (const char *gmsgid, ...)
gfc_warning. */
static bool
-gfc_warning (int opt, const char *gmsgid, va_list ap) ATTRIBUTE_GCC_GFC(2,0);
-
-static bool
gfc_warning (int opt, const char *gmsgid, va_list ap)
{
va_list argp;
@@ -969,7 +972,7 @@ gfc_notification_std (int std)
an error is generated. */
bool
-gfc_notify_std (int std, const char *gmsgid, ...)
+gfc_notify_std_1 (int std, const char *gmsgid, ...)
{
va_list argp;
bool warning;
@@ -1046,6 +1049,68 @@ gfc_notify_std (int std, const char *gmsgid, ...)
}
+bool
+gfc_notify_std (int std, const char *gmsgid, ...)
+{
+ va_list argp;
+ bool warning;
+ const char *msg, *msg2;
+ char *buffer;
+
+ warning = ((gfc_option.warn_std & std) != 0) && !inhibit_warnings;
+ if ((gfc_option.allow_std & std) != 0 && !warning)
+ return true;
+
+ if (suppress_errors)
+ return warning ? true : false;
+
+ switch (std)
+ {
+ case GFC_STD_F2008_TS:
+ msg = "TS 29113/TS 18508:";
+ break;
+ case GFC_STD_F2008_OBS:
+ msg = _("Fortran 2008 obsolescent feature:");
+ break;
+ case GFC_STD_F2008:
+ msg = "Fortran 2008:";
+ break;
+ case GFC_STD_F2003:
+ msg = "Fortran 2003:";
+ break;
+ case GFC_STD_GNU:
+ msg = _("GNU Extension:");
+ break;
+ case GFC_STD_LEGACY:
+ msg = _("Legacy Extension:");
+ break;
+ case GFC_STD_F95_OBS:
+ msg = _("Obsolescent feature:");
+ break;
+ case GFC_STD_F95_DEL:
+ msg = _("Deleted feature:");
+ break;
+ default:
+ gcc_unreachable ();
+ }
+
+ msg2 = _(gmsgid);
+ buffer = (char *) alloca (strlen (msg) + strlen (msg2) + 2);
+ strcpy (buffer, msg);
+ strcat (buffer, " ");
+ strcat (buffer, msg2);
+
+ va_start (argp, gmsgid);
+ if (warning)
+ gfc_warning (0, buffer, argp);
+ else
+ gfc_error (buffer, argp);
+ va_end (argp);
+
+ return (warning && !warnings_are_errors) ? true : false;
+}
+
+
/* Immediate warning (i.e. do not buffer the warning). */
/* Use gfc_warning_now instead, unless two locations are used in the same
warning or for scanner.c, if the location is not properly set up. */
@@ -1379,11 +1444,11 @@ warning:
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, ...)
+static void
+gfc_error (const char *gmsgid, va_list ap)
{
va_list argp;
- va_start (argp, gmsgid);
+ va_copy (argp, ap);
if (warnings_not_errors)
{
@@ -1410,8 +1475,8 @@ gfc_error (const char *gmsgid, ...)
pp->buffer = &pp_error_buffer;
global_dc->fatal_errors = false;
/* To prevent -fmax-errors= triggering, we decrease it before
- report_diagnostic increases it. */
- --errorcount;
+ report_diagnostic increases it. */
+ --errorcount;
}
diagnostic_set_info (&diagnostic, gmsgid, &argp, UNKNOWN_LOCATION, DK_ERROR);
@@ -1422,11 +1487,20 @@ gfc_error (const char *gmsgid, ...)
pp->buffer = tmp_buffer;
global_dc->fatal_errors = fatal_errors;
}
-
+
va_end (argp);
}
+void
+gfc_error (const char *gmsgid, ...)
+{
+ va_list argp;
+ va_start (argp, gmsgid);
+ gfc_error (gmsgid, argp);
+ va_end (argp);
+}
+
/* Immediate error. */
/* Use gfc_error_now instead, unless two locations are used in the same
@@ -145,7 +145,8 @@ gfc_get_constant_expr (bt type, int kind, locus *where)
gfc_expr *e;
if (!where)
- gfc_internal_error ("gfc_get_constant_expr(): locus 'where' cannot be NULL");
+ gfc_internal_error ("gfc_get_constant_expr(): locus %<where%> cannot be "
+ "NULL");
e = gfc_get_expr ();
@@ -3185,7 +3186,7 @@ gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform)
if (rvalue->is_boz && lvalue->ts.type != BT_INTEGER
&& lvalue->symtree->n.sym->attr.data
&& !gfc_notify_std (GFC_STD_GNU, "BOZ literal at %L used to "
- "initialize non-integer variable '%s'",
+ "initialize non-integer variable %qs",
&rvalue->where, lvalue->symtree->n.sym->name))
return false;
else if (rvalue->is_boz && !lvalue->symtree->n.sym->attr.data
@@ -3210,15 +3211,15 @@ gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform)
if (rc == ARITH_UNDERFLOW)
gfc_error ("Arithmetic underflow of bit-wise transferred BOZ at %L"
". This check can be disabled with the option "
- "-fno-range-check", &rvalue->where);
+ "%<-fno-range-check%>", &rvalue->where);
else if (rc == ARITH_OVERFLOW)
gfc_error ("Arithmetic overflow of bit-wise transferred BOZ at %L"
". This check can be disabled with the option "
- "-fno-range-check", &rvalue->where);
+ "%<-fno-range-check%>", &rvalue->where);
else if (rc == ARITH_NAN)
gfc_error ("Arithmetic NaN of bit-wise transferred BOZ at %L"
". This check can be disabled with the option "
- "-fno-range-check", &rvalue->where);
+ "%<-fno-range-check%>", &rvalue->where);
return false;
}
}
@@ -3360,7 +3361,7 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue)
}
if (!gfc_notify_std (GFC_STD_F2003, "Bounds specification "
- "for '%s' in pointer assignment at %L",
+ "for %qs in pointer assignment at %L",
lvalue->symtree->n.sym->name, &lvalue->where))
return false;
@@ -3486,7 +3487,7 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue)
return false;
}
if (attr.proc == PROC_INTERNAL &&
- !gfc_notify_std(GFC_STD_F2008, "Internal procedure '%s' "
+ !gfc_notify_std(GFC_STD_F2008, "Internal procedure %qs "
"is invalid in procedure pointer assignment "
"at %L", rvalue->symtree->name, &rvalue->where))
return false;
@@ -2693,6 +2693,7 @@ bool gfc_error_check (void);
bool gfc_error_flag_test (void);
notification gfc_notification_std (int);
+bool gfc_notify_std_1 (int, const char *, ...) ATTRIBUTE_GCC_GFC(2,3);
bool gfc_notify_std (int, const char *, ...) ATTRIBUTE_GCC_GFC(2,3);
/* A general purpose syntax error. */
@@ -316,7 +316,7 @@ gfc_match_end_interface (void)
if (current_interface.op == INTRINSIC_ASSIGN)
{
m = MATCH_ERROR;
- gfc_error ("Expected 'END INTERFACE ASSIGNMENT (=)' at %C");
+ gfc_error ("Expected %<END INTERFACE ASSIGNMENT (=)%> at %C");
}
else
{
@@ -346,7 +346,7 @@ gfc_match_end_interface (void)
break;
m = MATCH_ERROR;
- gfc_error ("Expecting 'END INTERFACE OPERATOR (%s)' at %C, "
+ gfc_error ("Expecting %<END INTERFACE OPERATOR (%s)%> at %C, "
"but got %s", s1, s2);
}
@@ -360,7 +360,7 @@ gfc_match_end_interface (void)
if (type != current_interface.type
|| strcmp (current_interface.uop->name, name) != 0)
{
- gfc_error ("Expecting 'END INTERFACE OPERATOR (.%s.)' at %C",
+ gfc_error ("Expecting %<END INTERFACE OPERATOR (.%s.)%> at %C",
current_interface.uop->name);
m = MATCH_ERROR;
}
@@ -371,7 +371,7 @@ gfc_match_end_interface (void)
if (type != current_interface.type
|| strcmp (current_interface.sym->name, name) != 0)
{
- gfc_error ("Expecting 'END INTERFACE %s' at %C",
+ gfc_error ("Expecting %<END INTERFACE %s%> at %C",
current_interface.sym->name);
m = MATCH_ERROR;
}
@@ -1226,7 +1226,7 @@ check_dummy_characteristics (gfc_symbol *s1, gfc_symbol *s2,
case -2:
/* FIXME: Implement a warning for this case.
- gfc_warning ("Possible shape mismatch in argument '%s'",
+ gfc_warning ("Possible shape mismatch in argument %qs",
s1->name);*/
break;
@@ -1589,7 +1589,7 @@ check_interface0 (gfc_interface *p, const char *interface_name)
/* F2003, C1207. F2008, C1207. */
if (p->sym->attr.proc == PROC_INTERNAL
&& !gfc_notify_std (GFC_STD_F2008, "Internal procedure "
- "'%s' in %s at %L", p->sym->name,
+ "%qs in %s at %L", p->sym->name,
interface_name, &p->sym->declared_at))
return 1;
}
@@ -4387,7 +4387,7 @@ gfc_intrinsic_func_interface (gfc_expr *expr, int error_flag)
if ((isym->id == GFC_ISYM_REAL || isym->id == GFC_ISYM_DBLE
|| isym->id == GFC_ISYM_CMPLX)
&& gfc_init_expr_flag
- && !gfc_notify_std (GFC_STD_F2003, "Function '%s' as initialization "
+ && !gfc_notify_std (GFC_STD_F2003, "Function %qs as initialization "
"expression at %L", name, &expr->where))
{
if (!error_flag)
@@ -550,8 +550,8 @@ check_format (bool is_input)
{
const char *posint_required = _("Positive width required");
const char *nonneg_required = _("Nonnegative width required");
- const char *unexpected_element = _("Unexpected element '%c' in format string"
- " at %L");
+ const char *unexpected_element = _("Unexpected element %<%c%> in format "
+ "string at %L");
const char *unexpected_end = _("Unexpected end of format string");
const char *zero_width = _("Zero width in format descriptor");
@@ -602,7 +602,7 @@ format_item_1:
level++;
goto format_item;
}
- error = _("Left parenthesis required after '*'");
+ error = _("Left parenthesis required after %<*%>");
goto syntax;
case FMT_POSINT:
@@ -823,7 +823,7 @@ data_desc:
error = zero_width;
goto syntax;
}
- if (!gfc_notify_std (GFC_STD_F2008, "'G0' in format at %L",
+ if (!gfc_notify_std (GFC_STD_F2008, "%<G0%> in format at %L",
&format_locus))
return false;
u = format_lex ();
@@ -1408,14 +1408,14 @@ resolve_tag_format (const gfc_expr *e)
return false;
if (e->symtree->n.sym->attr.assign != 1)
{
- gfc_error ("Variable '%s' at %L has not been assigned a "
+ gfc_error ("Variable %qs at %L has not been assigned a "
"format label", e->symtree->n.sym->name, &e->where);
return false;
}
}
else if (e->ts.type == BT_INTEGER)
{
- gfc_error ("Scalar '%s' in FORMAT tag at %L is not an ASSIGNED "
+ gfc_error ("Scalar %qs in FORMAT tag at %L is not an ASSIGNED "
"variable", gfc_basic_typename (e->ts.type), &e->where);
return false;
}
@@ -1729,7 +1729,7 @@ compare_to_allowed_values (const char *specifier, const char *allowed[],
if (n == ERROR)
{
gfc_notify_std (GFC_STD_F2003, "%s specifier in "
- "%s statement at %C has value '%s'", specifier,
+ "%s statement at %C has value %qs", specifier,
statement, allowed_f2003[i]);
return 0;
}
@@ -1756,7 +1756,7 @@ compare_to_allowed_values (const char *specifier, const char *allowed[],
if (n == ERROR)
{
gfc_notify_std (GFC_STD_GNU, "%s specifier in "
- "%s statement at %C has value '%s'", specifier,
+ "%s statement at %C has value %qs", specifier,
statement, allowed_gnu[i]);
return 0;
}
@@ -1768,7 +1768,7 @@ compare_to_allowed_values (const char *specifier, const char *allowed[],
if (warn)
{
char *s = gfc_widechar_to_char (value, -1);
- gfc_warning ("%s specifier in %s statement at %C has invalid value '%s'",
+ gfc_warning ("%s specifier in %s statement at %C has invalid value %qs",
specifier, statement, s);
free (s);
return 1;
@@ -1776,7 +1776,7 @@ compare_to_allowed_values (const char *specifier, const char *allowed[],
else
{
char *s = gfc_widechar_to_char (value, -1);
- gfc_error ("%s specifier in %s statement at %C has invalid value '%s'",
+ gfc_error ("%s specifier in %s statement at %C has invalid value %qs",
specifier, statement, s);
free (s);
return 0;
@@ -2085,7 +2085,7 @@ gfc_match_open (void)
char *s = gfc_widechar_to_char (open->status->value.character.string,
-1);
warn_or_error ("The STATUS specified in OPEN statement at %C is "
- "'%s' and no FILE specifier is present", s);
+ "%qs and no FILE specifier is present", s);
free (s);
}
@@ -2618,7 +2618,7 @@ check_namelist (gfc_symbol *sym)
for (p = sym->namelist; p; p = p->next)
if (p->sym->attr.intent == INTENT_IN)
{
- gfc_error ("Symbol '%s' in namelist '%s' is INTENT(IN) at %C",
+ gfc_error ("Symbol %qs in namelist %qs is INTENT(IN) at %C",
p->sym->name, sym->name);
return 1;
}
@@ -2663,7 +2663,7 @@ match_dt_element (io_kind k, gfc_dt *dt)
if (sym == NULL || sym->attr.flavor != FL_NAMELIST)
{
- gfc_error ("Symbol '%s' at %C must be a NAMELIST group name",
+ gfc_error ("Symbol %qs at %C must be a NAMELIST group name",
sym != NULL ? sym->name : name);
return MATCH_ERROR;
}
@@ -2892,8 +2892,8 @@ gfc_resolve_dt (gfc_dt *dt, locus *loc)
if (!t)
{
- gfc_error ("NAMELIST '%s' in READ statement at %L contains"
- " the symbol '%s' which may not appear in a"
+ gfc_error ("NAMELIST %qs in READ statement at %L contains"
+ " the symbol %qs which may not appear in a"
" variable definition context",
dt->namelist->name, loc, n->sym->name);
return false;
@@ -3533,11 +3533,11 @@ if (condition) \
"YES or NO.", &expr->where);
io_constraint (dt->size && not_no && k == M_READ,
- "SIZE tag at %L requires an ADVANCE = 'NO'",
+ "SIZE tag at %L requires an ADVANCE = %<NO%>",
&dt->size->where);
io_constraint (dt->eor && not_no && k == M_READ,
- "EOR tag at %L requires an ADVANCE = 'NO'",
+ "EOR tag at %L requires an ADVANCE = %<NO%>",
&dt->eor_where);
}
@@ -162,12 +162,12 @@ gfc_match_parens (void)
if (count > 0)
{
- gfc_error ("Missing ')' in statement at or before %L", &where);
+ gfc_error ("Missing %<)%> in statement at or before %L", &where);
return MATCH_ERROR;
}
if (count < 0)
{
- gfc_error ("Missing '(' in statement at or before %L", &where);
+ gfc_error ("Missing %<(%> in statement at or before %L", &where);
return MATCH_ERROR;
}
@@ -496,13 +496,13 @@ gfc_match_label (void)
if (gfc_get_symbol (name, NULL, &gfc_new_block))
{
- gfc_error ("Label name '%s' at %C is ambiguous", name);
+ gfc_error ("Label name %qs at %C is ambiguous", name);
return MATCH_ERROR;
}
if (gfc_new_block->attr.flavor == FL_LABEL)
{
- gfc_error ("Duplicate construct label '%s' at %C", name);
+ gfc_error ("Duplicate construct label %qs at %C", name);
return MATCH_ERROR;
}
@@ -1554,7 +1554,7 @@ gfc_match_else (void)
if (strcmp (name, gfc_current_block ()->name) != 0)
{
- gfc_error ("Label '%s' at %C doesn't match IF label '%s'",
+ gfc_error ("Label %qs at %C doesn't match IF label %qs",
name, gfc_current_block ()->name);
return MATCH_ERROR;
}
@@ -1589,7 +1589,7 @@ gfc_match_elseif (void)
if (strcmp (name, gfc_current_block ()->name) != 0)
{
- gfc_error ("Label '%s' at %C doesn't match IF label '%s'",
+ gfc_error ("Label %qs at %C doesn't match IF label %qs",
name, gfc_current_block ()->name);
goto cleanup;
}
@@ -1746,7 +1746,7 @@ gfc_match_associate (void)
for (a = new_st.ext.block.assoc; a; a = a->next)
if (!strcmp (a->name, newAssoc->name))
{
- gfc_error ("Duplicate name '%s' in association at %C",
+ gfc_error ("Duplicate name %qs in association at %C",
newAssoc->name);
goto assocListError;
}
@@ -1772,7 +1772,7 @@ gfc_match_associate (void)
break;
if (gfc_match_char (',') != MATCH_YES)
{
- gfc_error ("Expected ')' or ',' at %C");
+ gfc_error ("Expected %<)%> or %<,%> at %C");
return MATCH_ERROR;
}
@@ -1859,7 +1859,7 @@ gfc_match_type_spec (gfc_typespec *ts)
/* Enforce F03:C401. */
if (ts->u.derived->attr.abstract)
{
- gfc_error ("Derived type '%s' at %L may not be ABSTRACT",
+ gfc_error ("Derived type %qs at %L may not be ABSTRACT",
ts->u.derived->name, &old_locus);
return MATCH_ERROR;
}
@@ -2406,7 +2406,7 @@ match_exit_cycle (gfc_statement st, gfc_exec_op op)
stree = gfc_find_symtree_in_proc (name, gfc_current_ns);
if (!stree)
{
- gfc_error ("Name '%s' in %s statement at %C is unknown",
+ gfc_error ("Name %qs in %s statement at %C is unknown",
name, gfc_ascii_statement (st));
return MATCH_ERROR;
}
@@ -2414,7 +2414,7 @@ match_exit_cycle (gfc_statement st, gfc_exec_op op)
sym = stree->n.sym;
if (sym->attr.flavor != FL_LABEL)
{
- gfc_error ("Name '%s' in %s statement at %C is not a construct name",
+ gfc_error ("Name %qs in %s statement at %C is not a construct name",
name, gfc_ascii_statement (st));
return MATCH_ERROR;
}
@@ -2449,7 +2449,7 @@ match_exit_cycle (gfc_statement st, gfc_exec_op op)
gfc_error ("%s statement at %C is not within a construct",
gfc_ascii_statement (st));
else
- gfc_error ("%s statement at %C is not within construct '%s'",
+ gfc_error ("%s statement at %C is not within construct %qs",
gfc_ascii_statement (st), sym->name);
return MATCH_ERROR;
@@ -2475,7 +2475,7 @@ match_exit_cycle (gfc_statement st, gfc_exec_op op)
if (op == EXEC_CYCLE)
{
gfc_error ("CYCLE statement at %C is not applicable to non-loop"
- " construct '%s'", sym->name);
+ " construct %qs", sym->name);
return MATCH_ERROR;
}
gcc_assert (op == EXEC_EXIT);
@@ -2485,7 +2485,7 @@ match_exit_cycle (gfc_statement st, gfc_exec_op op)
break;
default:
- gfc_error ("%s statement at %C is not applicable to construct '%s'",
+ gfc_error ("%s statement at %C is not applicable to construct %qs",
gfc_ascii_statement (st), sym->name);
return MATCH_ERROR;
}
@@ -4323,7 +4323,7 @@ gfc_match_common (void)
if (((sym->value != NULL && sym->value->expr_type != EXPR_NULL)
|| sym->attr.data) && gfc_current_state () != COMP_BLOCK_DATA)
{
- if (!gfc_notify_std (GFC_STD_GNU, "Initialized symbol '%s' at "
+ if (!gfc_notify_std (GFC_STD_GNU, "Initialized symbol %qs at "
"%C can only be COMMON in BLOCK DATA",
sym->name))
goto cleanup;
@@ -4349,7 +4349,7 @@ gfc_match_common (void)
{
if (as->type != AS_EXPLICIT)
{
- gfc_error ("Array specification for symbol '%s' in COMMON "
+ gfc_error ("Array specification for symbol %qs in COMMON "
"at %C must be explicit", sym->name);
goto cleanup;
}
@@ -4359,7 +4359,7 @@ gfc_match_common (void)
if (sym->attr.pointer)
{
- gfc_error ("Symbol '%s' in COMMON at %C cannot be a "
+ gfc_error ("Symbol %qs in COMMON at %C cannot be a "
"POINTER array", sym->name);
goto cleanup;
}
@@ -4391,9 +4391,9 @@ gfc_match_common (void)
if (other->common_head
&& other->common_head != sym->common_head)
{
- gfc_error ("Symbol '%s', in COMMON block '%s' at "
+ gfc_error ("Symbol %qs, in COMMON block %qs at "
"%C is being indirectly equivalenced to "
- "another COMMON block '%s'",
+ "another COMMON block %qs",
sym->name, sym->common_head->name,
other->common_head->name);
goto cleanup;
@@ -4519,7 +4519,7 @@ gfc_match_namelist (void)
{
if (group_name->ts.type != BT_UNKNOWN)
{
- gfc_error ("Namelist group name '%s' at %C already has a basic "
+ gfc_error ("Namelist group name %qs at %C already has a basic "
"type of %s", group_name->name,
gfc_typename (&group_name->ts));
return MATCH_ERROR;
@@ -4527,7 +4527,7 @@ gfc_match_namelist (void)
if (group_name->attr.flavor == FL_NAMELIST
&& group_name->attr.use_assoc
- && !gfc_notify_std (GFC_STD_GNU, "Namelist group name '%s' "
+ && !gfc_notify_std (GFC_STD_GNU, "Namelist group name %qs "
"at %C already is USE associated and can"
"not be respecified.", group_name->name))
return MATCH_ERROR;
@@ -4553,7 +4553,7 @@ gfc_match_namelist (void)
these are the only errors for the next two lines. */
if (sym->as && sym->as->type == AS_ASSUMED_SIZE)
{
- gfc_error ("Assumed size array '%s' in namelist '%s' at "
+ gfc_error ("Assumed size array %qs in namelist %qs at "
"%C is not allowed", sym->name, group_name->name);
gfc_error_check ();
}
@@ -4991,7 +4991,7 @@ match_case_eos (void)
if (strcmp (name, gfc_current_block ()->name) != 0)
{
- gfc_error ("Expected block name '%s' of SELECT construct at %C",
+ gfc_error ("Expected block name %qs of SELECT construct at %C",
gfc_current_block ()->name);
return MATCH_ERROR;
}
@@ -5669,7 +5669,7 @@ gfc_match_elsewhere (void)
if (strcmp (name, gfc_current_block ()->name) != 0)
{
- gfc_error ("Label '%s' at %C doesn't match WHERE label '%s'",
+ gfc_error ("Label %qs at %C doesn't match WHERE label %qs",
name, gfc_current_block ()->name);
goto cleanup;
}
@@ -69,7 +69,7 @@ gfc_match_defined_op_name (char *result, int error_flag)
for (i = 0; name[i]; i++)
if (!ISALPHA (name[i]))
{
- gfc_error ("Bad character '%c' in OPERATOR name at %C", name[i]);
+ gfc_error ("Bad character %<%c%> in OPERATOR name at %C", name[i]);
return MATCH_ERROR;
}
@@ -77,7 +77,7 @@ gfc_match_defined_op_name (char *result, int error_flag)
return MATCH_YES;
error:
- gfc_error ("The name '%s' cannot be used as a defined operator at %C",
+ gfc_error ("The name %qs cannot be used as a defined operator at %C",
name);
gfc_current_locus = old_loc;
@@ -670,7 +670,7 @@ gfc_match_use (void)
if (strcmp (new_use->use_name, use_list->module_name) == 0
|| strcmp (new_use->local_name, use_list->module_name) == 0)
{
- gfc_error ("The name '%s' at %C has already been used as "
+ gfc_error ("The name %qs at %C has already been used as "
"an external module name.", use_list->module_name);
goto cleanup;
}
@@ -4855,7 +4855,7 @@ check_for_ambiguous (gfc_symbol *st_sym, pointer_info *info)
if (gfc_current_ns->proc_name && st_sym->name == gfc_current_ns->proc_name->name)
{
- gfc_error ("'%s' of module '%s', imported at %C, is also the name of the "
+ gfc_error ("%qs of module %qs, imported at %C, is also the name of the "
"current program unit", st_sym->name, module_name);
return true;
}
@@ -5206,20 +5206,20 @@ read_module (void)
if (u->op == INTRINSIC_NONE)
{
- gfc_error ("Symbol '%s' referenced at %L not found in module '%s'",
+ gfc_error ("Symbol %qs referenced at %L not found in module %qs",
u->use_name, &u->where, module_name);
continue;
}
if (u->op == INTRINSIC_USER)
{
- gfc_error ("User operator '%s' referenced at %L not found "
- "in module '%s'", u->use_name, &u->where, module_name);
+ gfc_error ("User operator %qs referenced at %L not found "
+ "in module %qs", u->use_name, &u->where, module_name);
continue;
}
- gfc_error ("Intrinsic operator '%s' referenced at %L not found "
- "in module '%s'", gfc_op2string (u->op), &u->where,
+ gfc_error ("Intrinsic operator %qs referenced at %L not found "
+ "in module %qs", gfc_op2string (u->op), &u->where,
module_name);
}
@@ -6050,7 +6050,7 @@ gfc_dump_module (const char *name, int dump_flag)
else
{
if (remove (filename_tmp))
- gfc_fatal_error ("Can't delete temporary module file '%s': %s",
+ gfc_fatal_error ("Can't delete temporary module file %qs: %s",
filename_tmp, xstrerror (errno));
}
}
@@ -6070,7 +6070,7 @@ create_intrinsic_function (const char *name, int id,
{
if (strcmp (modname, tmp_symtree->n.sym->module) == 0)
return;
- gfc_error ("Symbol '%s' already declared", name);
+ gfc_error ("Symbol %qs already declared", name);
}
gfc_get_sym_tree (name, gfc_current_ns, &tmp_symtree, false);
@@ -6248,7 +6248,7 @@ import_iso_c_binding_module (void)
if (not_in_std)
{
- gfc_error ("The symbol '%s', referenced at %L, is not "
+ gfc_error ("The symbol %qs, referenced at %L, is not "
"in the selected standard", name, &u->where);
continue;
}
@@ -6376,7 +6376,7 @@ import_iso_c_binding_module (void)
if (u->found)
continue;
- gfc_error ("Symbol '%s' referenced at %L not found in intrinsic "
+ gfc_error ("Symbol %qs referenced at %L not found in intrinsic "
"module ISO_C_BINDING", u->use_name, &u->where);
}
}
@@ -6397,7 +6397,7 @@ create_int_parameter (const char *name, int value, const char *modname,
if (strcmp (modname, tmp_symtree->n.sym->module) == 0)
return;
else
- gfc_error ("Symbol '%s' already declared", name);
+ gfc_error ("Symbol %qs already declared", name);
}
gfc_get_sym_tree (name, gfc_current_ns, &tmp_symtree, false);
@@ -6430,7 +6430,7 @@ create_int_parameter_array (const char *name, int size, gfc_expr *value,
if (strcmp (modname, tmp_symtree->n.sym->module) == 0)
return;
else
- gfc_error ("Symbol '%s' already declared", name);
+ gfc_error ("Symbol %qs already declared", name);
}
gfc_get_sym_tree (name, gfc_current_ns, &tmp_symtree, false);
@@ -6472,7 +6472,7 @@ create_derived_type (const char *name, const char *modname,
if (strcmp (modname, tmp_symtree->n.sym->module) == 0)
return;
else
- gfc_error ("Symbol '%s' already declared", name);
+ gfc_error ("Symbol %qs already declared", name);
}
gfc_get_sym_tree (name, gfc_current_ns, &tmp_symtree, false);
@@ -6577,7 +6577,7 @@ use_iso_fortran_env_module (void)
}
else
if (!mod_symtree->n.sym->attr.intrinsic)
- gfc_error ("Use of intrinsic module '%s' at %C conflicts with "
+ gfc_error ("Use of intrinsic module %qs at %C conflicts with "
"non-intrinsic module name used previously", mod);
/* Generate the symbols for the module integer named constants. */
@@ -6592,7 +6592,7 @@ use_iso_fortran_env_module (void)
found = true;
u->found = 1;
- if (!gfc_notify_std (symbol[i].standard, "The symbol '%s', "
+ if (!gfc_notify_std (symbol[i].standard, "The symbol %qs, "
"referenced at %L, is not in the selected "
"standard", symbol[i].name, &u->where))
continue;
@@ -6720,7 +6720,7 @@ use_iso_fortran_env_module (void)
if (u->found)
continue;
- gfc_error ("Symbol '%s' referenced at %L not found in intrinsic "
+ gfc_error ("Symbol %qs referenced at %L not found in intrinsic "
"module ISO_FORTRAN_ENV", u->use_name, &u->where);
}
}
@@ -6822,7 +6822,7 @@ gfc_use_module (gfc_use_list *module)
mod_symtree = gfc_find_symtree (gfc_current_ns->sym_root, module_name);
if (mod_symtree && mod_symtree->n.sym->attr.intrinsic)
- gfc_error ("Use of non-intrinsic module '%s' at %C conflicts with "
+ gfc_error ("Use of non-intrinsic module %qs at %C conflicts with "
"intrinsic module name used previously", module_name);
iomode = IO_INPUT;
@@ -2074,7 +2074,7 @@ resolve_omp_clauses (gfc_code *code, locus *where,
|| (!code && (!n->sym->attr.dummy || n->sym->ns != ns)))
{
if (!code && (!n->sym->attr.dummy || n->sym->ns != ns))
- gfc_error ("Variable '%s' is not a dummy argument at %L",
+ gfc_error ("Variable %qs is not a dummy argument at %L",
n->sym->name, where);
continue;
}
@@ -2106,7 +2106,7 @@ resolve_omp_clauses (gfc_code *code, locus *where,
continue;
}
}
- gfc_error ("Object '%s' is not a variable at %L", n->sym->name,
+ gfc_error ("Object %qs is not a variable at %L", n->sym->name,
where);
}
@@ -2121,7 +2121,7 @@ resolve_omp_clauses (gfc_code *code, locus *where,
for (n = omp_clauses->lists[list]; n; n = n->next)
{
if (n->sym->mark)
- gfc_error ("Symbol '%s' present on multiple clauses at %L",
+ gfc_error ("Symbol %qs present on multiple clauses at %L",
n->sym->name, where);
else
n->sym->mark = 1;
@@ -2132,7 +2132,7 @@ resolve_omp_clauses (gfc_code *code, locus *where,
for (n = omp_clauses->lists[list]; n; n = n->next)
if (n->sym->mark)
{
- gfc_error ("Symbol '%s' present on multiple clauses at %L",
+ gfc_error ("Symbol %qs present on multiple clauses at %L",
n->sym->name, where);
n->sym->mark = 0;
}
@@ -2140,7 +2140,7 @@ resolve_omp_clauses (gfc_code *code, locus *where,
for (n = omp_clauses->lists[OMP_LIST_FIRSTPRIVATE]; n; n = n->next)
{
if (n->sym->mark)
- gfc_error ("Symbol '%s' present on multiple clauses at %L",
+ gfc_error ("Symbol %qs present on multiple clauses at %L",
n->sym->name, where);
else
n->sym->mark = 1;
@@ -2151,7 +2151,7 @@ resolve_omp_clauses (gfc_code *code, locus *where,
for (n = omp_clauses->lists[OMP_LIST_LASTPRIVATE]; n; n = n->next)
{
if (n->sym->mark)
- gfc_error ("Symbol '%s' present on multiple clauses at %L",
+ gfc_error ("Symbol %qs present on multiple clauses at %L",
n->sym->name, where);
else
n->sym->mark = 1;
@@ -2163,7 +2163,7 @@ resolve_omp_clauses (gfc_code *code, locus *where,
for (n = omp_clauses->lists[OMP_LIST_ALIGNED]; n; n = n->next)
{
if (n->sym->mark)
- gfc_error ("Symbol '%s' present on multiple clauses at %L",
+ gfc_error ("Symbol %qs present on multiple clauses at %L",
n->sym->name, where);
else
n->sym->mark = 1;
@@ -2177,7 +2177,7 @@ resolve_omp_clauses (gfc_code *code, locus *where,
for (n = omp_clauses->lists[OMP_LIST_TO]; n; n = n->next)
{
if (n->expr == NULL && n->sym->mark)
- gfc_error ("Symbol '%s' present on both FROM and TO clauses at %L",
+ gfc_error ("Symbol %qs present on both FROM and TO clauses at %L",
n->sym->name, where);
else
n->sym->mark = 1;
@@ -2199,7 +2199,7 @@ resolve_omp_clauses (gfc_code *code, locus *where,
for (; n != NULL; n = n->next)
{
if (!n->sym->attr.threadprivate)
- gfc_error ("Non-THREADPRIVATE object '%s' in COPYIN clause"
+ gfc_error ("Non-THREADPRIVATE object %qs in COPYIN clause"
" at %L", n->sym->name, where);
}
break;
@@ -2207,10 +2207,10 @@ resolve_omp_clauses (gfc_code *code, locus *where,
for (; n != NULL; n = n->next)
{
if (n->sym->as && n->sym->as->type == AS_ASSUMED_SIZE)
- gfc_error ("Assumed size array '%s' in COPYPRIVATE clause "
+ gfc_error ("Assumed size array %qs in COPYPRIVATE clause "
"at %L", n->sym->name, where);
if (n->sym->attr.pointer && n->sym->attr.intent == INTENT_IN)
- gfc_error ("INTENT(IN) POINTER '%s' in COPYPRIVATE clause "
+ gfc_error ("INTENT(IN) POINTER %qs in COPYPRIVATE clause "
"at %L", n->sym->name, where);
}
break;
@@ -2218,13 +2218,13 @@ resolve_omp_clauses (gfc_code *code, locus *where,
for (; n != NULL; n = n->next)
{
if (n->sym->attr.threadprivate)
- gfc_error ("THREADPRIVATE object '%s' in SHARED clause at "
+ gfc_error ("THREADPRIVATE object %qs in SHARED clause at "
"%L", n->sym->name, where);
if (n->sym->attr.cray_pointee)
- gfc_error ("Cray pointee '%s' in SHARED clause at %L",
+ gfc_error ("Cray pointee %qs in SHARED clause at %L",
n->sym->name, where);
if (n->sym->attr.associate_var)
- gfc_error ("ASSOCIATE name '%s' in SHARED clause at %L",
+ gfc_error ("ASSOCIATE name %qs in SHARED clause at %L",
n->sym->name, where);
}
break;
@@ -2239,7 +2239,7 @@ resolve_omp_clauses (gfc_code *code, locus *where,
!= INTMOD_ISO_C_BINDING)
|| (n->sym->ts.u.derived->intmod_sym_id
!= ISOCBINDING_PTR)))
- gfc_error ("'%s' in ALIGNED clause must be POINTER, "
+ gfc_error ("%qs in ALIGNED clause must be POINTER, "
"ALLOCATABLE, Cray pointer or C_PTR at %L",
n->sym->name, where);
else if (n->expr)
@@ -2251,7 +2251,7 @@ resolve_omp_clauses (gfc_code *code, locus *where,
|| expr->rank != 0
|| gfc_extract_int (expr, &alignment)
|| alignment <= 0)
- gfc_error ("'%s' in ALIGNED clause at %L requires a scalar "
+ gfc_error ("%qs in ALIGNED clause at %L requires a scalar "
"positive constant integer alignment "
"expression", n->sym->name, where);
}
@@ -2269,7 +2269,7 @@ resolve_omp_clauses (gfc_code *code, locus *where,
|| n->expr->ref == NULL
|| n->expr->ref->next
|| n->expr->ref->type != REF_ARRAY)
- gfc_error ("'%s' in %s clause at %L is not a proper "
+ gfc_error ("%qs in %s clause at %L is not a proper "
"array section", n->sym->name, name, where);
else if (n->expr->ref->u.ar.codimen)
gfc_error ("Coarrays not supported in %s clause at %L",
@@ -2289,7 +2289,7 @@ resolve_omp_clauses (gfc_code *code, locus *where,
else if (ar->dimen_type[i] != DIMEN_ELEMENT
&& ar->dimen_type[i] != DIMEN_RANGE)
{
- gfc_error ("'%s' in %s clause at %L is not a "
+ gfc_error ("%qs in %s clause at %L is not a "
"proper array section",
n->sym->name, name, where);
break;
@@ -2302,7 +2302,7 @@ resolve_omp_clauses (gfc_code *code, locus *where,
&& mpz_cmp (ar->start[i]->value.integer,
ar->end[i]->value.integer) > 0)
{
- gfc_error ("'%s' in DEPEND clause at %L is a zero "
+ gfc_error ("%qs in DEPEND clause at %L is a zero "
"size array section", n->sym->name,
where);
break;
@@ -2314,10 +2314,10 @@ resolve_omp_clauses (gfc_code *code, locus *where,
{
n->sym->attr.referenced = 1;
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);
}
break;
@@ -2220,7 +2220,7 @@ unexpected_eof (void)
{
gfc_state_data *p;
- gfc_error ("Unexpected end of file in '%s'", gfc_source_file);
+ gfc_error ("Unexpected end of file in %qs", gfc_source_file);
/* Memory cleanup. Move to "second to last". */
for (p = gfc_state_stack; p && p->previous && p->previous->previous;
@@ -2252,10 +2252,10 @@ parse_derived_contains (void)
/* Derived-types with SEQUENCE and/or BIND(C) must not have a CONTAINS
section. */
if (gfc_current_block ()->attr.sequence)
- gfc_error ("Derived-type '%s' with SEQUENCE must not have a CONTAINS"
+ gfc_error ("Derived-type %qs with SEQUENCE must not have a CONTAINS"
" section at %C", gfc_current_block ()->name);
if (gfc_current_block ()->attr.is_bind_c)
- gfc_error ("Derived-type '%s' with BIND(C) must not have a CONTAINS"
+ gfc_error ("Derived-type %qs with BIND(C) must not have a CONTAINS"
" section at %C", gfc_current_block ()->name);
accept_statement (ST_CONTAINS);
@@ -2739,7 +2739,7 @@ loop:
{
gfc_add_abstract (&gfc_new_block->attr, &gfc_current_locus);
if (gfc_is_intrinsic_typename (gfc_new_block->name))
- gfc_error ("Name '%s' of ABSTRACT INTERFACE at %C "
+ gfc_error ("Name %qs of ABSTRACT INTERFACE at %C "
"cannot be the same as an intrinsic type",
gfc_new_block->name);
}
@@ -2790,7 +2790,7 @@ decl:
&& current_interface.ns->proc_name
&& strcmp (current_interface.ns->proc_name->name,
prog_unit->name) == 0)
- gfc_error ("INTERFACE procedure '%s' at %L has the same name as the "
+ gfc_error ("INTERFACE procedure %qs at %L has the same name as the "
"enclosing procedure", prog_unit->name,
¤t_interface.ns->proc_name->declared_at);
@@ -3088,11 +3088,11 @@ declSt:
{
ts = &gfc_current_block ()->result->ts;
if (ts->type != BT_DERIVED)
- gfc_error ("Bad kind expression for function '%s' at %L",
+ gfc_error ("Bad kind expression for function %qs at %L",
gfc_current_block ()->name,
&gfc_current_block ()->declared_at);
else
- gfc_error ("The type for function '%s' at %L is not accessible",
+ gfc_error ("The type for function %qs at %L is not accessible",
gfc_current_block ()->name,
&gfc_current_block ()->declared_at);
@@ -4467,7 +4467,7 @@ parse_contained (int module)
if (!module)
{
if (gfc_get_symbol (gfc_new_block->name, parent_ns, &sym))
- gfc_error ("Contained procedure '%s' at %C is already "
+ gfc_error ("Contained procedure %qs at %C is already "
"ambiguous", gfc_new_block->name);
else
{
@@ -631,7 +631,7 @@ done:
case 'd':
if (kind != -2)
{
- gfc_error ("Real number at %C has a 'd' exponent and an explicit "
+ gfc_error ("Real number at %C has a %<d%> exponent and an explicit "
"kind");
goto cleanup;
}
@@ -661,7 +661,7 @@ done:
case 'q':
if (kind != -2)
{
- gfc_error ("Real number at %C has a 'q' exponent and an explicit "
+ gfc_error ("Real number at %C has a %<q%> exponent and an explicit "
"kind");
goto cleanup;
}
@@ -675,7 +675,7 @@ done:
kind = 10;
if (gfc_validate_kind (BT_REAL, kind, true) < 0)
{
- gfc_error ("Invalid exponent-letter 'q' in "
+ gfc_error ("Invalid exponent-letter %<q%> in "
"real-literal-constant at %C");
goto cleanup;
}
@@ -1083,7 +1083,7 @@ got_delim:
if (!gfc_check_character_range (c, kind))
{
gfc_free_expr (e);
- gfc_error ("Character '%s' in string at %C is not representable "
+ gfc_error ("Character %qs in string at %C is not representable "
"in character kind %d", gfc_print_wide_char (c), kind);
return MATCH_ERROR;
}
@@ -1580,7 +1580,7 @@ match_keyword_arg (gfc_actual_arglist *actual, gfc_actual_arglist *base)
for (a = base; a; a = a->next)
if (a->name != NULL && strcmp (a->name, name) == 0)
{
- gfc_error ("Keyword '%s' at %C has already appeared in the "
+ gfc_error ("Keyword %qs at %C has already appeared in the "
"current argument list", name);
return MATCH_ERROR;
}
@@ -1847,7 +1847,7 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag,
|| (sym->ts.type == BT_CLASS && CLASS_DATA (sym)
&& !CLASS_DATA (sym)->attr.codimension))
{
- gfc_error ("Coarray designator at %C but '%s' is not a coarray",
+ gfc_error ("Coarray designator at %C but %qs is not a coarray",
sym->name);
return MATCH_ERROR;
}
@@ -1914,13 +1914,13 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag,
if (sym->ts.type == BT_UNKNOWN && gfc_match_char ('%') == MATCH_YES)
{
- gfc_error ("Symbol '%s' at %C has no IMPLICIT type", sym->name);
+ gfc_error ("Symbol %qs at %C has no IMPLICIT type", sym->name);
return MATCH_ERROR;
}
else if ((sym->ts.type != BT_DERIVED && sym->ts.type != BT_CLASS)
&& gfc_match_char ('%') == MATCH_YES)
{
- gfc_error ("Unexpected '%%' for nonderived-type variable '%s' at %C",
+ gfc_error ("Unexpected %<%%%> for nonderived-type variable %qs at %C",
sym->name);
return MATCH_ERROR;
}
@@ -2020,7 +2020,7 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag,
if (m == MATCH_NO && !gfc_matching_ptr_assignment
&& !gfc_matching_procptr_assignment && !matching_actual_arglist)
{
- gfc_error ("Procedure pointer component '%s' requires an "
+ gfc_error ("Procedure pointer component %qs requires an "
"argument list at %C", component->name);
return MATCH_ERROR;
}
@@ -2369,7 +2369,7 @@ build_actual_constructor (gfc_structure_ctor_component **comp_head,
}
else if (!comp->attr.deferred_parameter)
{
- gfc_error ("No initializer for component '%s' given in the"
+ gfc_error ("No initializer for component %qs given in the"
" structure constructor at %C!", comp->name);
return false;
}
@@ -2417,7 +2417,7 @@ gfc_convert_to_structure_constructor (gfc_expr *e, gfc_symbol *sym, gfc_expr **c
if (!parent && sym->attr.abstract)
{
- gfc_error ("Can't construct ABSTRACT type '%s' at %L",
+ gfc_error ("Can't construct ABSTRACT type %qs at %L",
sym->name, &expr->where);
goto cleanup;
}
@@ -2506,7 +2506,7 @@ gfc_convert_to_structure_constructor (gfc_expr *e, gfc_symbol *sym, gfc_expr **c
if (this_comp->attr.pointer && comp_tail->val
&& gfc_is_coindexed (comp_tail->val))
{
- gfc_error ("Coindexed expression to pointer component '%s' in "
+ gfc_error ("Coindexed expression to pointer component %qs in "
"structure constructor at %L!", comp_tail->name,
&comp_tail->where);
goto cleanup;
@@ -2560,7 +2560,7 @@ gfc_convert_to_structure_constructor (gfc_expr *e, gfc_symbol *sym, gfc_expr **c
{
for (comp_iter = comp_head; comp_iter; comp_iter = comp_iter->next)
{
- gfc_error ("component '%s' at %L has already been set by a "
+ gfc_error ("component %qs at %L has already been set by a "
"parent derived type constructor", comp_iter->name,
&comp_iter->where);
}
@@ -2743,7 +2743,7 @@ gfc_match_rvalue (gfc_expr **result)
&& gfc_current_ns->proc_name == sym
&& !sym->attr.dimension)
{
- gfc_error ("'%s' at %C is the name of a recursive function "
+ gfc_error ("%qs at %C is the name of a recursive function "
"and so refers to the result variable. Use an "
"explicit RESULT variable for direct recursion "
"(12.5.2.1)", sym->name);
@@ -2866,7 +2866,7 @@ gfc_match_rvalue (gfc_expr **result)
if (sym->attr.subroutine)
{
- gfc_error ("Unexpected use of subroutine name '%s' at %C",
+ gfc_error ("Unexpected use of subroutine name %qs at %C",
sym->name);
m = MATCH_ERROR;
break;
@@ -2897,10 +2897,10 @@ gfc_match_rvalue (gfc_expr **result)
if (m == MATCH_NO)
{
if (sym->attr.proc == PROC_ST_FUNCTION)
- gfc_error ("Statement function '%s' requires argument list at %C",
+ gfc_error ("Statement function %qs requires argument list at %C",
sym->name);
else
- gfc_error ("Function '%s' requires an argument list at %C",
+ gfc_error ("Function %qs requires an argument list at %C",
sym->name);
m = MATCH_ERROR;
@@ -2950,7 +2950,7 @@ gfc_match_rvalue (gfc_expr **result)
/* make sure we were given a param */
if (actual_arglist == NULL)
{
- gfc_error ("Missing argument to '%s' at %C", sym->name);
+ gfc_error ("Missing argument to %qs at %C", sym->name);
m = MATCH_ERROR;
break;
}
@@ -3106,7 +3106,7 @@ gfc_match_rvalue (gfc_expr **result)
m = gfc_match_actual_arglist (0, &e->value.function.actual);
if (m == MATCH_NO)
- gfc_error ("Missing argument list in function '%s' at %C", sym->name);
+ gfc_error ("Missing argument list in function %qs at %C", sym->name);
if (m != MATCH_YES)
{
@@ -3273,7 +3273,7 @@ match_variable (gfc_expr **result, int equiv_flag, int host_flag)
/* Fall through to error */
default:
- gfc_error ("'%s' at %C is not a variable", sym->name);
+ gfc_error ("%qs at %C is not a variable", sym->name);
return MATCH_ERROR;
}
@@ -122,10 +122,10 @@ resolve_typespec_used (gfc_typespec* ts, locus* where, const char* name)
if (where)
{
if (name)
- gfc_error ("'%s' at %L is of the ABSTRACT type '%s'",
+ gfc_error ("%qs at %L is of the ABSTRACT type %qs",
name, where, ts->u.derived->name);
else
- gfc_error ("ABSTRACT type '%s' used at %L",
+ gfc_error ("ABSTRACT type %qs used at %L",
ts->u.derived->name, where);
}
@@ -142,7 +142,7 @@ check_proc_interface (gfc_symbol *ifc, locus *where)
/* Several checks for F08:C1216. */
if (ifc->attr.procedure)
{
- gfc_error ("Interface '%s' at %L is declared "
+ gfc_error ("Interface %qs at %L is declared "
"in a later PROCEDURE statement", ifc->name, where);
return false;
}
@@ -155,14 +155,14 @@ check_proc_interface (gfc_symbol *ifc, locus *where)
gen = gen->next;
if (!gen)
{
- gfc_error ("Interface '%s' at %L may not be generic",
+ gfc_error ("Interface %qs at %L may not be generic",
ifc->name, where);
return false;
}
}
if (ifc->attr.proc == PROC_ST_FUNCTION)
{
- gfc_error ("Interface '%s' at %L may not be a statement function",
+ gfc_error ("Interface %qs at %L may not be a statement function",
ifc->name, where);
return false;
}
@@ -171,13 +171,13 @@ check_proc_interface (gfc_symbol *ifc, locus *where)
ifc->attr.intrinsic = 1;
if (ifc->attr.intrinsic && !gfc_intrinsic_actual_ok (ifc->name, 0))
{
- gfc_error ("Intrinsic procedure '%s' not allowed in "
+ gfc_error ("Intrinsic procedure %qs not allowed in "
"PROCEDURE statement at %L", ifc->name, where);
return false;
}
if (!ifc->attr.if_source && !ifc->attr.intrinsic && ifc->name[0] != '\0')
{
- gfc_error ("Interface '%s' at %L must be explicit", ifc->name, where);
+ gfc_error ("Interface %qs at %L must be explicit", ifc->name, where);
return false;
}
return true;
@@ -199,7 +199,7 @@ resolve_procedure_interface (gfc_symbol *sym)
if (ifc == sym)
{
- gfc_error ("PROCEDURE '%s' at %L may not be used as its own interface",
+ gfc_error ("PROCEDURE %qs at %L may not be used as its own interface",
sym->name, &sym->declared_at);
return false;
}
@@ -294,11 +294,11 @@ resolve_formal_arglist (gfc_symbol *proc)
/* Alternate return placeholder. */
if (gfc_elemental (proc))
gfc_error ("Alternate return specifier in elemental subroutine "
- "'%s' at %L is not allowed", proc->name,
+ "%qs at %L is not allowed", proc->name,
&proc->declared_at);
if (proc->attr.function)
gfc_error ("Alternate return specifier in function "
- "'%s' at %L is not allowed", proc->name,
+ "%qs at %L is not allowed", proc->name,
&proc->declared_at);
continue;
}
@@ -309,7 +309,7 @@ resolve_formal_arglist (gfc_symbol *proc)
if (strcmp (proc->name, sym->name) == 0)
{
gfc_error ("Self-referential argument "
- "'%s' at %L is not allowed", sym->name,
+ "%qs at %L is not allowed", sym->name,
&proc->declared_at);
return;
}
@@ -380,7 +380,7 @@ resolve_formal_arglist (gfc_symbol *proc)
/* F08:C1279. */
if (!gfc_pure (sym))
{
- gfc_error ("Dummy procedure '%s' of PURE procedure at %L must "
+ gfc_error ("Dummy procedure %qs of PURE procedure at %L must "
"also be PURE", sym->name, &sym->declared_at);
continue;
}
@@ -390,12 +390,12 @@ resolve_formal_arglist (gfc_symbol *proc)
if (proc->attr.function && sym->attr.intent != INTENT_IN)
{
if (sym->attr.value)
- gfc_notify_std (GFC_STD_F2008, "Argument '%s'"
- " of pure function '%s' at %L with VALUE "
+ gfc_notify_std (GFC_STD_F2008, "Argument %qs"
+ " of pure function %qs at %L with VALUE "
"attribute but without INTENT(IN)",
sym->name, proc->name, &sym->declared_at);
else
- gfc_error ("Argument '%s' of pure function '%s' at %L must "
+ gfc_error ("Argument %qs of pure function %qs at %L must "
"be INTENT(IN) or VALUE", sym->name, proc->name,
&sym->declared_at);
}
@@ -403,12 +403,12 @@ resolve_formal_arglist (gfc_symbol *proc)
if (proc->attr.subroutine && sym->attr.intent == INTENT_UNKNOWN)
{
if (sym->attr.value)
- gfc_notify_std (GFC_STD_F2008, "Argument '%s'"
- " of pure subroutine '%s' at %L with VALUE "
+ gfc_notify_std (GFC_STD_F2008, "Argument %qs"
+ " of pure subroutine %qs at %L with VALUE "
"attribute but without INTENT", sym->name,
proc->name, &sym->declared_at);
else
- gfc_error ("Argument '%s' of pure subroutine '%s' at %L "
+ gfc_error ("Argument %qs of pure subroutine %qs at %L "
"must have its INTENT specified or have the "
"VALUE attribute", sym->name, proc->name,
&sym->declared_at);
@@ -442,7 +442,7 @@ resolve_formal_arglist (gfc_symbol *proc)
|| (sym->ts.type == BT_CLASS && CLASS_DATA (sym)
&& CLASS_DATA (sym)->attr.codimension))
{
- gfc_error ("Coarray dummy argument '%s' at %L to elemental "
+ gfc_error ("Coarray dummy argument %qs at %L to elemental "
"procedure", sym->name, &sym->declared_at);
continue;
}
@@ -450,7 +450,7 @@ resolve_formal_arglist (gfc_symbol *proc)
if (sym->as || (sym->ts.type == BT_CLASS && CLASS_DATA (sym)
&& CLASS_DATA (sym)->as))
{
- gfc_error ("Argument '%s' of elemental procedure at %L must "
+ gfc_error ("Argument %qs of elemental procedure at %L must "
"be scalar", sym->name, &sym->declared_at);
continue;
}
@@ -459,7 +459,7 @@ resolve_formal_arglist (gfc_symbol *proc)
|| (sym->ts.type == BT_CLASS && CLASS_DATA (sym)
&& CLASS_DATA (sym)->attr.allocatable))
{
- gfc_error ("Argument '%s' of elemental procedure at %L cannot "
+ gfc_error ("Argument %qs of elemental procedure at %L cannot "
"have the ALLOCATABLE attribute", sym->name,
&sym->declared_at);
continue;
@@ -913,11 +913,11 @@ resolve_common_vars (gfc_symbol *sym, bool named_common)
if (csym->value || csym->attr.data)
{
if (!csym->ns->is_block_data)
- gfc_notify_std (GFC_STD_GNU, "Variable '%s' at %L is in COMMON "
+ gfc_notify_std (GFC_STD_GNU, "Variable %qs at %L is in COMMON "
"but only in BLOCK DATA initialization is "
"allowed", csym->name, &csym->declared_at);
else if (!named_common)
- gfc_notify_std (GFC_STD_GNU, "Initialized variable '%s' at %L is "
+ gfc_notify_std (GFC_STD_GNU, "Initialized variable %qs at %L is "
"in a blank COMMON but initialization is only "
"allowed in named common blocks", csym->name,
&csym->declared_at);
@@ -1061,12 +1061,12 @@ resolve_common_blocks (gfc_symtree *common_root)
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 "
+ gfc_notify_std (GFC_STD_F2003, "COMMON block %qs at %L "
"that is also a function result", sym->name,
&common_root->n.common->where);
else if (sym->attr.flavor == FL_PROCEDURE && sym->attr.proc != PROC_INTERNAL
&& sym->attr.proc != PROC_ST_FUNCTION)
- gfc_notify_std (GFC_STD_F2003, "COMMON block '%s' at %L "
+ gfc_notify_std (GFC_STD_F2003, "COMMON block %qs at %L "
"that is also a global procedure", sym->name,
&common_root->n.common->where);
}
@@ -1683,10 +1683,10 @@ gfc_resolve_intrinsic (gfc_symbol *sym, locus *loc)
/* Check it is actually available in the standard settings. */
if (!gfc_check_intrinsic_standard (isym, &symstd, false, sym->declared_at))
{
- 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.",
+ 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;
}
@@ -1815,7 +1815,7 @@ resolve_actual_arglist (gfc_actual_arglist *arg, procedure_type ptype,
if (sym->attr.contained && !sym->attr.use_assoc
&& sym->ns->proc_name->attr.flavor != FL_MODULE)
{
- if (!gfc_notify_std (GFC_STD_F2008, "Internal procedure '%s' is"
+ if (!gfc_notify_std (GFC_STD_F2008, "Internal procedure %qs is"
" used as actual argument at %L",
sym->name, &e->where))
goto cleanup;
@@ -4966,12 +4966,12 @@ resolve_variable (gfc_expr *e)
if (!seen)
{
if (specification_expr)
- gfc_error ("Variable '%s', used in a specification expression"
+ gfc_error ("Variable %qs, used in a specification expression"
", is referenced at %L before the ENTRY statement "
"in which it is a parameter",
sym->name, &cs_base->current->loc);
else
- gfc_error ("Variable '%s' is used at %L before the ENTRY "
+ gfc_error ("Variable %qs is used at %L before the ENTRY "
"statement in which it is a parameter",
sym->name, &cs_base->current->loc);
t = false;
@@ -5393,7 +5393,7 @@ update_ppc_arglist (gfc_expr* e)
if (po->ts.type == BT_DERIVED && po->ts.u.derived->attr.abstract)
{
gfc_error ("Base object for procedure-pointer component call at %L is of"
- " ABSTRACT type '%s'", &e->where, po->ts.u.derived->name);
+ " ABSTRACT type %qs", &e->where, po->ts.u.derived->name);
return false;
}
@@ -5428,7 +5428,7 @@ check_typebound_baseobject (gfc_expr* e)
if (base->ts.type == BT_DERIVED && base->ts.u.derived->attr.abstract)
{
gfc_error ("Base object for type-bound procedure call at %L is of"
- " ABSTRACT type '%s'", &e->where, base->ts.u.derived->name);
+ " ABSTRACT type %qs", &e->where, base->ts.u.derived->name);
goto cleanup;
}
@@ -5625,7 +5625,7 @@ resolve_typebound_generic_call (gfc_expr* e, const char **name)
/* Nothing matching found! */
gfc_error ("Found no matching specific binding for the call to the GENERIC"
- " '%s' at %L", genname, &e->where);
+ " %qs at %L", genname, &e->where);
return false;
success:
@@ -5651,7 +5651,7 @@ resolve_typebound_call (gfc_code* c, const char **name)
/* Check that's really a SUBROUTINE. */
if (!c->expr1->value.compcall.tbp->subroutine)
{
- gfc_error ("'%s' at %L should be a SUBROUTINE",
+ gfc_error ("%qs at %L should be a SUBROUTINE",
c->expr1->value.compcall.name, &c->loc);
return false;
}
@@ -5698,7 +5698,7 @@ resolve_compcall (gfc_expr* e, const char **name)
/* Check that's really a FUNCTION. */
if (!e->value.compcall.tbp->function)
{
- gfc_error ("'%s' at %L should be a FUNCTION",
+ gfc_error ("%qs at %L should be a FUNCTION",
e->value.compcall.name, &e->where);
return false;
}
@@ -6433,7 +6433,7 @@ resolve_forall_iterators (gfc_forall_iterator *it)
if (find_forall_index (iter2->start, iter->var->symtree->n.sym, 0)
|| find_forall_index (iter2->end, iter->var->symtree->n.sym, 0)
|| find_forall_index (iter2->stride, iter->var->symtree->n.sym, 0))
- gfc_error ("FORALL index '%s' may not appear in triplet "
+ gfc_error ("FORALL index %qs may not appear in triplet "
"specification at %L", iter->var->symtree->name,
&iter2->start->where);
}
@@ -7049,7 +7049,7 @@ check_symbols:
|| (ar->end[i] != NULL
&& gfc_find_sym_in_expr (sym, ar->end[i])))
{
- gfc_error ("'%s' must not appear in the array specification at "
+ gfc_error ("%qs must not appear in the array specification at "
"%L in the same ALLOCATE statement where it is "
"itself allocated", sym->name, &ar->where);
goto failure;
@@ -7883,7 +7883,7 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target)
/* Finally resolve if this is an array or not. */
if (sym->attr.dimension && target->rank == 0)
{
- gfc_error ("Associate-name '%s' at %L is used as array",
+ gfc_error ("Associate-name %qs at %L is used as array",
sym->name, &sym->declared_at);
sym->attr.dimension = 0;
return;
@@ -7992,7 +7992,7 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns)
&& !selector_type->attr.unlimited_polymorphic
&& !gfc_type_is_extensible (c->ts.u.derived))
{
- gfc_error ("Derived type '%s' at %L must be extensible",
+ gfc_error ("Derived type %qs at %L must be extensible",
c->ts.u.derived->name, &c->where);
error++;
continue;
@@ -8004,10 +8004,10 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns)
|| !gfc_type_is_extension_of (selector_type, c->ts.u.derived)))
{
if (c->ts.type == BT_DERIVED || c->ts.type == BT_CLASS)
- gfc_error ("Derived type '%s' at %L must be an extension of '%s'",
+ gfc_error ("Derived type %qs at %L must be an extension of %qs",
c->ts.u.derived->name, &c->where, selector_type->name);
else
- gfc_error ("Unexpected intrinsic type '%s' at %L",
+ gfc_error ("Unexpected intrinsic type %qs at %L",
gfc_basic_typename (c->ts.type), &c->where);
error++;
continue;
@@ -8656,7 +8656,7 @@ resolve_branch (gfc_st_label *label, gfc_code *code)
/* The label is not in an enclosing block, so illegal. This was
allowed in Fortran 66, so we allow it as extension. No
further checks are necessary in this case. */
- gfc_notify_std (GFC_STD_LEGACY, "Label at %L is not in the same block "
+ gfc_notify_std_1 (GFC_STD_LEGACY, "Label at %L is not in the same block "
"as the GOTO statement at %L", &label->where,
&code->loc);
return;
@@ -9196,15 +9196,15 @@ resolve_ordinary_assign (gfc_code *code, gfc_namespace *ns)
if (rc == ARITH_UNDERFLOW)
gfc_error ("Arithmetic underflow of bit-wise transferred BOZ at %L"
". This check can be disabled with the option "
- "-fno-range-check", &rhs->where);
+ "%<-fno-range-check%>", &rhs->where);
else if (rc == ARITH_OVERFLOW)
gfc_error ("Arithmetic overflow of bit-wise transferred BOZ at %L"
". This check can be disabled with the option "
- "-fno-range-check", &rhs->where);
+ "%<-fno-range-check%>", &rhs->where);
else if (rc == ARITH_NAN)
gfc_error ("Arithmetic NaN of bit-wise transferred BOZ at %L"
". This check can be disabled with the option "
- "-fno-range-check", &rhs->where);
+ "%<-fno-range-check%>", &rhs->where);
return false;
}
}
@@ -9316,7 +9316,7 @@ resolve_ordinary_assign (gfc_code *code, gfc_namespace *ns)
if (!gfc_option.flag_realloc_lhs)
{
gfc_error ("Assignment to an allocatable polymorphic variable at %L "
- "requires -frealloc-lhs", &lhs->where);
+ "requires %<-frealloc-lhs%>", &lhs->where);
return false;
}
/* See PR 43366. */
@@ -10836,19 +10836,19 @@ resolve_fl_var_and_proc (gfc_symbol *sym, int mp_flag)
{
if (dimension && as->type != AS_ASSUMED_RANK)
{
- gfc_error ("Allocatable array '%s' at %L must have a deferred "
+ gfc_error ("Allocatable array %qs at %L must have a deferred "
"shape or assumed rank", sym->name, &sym->declared_at);
return false;
}
else if (!gfc_notify_std (GFC_STD_F2003, "Scalar object "
- "'%s' at %L may not be ALLOCATABLE",
+ "%qs at %L may not be ALLOCATABLE",
sym->name, &sym->declared_at))
return false;
}
if (pointer && dimension && as->type != AS_ASSUMED_RANK)
{
- gfc_error ("Array pointer '%s' at %L must have a deferred shape or "
+ gfc_error ("Array pointer %qs at %L must have a deferred shape or "
"assumed rank", sym->name, &sym->declared_at);
return false;
}
@@ -10858,7 +10858,7 @@ resolve_fl_var_and_proc (gfc_symbol *sym, int mp_flag)
if (!mp_flag && !sym->attr.allocatable && !sym->attr.pointer
&& sym->ts.type != BT_CLASS && !sym->assoc)
{
- gfc_error ("Array '%s' at %L cannot have a deferred shape",
+ gfc_error ("Array %qs at %L cannot have a deferred shape",
sym->name, &sym->declared_at);
return false;
}
@@ -10873,7 +10873,7 @@ resolve_fl_var_and_proc (gfc_symbol *sym, int mp_flag)
&& !UNLIMITED_POLY (sym)
&& !gfc_type_is_extensible (CLASS_DATA (sym)->ts.u.derived))
{
- gfc_error ("Type '%s' of CLASS variable '%s' at %L is not extensible",
+ gfc_error ("Type %qs of CLASS variable %qs at %L is not extensible",
CLASS_DATA (sym)->ts.u.derived->name, sym->name,
&sym->declared_at);
return false;
@@ -10885,7 +10885,7 @@ resolve_fl_var_and_proc (gfc_symbol *sym, int mp_flag)
and excepted from the test. */
if (!sym->attr.class_ok && !sym->attr.use_assoc && !sym->assoc)
{
- gfc_error ("CLASS variable '%s' at %L must be dummy, allocatable "
+ gfc_error ("CLASS variable %qs at %L must be dummy, allocatable "
"or pointer", sym->name, &sym->declared_at);
return false;
}
@@ -10939,7 +10939,7 @@ resolve_fl_variable_derived (gfc_symbol *sym, int no_init_flag)
&& !sym->attr.pointer && !sym->attr.allocatable
&& gfc_has_default_initializer (sym->ts.u.derived)
&& !gfc_notify_std (GFC_STD_F2008, "Implied SAVE for module variable "
- "'%s' at %L, needed due to the default "
+ "%qs at %L, needed due to the default "
"initialization", sym->name, &sym->declared_at))
return false;
@@ -10964,7 +10964,7 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag)
const char *auto_save_msg;
bool saved_specification_expr;
- auto_save_msg = "Automatic object '%s' at %L cannot have the "
+ auto_save_msg = "Automatic object %qs at %L cannot have the "
"SAVE attribute";
if (!resolve_fl_var_and_proc (sym, mp_flag))
@@ -10998,7 +10998,7 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag)
|| sym->attr.allocatable
|| sym->attr.omp_udr_artificial_var))
{
- gfc_error ("Entity '%s' at %L has a deferred type parameter and "
+ gfc_error ("Entity %qs at %L has a deferred type parameter and "
"requires either the pointer or allocatable attribute",
sym->name, &sym->declared_at);
specification_expr = saved_specification_expr;
@@ -11042,7 +11042,7 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag)
}
if (sym->attr.in_common)
{
- gfc_error ("COMMON variable '%s' at %L must have constant "
+ gfc_error ("COMMON variable %qs at %L must have constant "
"character length", sym->name, &sym->declared_at);
specification_expr = saved_specification_expr;
return false;
@@ -11089,23 +11089,23 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag)
{
if (sym->attr.allocatable || (sym->ts.type == BT_CLASS
&& CLASS_DATA (sym)->attr.allocatable))
- gfc_error ("Allocatable '%s' at %L cannot have an initializer",
+ gfc_error ("Allocatable %qs at %L cannot have an initializer",
sym->name, &sym->declared_at);
else if (sym->attr.external)
- gfc_error ("External '%s' at %L cannot have an initializer",
+ gfc_error ("External %qs at %L cannot have an initializer",
sym->name, &sym->declared_at);
else if (sym->attr.dummy
&& !(sym->ts.type == BT_DERIVED && sym->attr.intent == INTENT_OUT))
- gfc_error ("Dummy '%s' at %L cannot have an initializer",
+ gfc_error ("Dummy %qs at %L cannot have an initializer",
sym->name, &sym->declared_at);
else if (sym->attr.intrinsic)
- gfc_error ("Intrinsic '%s' at %L cannot have an initializer",
+ gfc_error ("Intrinsic %qs at %L cannot have an initializer",
sym->name, &sym->declared_at);
else if (sym->attr.result)
- gfc_error ("Function result '%s' at %L cannot have an initializer",
+ gfc_error ("Function result %qs at %L cannot have an initializer",
sym->name, &sym->declared_at);
else if (automatic_flag)
- gfc_error ("Automatic array '%s' at %L cannot have an initializer",
+ gfc_error ("Automatic array %qs at %L cannot have an initializer",
sym->name, &sym->declared_at);
else
goto no_init_error;
@@ -11148,7 +11148,7 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag)
if ((!cl || !cl->length || cl->length->expr_type != EXPR_CONSTANT)
&& sym->attr.proc == PROC_ST_FUNCTION)
{
- gfc_error ("Character-valued statement function '%s' at %L must "
+ gfc_error ("Character-valued statement function %qs at %L must "
"have constant length", sym->name, &sym->declared_at);
return false;
}
@@ -11170,9 +11170,9 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag)
&& arg->sym->ts.type == BT_DERIVED
&& !arg->sym->ts.u.derived->attr.use_assoc
&& !gfc_check_symbol_access (arg->sym->ts.u.derived)
- && !gfc_notify_std (GFC_STD_F2003, "'%s' is of a PRIVATE type "
+ && !gfc_notify_std (GFC_STD_F2003, "%qs is of a PRIVATE type "
"and cannot be a dummy argument"
- " of '%s', which is PUBLIC at %L",
+ " of %qs, which is PUBLIC at %L",
arg->sym->name, sym->name,
&sym->declared_at))
{
@@ -11192,9 +11192,9 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag)
&& arg->sym->ts.type == BT_DERIVED
&& !arg->sym->ts.u.derived->attr.use_assoc
&& !gfc_check_symbol_access (arg->sym->ts.u.derived)
- && !gfc_notify_std (GFC_STD_F2003, "Procedure '%s' in "
- "PUBLIC interface '%s' at %L "
- "takes dummy arguments of '%s' which "
+ && !gfc_notify_std (GFC_STD_F2003, "Procedure %qs in "
+ "PUBLIC interface %qs at %L "
+ "takes dummy arguments of %qs which "
"is PRIVATE", iface->sym->name,
sym->name, &iface->sym->declared_at,
gfc_typename(&arg->sym->ts)))
@@ -11210,7 +11210,7 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag)
if (sym->attr.function && sym->value && sym->attr.proc != PROC_ST_FUNCTION
&& !sym->attr.proc_pointer)
{
- gfc_error ("Function '%s' at %L cannot have an initializer",
+ gfc_error ("Function %qs at %L cannot have an initializer",
sym->name, &sym->declared_at);
return false;
}
@@ -11219,7 +11219,7 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag)
a procedure. Exception: Procedure Pointers. */
if (sym->attr.external && sym->value && !sym->attr.proc_pointer)
{
- gfc_error ("External object '%s' at %L may not have an initializer",
+ gfc_error ("External object %qs at %L may not have an initializer",
sym->name, &sym->declared_at);
return false;
}
@@ -11227,7 +11227,7 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag)
/* An elemental function is required to return a scalar 12.7.1 */
if (sym->attr.elemental && sym->attr.function && sym->as)
{
- gfc_error ("ELEMENTAL function '%s' at %L must have a scalar "
+ gfc_error ("ELEMENTAL function %qs at %L must have a scalar "
"result", sym->name, &sym->declared_at);
/* Reset so that the error only occurs once. */
sym->attr.elemental = 0;
@@ -11237,7 +11237,7 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag)
if (sym->attr.proc == PROC_ST_FUNCTION
&& (sym->attr.allocatable || sym->attr.pointer))
{
- gfc_error ("Statement function '%s' at %L may not have pointer or "
+ gfc_error ("Statement function %qs at %L may not have pointer or "
"allocatable attribute", sym->name, &sym->declared_at);
return false;
}
@@ -11256,19 +11256,19 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag)
|| (sym->attr.recursive) || (sym->attr.pure))
{
if (sym->as && sym->as->rank)
- gfc_error ("CHARACTER(*) function '%s' at %L cannot be "
+ gfc_error ("CHARACTER(*) function %qs at %L cannot be "
"array-valued", sym->name, &sym->declared_at);
if (sym->attr.pointer)
- gfc_error ("CHARACTER(*) function '%s' at %L cannot be "
+ gfc_error ("CHARACTER(*) function %qs at %L cannot be "
"pointer-valued", sym->name, &sym->declared_at);
if (sym->attr.pure)
- gfc_error ("CHARACTER(*) function '%s' at %L cannot be "
+ gfc_error ("CHARACTER(*) function %qs at %L cannot be "
"pure", sym->name, &sym->declared_at);
if (sym->attr.recursive)
- gfc_error ("CHARACTER(*) function '%s' at %L cannot be "
+ gfc_error ("CHARACTER(*) function %qs at %L cannot be "
"recursive", sym->name, &sym->declared_at);
return false;
@@ -11281,7 +11281,7 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag)
if (!sym->attr.contained && !sym->ts.deferred
&& (sym->name[0] != '_' || sym->name[1] != '_'))
gfc_notify_std (GFC_STD_F95_OBS,
- "CHARACTER(*) function '%s' at %L",
+ "CHARACTER(*) function %qs at %L",
sym->name, &sym->declared_at);
}
@@ -11290,13 +11290,13 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag)
{
if (sym->attr.proc_pointer)
{
- gfc_error ("Procedure pointer '%s' at %L shall not be elemental",
+ gfc_error ("Procedure pointer %qs at %L shall not be elemental",
sym->name, &sym->declared_at);
return false;
}
if (sym->attr.dummy)
{
- gfc_error ("Dummy procedure '%s' at %L shall not be elemental",
+ gfc_error ("Dummy procedure %qs at %L shall not be elemental",
sym->name, &sym->declared_at);
return false;
}
@@ -11353,19 +11353,19 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag)
if (sym->attr.save == SAVE_EXPLICIT)
{
gfc_error ("PROCEDURE attribute conflicts with SAVE attribute "
- "in '%s' at %L", sym->name, &sym->declared_at);
+ "in %qs at %L", sym->name, &sym->declared_at);
return false;
}
if (sym->attr.intent)
{
gfc_error ("PROCEDURE attribute conflicts with INTENT attribute "
- "in '%s' at %L", sym->name, &sym->declared_at);
+ "in %qs at %L", sym->name, &sym->declared_at);
return false;
}
if (sym->attr.subroutine && sym->attr.result)
{
gfc_error ("PROCEDURE attribute conflicts with RESULT attribute "
- "in '%s' at %L", sym->name, &sym->declared_at);
+ "in %qs at %L", sym->name, &sym->declared_at);
return false;
}
if (sym->attr.external && sym->attr.function
@@ -11373,12 +11373,12 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag)
|| sym->attr.contained))
{
gfc_error ("EXTERNAL attribute conflicts with FUNCTION attribute "
- "in '%s' at %L", sym->name, &sym->declared_at);
+ "in %qs at %L", sym->name, &sym->declared_at);
return false;
}
if (strcmp ("ppr@", sym->name) == 0)
{
- gfc_error ("Procedure pointer result '%s' at %L "
+ gfc_error ("Procedure pointer result %qs at %L "
"is missing the pointer attribute",
sym->ns->proc_name->name, &sym->declared_at);
return false;
@@ -11450,7 +11450,7 @@ gfc_resolve_finalizers (gfc_symbol* derived, bool *finalizable)
/* Check this exists and is a SUBROUTINE. */
if (!list->proc_sym->attr.subroutine)
{
- gfc_error ("FINAL procedure '%s' at %L is not a SUBROUTINE",
+ gfc_error ("FINAL procedure %qs at %L is not a SUBROUTINE",
list->proc_sym->name, &list->where);
goto error;
}
@@ -11468,7 +11468,7 @@ gfc_resolve_finalizers (gfc_symbol* derived, bool *finalizable)
/* This argument must be of our type. */
if (arg->ts.type != BT_DERIVED || arg->ts.u.derived != derived)
{
- gfc_error ("Argument of FINAL procedure at %L must be of type '%s'",
+ gfc_error ("Argument of FINAL procedure at %L must be of type %qs",
&arg->declared_at, derived->name);
goto error;
}
@@ -11527,8 +11527,8 @@ gfc_resolve_finalizers (gfc_symbol* derived, bool *finalizable)
const int i_rank = (i_arg->as ? i_arg->as->rank : 0);
if (i_rank == my_rank)
{
- gfc_error ("FINAL procedure '%s' declared at %L has the same"
- " rank (%d) as '%s'",
+ gfc_error ("FINAL procedure %qs declared at %L has the same"
+ " rank (%d) as %qs",
list->proc_sym->name, &list->where, my_rank,
i->proc_sym->name);
goto error;
@@ -11604,8 +11604,8 @@ check_generic_tbp_ambiguity (gfc_tbp_generic* t1, gfc_tbp_generic* t2,
if (sym1->attr.subroutine != sym2->attr.subroutine
|| sym1->attr.function != sym2->attr.function)
{
- gfc_error ("'%s' and '%s' can't be mixed FUNCTION/SUBROUTINE for"
- " GENERIC '%s' at %L",
+ gfc_error ("%qs and %qs can't be mixed FUNCTION/SUBROUTINE for"
+ " GENERIC %qs at %L",
sym1->name, sym2->name, generic_name, &where);
return false;
}
@@ -11640,7 +11640,7 @@ check_generic_tbp_ambiguity (gfc_tbp_generic* t1, gfc_tbp_generic* t2,
if (gfc_compare_interfaces (sym1, sym2, sym2->name, !t1->is_operator, 0,
NULL, 0, pass1, pass2))
{
- gfc_error ("'%s' and '%s' for GENERIC '%s' at %L are ambiguous",
+ gfc_error ("%qs and %qs for GENERIC %qs at %L are ambiguous",
sym1->name, sym2->name, generic_name, &where);
return false;
}
@@ -11699,7 +11699,7 @@ resolve_tb_generic_targets (gfc_symbol* super_type,
}
}
- gfc_error ("Undefined specific binding '%s' as target of GENERIC '%s'"
+ gfc_error ("Undefined specific binding %qs as target of GENERIC %qs"
" at %L", target_name, name, &p->where);
return false;
@@ -11711,8 +11711,8 @@ specific_found:
/* This must really be a specific binding! */
if (target->specific->is_generic)
{
- gfc_error ("GENERIC '%s' at %L must target a specific binding,"
- " '%s' is GENERIC, too", name, &p->where, target_name);
+ gfc_error ("GENERIC %qs at %L must target a specific binding,"
+ " %qs is GENERIC, too", name, &p->where, target_name);
return false;
}
@@ -11739,7 +11739,7 @@ specific_found:
/* If we attempt to "overwrite" a specific binding, this is an error. */
if (p->overridden && !p->overridden->is_generic)
{
- gfc_error ("GENERIC '%s' at %L can't overwrite specific binding with"
+ gfc_error ("GENERIC %qs at %L can't overwrite specific binding with"
" the same name", name, &p->where);
return false;
}
@@ -11977,7 +11977,7 @@ resolve_typebound_procedure (gfc_symtree* stree)
&& proc->attr.if_source != IFSRC_IFBODY)
|| proc->attr.abstract)
{
- gfc_error ("'%s' must be a module procedure or an external procedure with"
+ gfc_error ("%qs must be a module procedure or an external procedure with"
" an explicit interface at %L", proc->name, &where);
goto error;
}
@@ -12019,8 +12019,8 @@ resolve_typebound_procedure (gfc_symtree* stree)
if (!me_arg)
{
- gfc_error ("Procedure '%s' with PASS(%s) at %L has no"
- " argument '%s'",
+ gfc_error ("Procedure %qs with PASS(%s) at %L has no"
+ " argument %qs",
proc->name, stree->n.tb->pass_arg, &where,
stree->n.tb->pass_arg);
goto error;
@@ -12033,7 +12033,7 @@ resolve_typebound_procedure (gfc_symtree* stree)
stree->n.tb->pass_arg_num = 1;
if (!dummy_args)
{
- gfc_error ("Procedure '%s' with PASS at %L must have at"
+ gfc_error ("Procedure %qs with PASS at %L must have at"
" least one argument", proc->name, &where);
goto error;
}
@@ -12047,7 +12047,7 @@ resolve_typebound_procedure (gfc_symtree* stree)
if (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", proc->name, &where);
goto error;
}
@@ -12055,8 +12055,8 @@ resolve_typebound_procedure (gfc_symtree* stree)
if (CLASS_DATA (me_arg)->ts.u.derived
!= resolve_bindings_derived)
{
- gfc_error ("Argument '%s' of '%s' with PASS(%s) at %L must be of"
- " the derived-type '%s'", me_arg->name, proc->name,
+ gfc_error ("Argument %qs of %qs with PASS(%s) at %L must be of"
+ " the derived-type %qs", me_arg->name, proc->name,
me_arg->name, &where, resolve_bindings_derived->name);
goto error;
}
@@ -12064,19 +12064,19 @@ resolve_typebound_procedure (gfc_symtree* stree)
gcc_assert (me_arg->ts.type == BT_CLASS);
if (CLASS_DATA (me_arg)->as && CLASS_DATA (me_arg)->as->rank != 0)
{
- gfc_error ("Passed-object dummy argument of '%s' at %L must be"
+ gfc_error ("Passed-object dummy argument of %qs at %L must be"
" scalar", proc->name, &where);
goto error;
}
if (CLASS_DATA (me_arg)->attr.allocatable)
{
- gfc_error ("Passed-object dummy argument of '%s' at %L must not"
+ gfc_error ("Passed-object dummy argument of %qs at %L must not"
" be ALLOCATABLE", proc->name, &where);
goto error;
}
if (CLASS_DATA (me_arg)->attr.class_pointer)
{
- gfc_error ("Passed-object dummy argument of '%s' at %L must not"
+ gfc_error ("Passed-object dummy argument of %qs at %L must not"
" be POINTER", proc->name, &where);
goto error;
}
@@ -12105,8 +12105,8 @@ resolve_typebound_procedure (gfc_symtree* stree)
for (comp = resolve_bindings_derived->components; comp; comp = comp->next)
if (!strcmp (comp->name, stree->name))
{
- gfc_error ("Procedure '%s' at %L has the same name as a component of"
- " '%s'",
+ gfc_error ("Procedure %qs at %L has the same name as a component of"
+ " %qs",
stree->name, &where, resolve_bindings_derived->name);
goto error;
}
@@ -12114,8 +12114,8 @@ resolve_typebound_procedure (gfc_symtree* stree)
/* Try to find a name collision with an inherited component. */
if (super_type && gfc_find_component (super_type, stree->name, true, true))
{
- gfc_error ("Procedure '%s' at %L has the same name as an inherited"
- " component of '%s'",
+ gfc_error ("Procedure %qs at %L has the same name as an inherited"
+ " component of %qs",
stree->name, &where, resolve_bindings_derived->name);
goto error;
}
@@ -12206,8 +12206,8 @@ ensure_not_abstract_walker (gfc_symbol* sub, gfc_symtree* st)
gcc_assert (overriding->n.tb);
if (overriding->n.tb->deferred)
{
- gfc_error ("Derived-type '%s' declared at %L must be ABSTRACT because"
- " '%s' is DEFERRED and not overridden",
+ gfc_error ("Derived-type %qs declared at %L must be ABSTRACT because"
+ " %qs is DEFERRED and not overridden",
sub->name, &sub->declared_at, st->name);
return false;
}
@@ -12304,8 +12304,8 @@ resolve_fl_derived0 (gfc_symbol *sym)
/* F2008, C432. */
if (super_type && sym->attr.coarray_comp && !super_type->attr.coarray_comp)
{
- gfc_error ("As extending type '%s' at %L has a coarray component, "
- "parent type '%s' shall also have one", sym->name,
+ gfc_error ("As extending type %qs at %L has a coarray component, "
+ "parent type %qs shall also have one", sym->name,
&sym->declared_at, super_type->name);
return false;
}
@@ -12317,7 +12317,7 @@ resolve_fl_derived0 (gfc_symbol *sym)
/* An ABSTRACT type must be extensible. */
if (sym->attr.abstract && !gfc_type_is_extensible (sym))
{
- gfc_error ("Non-extensible derived-type '%s' at %L must not be ABSTRACT",
+ gfc_error ("Non-extensible derived-type %qs at %L must not be ABSTRACT",
sym->name, &sym->declared_at);
return false;
}
@@ -12606,9 +12606,9 @@ resolve_fl_derived0 (gfc_symbol *sym)
&& !is_sym_host_assoc (c->ts.u.derived, sym->ns)
&& !c->ts.u.derived->attr.use_assoc
&& !gfc_check_symbol_access (c->ts.u.derived)
- && !gfc_notify_std (GFC_STD_F2003, "the component '%s' is a "
+ && !gfc_notify_std (GFC_STD_F2003, "the component %qs is a "
"PRIVATE type and cannot be a component of "
- "'%s', which is PUBLIC at %L", c->name,
+ "%qs, which is PUBLIC at %L", c->name,
sym->name, &sym->declared_at))
return false;
@@ -12730,7 +12730,7 @@ resolve_fl_derived (gfc_symbol *sym)
if (gen_dt && gen_dt->generic && gen_dt->generic->next
&& (!gen_dt->generic->sym->attr.use_assoc
|| gen_dt->generic->sym->module != gen_dt->generic->next->sym->module)
- && !gfc_notify_std (GFC_STD_F2003, "Generic name '%s' of function "
+ && !gfc_notify_std_1 (GFC_STD_F2003, "Generic name '%s' of function "
"'%s' at %L being the same name as derived "
"type at %L", sym->name,
gen_dt->generic->sym == sym
@@ -12786,29 +12786,29 @@ resolve_fl_namelist (gfc_symbol *sym)
after the decl. */
if (nl->sym->as && nl->sym->as->type == AS_ASSUMED_SIZE)
{
- gfc_error ("Assumed size array '%s' in namelist '%s' at %L is not "
+ gfc_error ("Assumed size array %qs in namelist %qs at %L is not "
"allowed", nl->sym->name, sym->name, &sym->declared_at);
return false;
}
if (nl->sym->as && nl->sym->as->type == AS_ASSUMED_SHAPE
- && !gfc_notify_std (GFC_STD_F2003, "NAMELIST array object '%s' "
- "with assumed shape in namelist '%s' at %L",
+ && !gfc_notify_std (GFC_STD_F2003, "NAMELIST array object %qs "
+ "with assumed shape in namelist %qs at %L",
nl->sym->name, sym->name, &sym->declared_at))
return false;
if (is_non_constant_shape_array (nl->sym)
- && !gfc_notify_std (GFC_STD_F2003, "NAMELIST array object '%s' "
- "with nonconstant shape in namelist '%s' at %L",
+ && !gfc_notify_std (GFC_STD_F2003, "NAMELIST array object %qs "
+ "with nonconstant shape in namelist %qs at %L",
nl->sym->name, sym->name, &sym->declared_at))
return false;
if (nl->sym->ts.type == BT_CHARACTER
&& (nl->sym->ts.u.cl->length == NULL
|| !gfc_is_constant_expr (nl->sym->ts.u.cl->length))
- && !gfc_notify_std (GFC_STD_F2003, "NAMELIST object '%s' with "
+ && !gfc_notify_std (GFC_STD_F2003, "NAMELIST object %qs with "
"nonconstant character length in "
- "namelist '%s' at %L", nl->sym->name,
+ "namelist %qs at %L", nl->sym->name,
sym->name, &sym->declared_at))
return false;
@@ -12816,7 +12816,7 @@ resolve_fl_namelist (gfc_symbol *sym)
removed. */
if (nl->sym->ts.type == BT_CLASS)
{
- gfc_error ("NAMELIST object '%s' in namelist '%s' at %L is "
+ gfc_error ("NAMELIST object %qs in namelist %qs at %L is "
"polymorphic and requires a defined input/output "
"procedure", nl->sym->name, sym->name, &sym->declared_at);
return false;
@@ -12826,15 +12826,15 @@ resolve_fl_namelist (gfc_symbol *sym)
&& (nl->sym->ts.u.derived->attr.alloc_comp
|| nl->sym->ts.u.derived->attr.pointer_comp))
{
- if (!gfc_notify_std (GFC_STD_F2003, "NAMELIST object '%s' in "
- "namelist '%s' at %L with ALLOCATABLE "
+ if (!gfc_notify_std (GFC_STD_F2003, "NAMELIST object %qs in "
+ "namelist %qs at %L with ALLOCATABLE "
"or POINTER components", nl->sym->name,
sym->name, &sym->declared_at))
return false;
/* FIXME: Once UDDTIO is implemented, the following can be
removed. */
- gfc_error ("NAMELIST object '%s' in namelist '%s' at %L has "
+ gfc_error ("NAMELIST object %qs in namelist %qs at %L has "
"ALLOCATABLE or POINTER components and thus requires "
"a defined input/output procedure", nl->sym->name,
sym->name, &sym->declared_at);
@@ -12851,8 +12851,8 @@ resolve_fl_namelist (gfc_symbol *sym)
&& !is_sym_host_assoc (nl->sym, sym->ns)
&& !gfc_check_symbol_access (nl->sym))
{
- gfc_error ("NAMELIST object '%s' was declared PRIVATE and "
- "cannot be member of PUBLIC namelist '%s' at %L",
+ gfc_error ("NAMELIST object %qs was declared PRIVATE and "
+ "cannot be member of PUBLIC namelist %qs at %L",
nl->sym->name, sym->name, &sym->declared_at);
return false;
}
@@ -12861,8 +12861,8 @@ resolve_fl_namelist (gfc_symbol *sym)
if (nl->sym->ts.type == BT_DERIVED
&& derived_inaccessible (nl->sym->ts.u.derived))
{
- gfc_error ("NAMELIST object '%s' has use-associated PRIVATE "
- "components and cannot be member of namelist '%s' at %L",
+ gfc_error ("NAMELIST object %qs has use-associated PRIVATE "
+ "components and cannot be member of namelist %qs at %L",
nl->sym->name, sym->name, &sym->declared_at);
return false;
}
@@ -12872,8 +12872,8 @@ resolve_fl_namelist (gfc_symbol *sym)
&& !is_sym_host_assoc (nl->sym->ts.u.derived, sym->ns)
&& nl->sym->ts.u.derived->attr.private_comp)
{
- gfc_error ("NAMELIST object '%s' has PRIVATE components and "
- "cannot be a member of PUBLIC namelist '%s' at %L",
+ gfc_error ("NAMELIST object %qs has PRIVATE components and "
+ "cannot be a member of PUBLIC namelist %qs at %L",
nl->sym->name, sym->name, &sym->declared_at);
return false;
}
@@ -12900,7 +12900,7 @@ resolve_fl_namelist (gfc_symbol *sym)
if (nlsym && nlsym->attr.flavor == FL_PROCEDURE)
{
gfc_error ("PROCEDURE attribute conflicts with NAMELIST "
- "attribute in '%s' at %L", nlsym->name,
+ "attribute in %qs at %L", nlsym->name,
&sym->declared_at);
return false;
}
@@ -12918,7 +12918,7 @@ resolve_fl_parameter (gfc_symbol *sym)
&& (sym->as->type == AS_DEFERRED
|| is_non_constant_shape_array (sym)))
{
- gfc_error ("Parameter array '%s' at %L cannot be automatic "
+ gfc_error ("Parameter array %qs at %L cannot be automatic "
"or of deferred shape", sym->name, &sym->declared_at);
return false;
}
@@ -12930,7 +12930,7 @@ resolve_fl_parameter (gfc_symbol *sym)
&& !gfc_compare_types (&sym->ts, gfc_get_default_type (sym->name,
sym->ns)))
{
- gfc_error ("Implicitly typed PARAMETER '%s' at %L doesn't match a "
+ gfc_error ("Implicitly typed PARAMETER %qs at %L doesn't match a "
"later IMPLICIT type", sym->name, &sym->declared_at);
return false;
}
@@ -13117,7 +13117,7 @@ resolve_symbol (gfc_symbol *sym)
|| (as->type != AS_ASSUMED_SHAPE && as->type != AS_ASSUMED_RANK
&& !class_attr.pointer)))
{
- gfc_error ("'%s' at %L has the CONTIGUOUS attribute but is not an "
+ gfc_error ("%qs at %L has the CONTIGUOUS attribute but is not an "
"array pointer or an assumed-shape or assumed-rank array",
sym->name, &sym->declared_at);
return;
@@ -13172,7 +13172,7 @@ resolve_symbol (gfc_symbol *sym)
if (sym->attr.value && !sym->attr.dummy)
{
- gfc_error ("'%s' at %L cannot have the VALUE attribute because "
+ gfc_error ("%qs at %L cannot have the VALUE attribute because "
"it is not a dummy argument", sym->name, &sym->declared_at);
return;
}
@@ -13182,7 +13182,7 @@ resolve_symbol (gfc_symbol *sym)
gfc_charlen *cl = sym->ts.u.cl;
if (!cl || !cl->length || cl->length->expr_type != EXPR_CONSTANT)
{
- gfc_error ("Character dummy variable '%s' at %L with VALUE "
+ gfc_error ("Character dummy variable %qs at %L with VALUE "
"attribute must have constant length",
sym->name, &sym->declared_at);
return;
@@ -13191,7 +13191,7 @@ resolve_symbol (gfc_symbol *sym)
if (sym->ts.is_c_interop
&& mpz_cmp_si (cl->length->value.integer, 1) != 0)
{
- gfc_error ("C interoperable character dummy variable '%s' at %L "
+ gfc_error ("C interoperable character dummy variable %qs at %L "
"with VALUE attribute must have length one",
sym->name, &sym->declared_at);
return;
@@ -13204,7 +13204,7 @@ resolve_symbol (gfc_symbol *sym)
sym->ts.u.derived = gfc_find_dt_in_generic (sym->ts.u.derived);
if (!sym->ts.u.derived)
{
- gfc_error ("The derived type '%s' at %L is of type '%s', "
+ gfc_error ("The derived type %qs at %L is of type %qs, "
"which has not been defined", sym->name,
&sym->declared_at, sym->ts.u.derived->name);
sym->ts.type = BT_UNKNOWN;
@@ -13371,7 +13371,7 @@ resolve_symbol (gfc_symbol *sym)
&& sym->ts.u.derived->components == NULL
&& !sym->ts.u.derived->attr.zero_comp)
{
- gfc_error ("The derived type '%s' at %L is of type '%s', "
+ gfc_error ("The derived type %qs at %L is of type %qs, "
"which has not been defined", sym->name,
&sym->declared_at, sym->ts.u.derived->name);
sym->ts.type = BT_UNKNOWN;
@@ -13397,8 +13397,8 @@ resolve_symbol (gfc_symbol *sym)
&& !sym->ts.u.derived->attr.use_assoc
&& gfc_check_symbol_access (sym)
&& !gfc_check_symbol_access (sym->ts.u.derived)
- && !gfc_notify_std (GFC_STD_F2003, "PUBLIC %s '%s' at %L of PRIVATE "
- "derived type '%s'",
+ && !gfc_notify_std (GFC_STD_F2003, "PUBLIC %s %qs at %L of PRIVATE "
+ "derived type %qs",
(sym->attr.flavor == FL_PARAMETER)
? "parameter" : "variable",
sym->name, &sym->declared_at,
@@ -13430,7 +13430,7 @@ resolve_symbol (gfc_symbol *sym)
{
if (c->initializer)
{
- gfc_error ("The INTENT(OUT) dummy argument '%s' at %L is "
+ gfc_error ("The INTENT(OUT) dummy argument %qs at %L is "
"ASSUMED SIZE and so cannot have a default initializer",
sym->name, &sym->declared_at);
return;
@@ -13442,7 +13442,7 @@ resolve_symbol (gfc_symbol *sym)
if (sym->ts.type == BT_DERIVED && sym->attr.dummy
&& sym->attr.intent == INTENT_OUT && sym->attr.lock_comp)
{
- gfc_error ("Dummy argument '%s' at %L of LOCK_TYPE shall not be "
+ gfc_error ("Dummy argument %qs at %L of LOCK_TYPE shall not be "
"INTENT(OUT)", sym->name, &sym->declared_at);
return;
}
@@ -13454,7 +13454,7 @@ resolve_symbol (gfc_symbol *sym)
|| class_attr.codimension)
&& (sym->attr.result || sym->result == sym))
{
- gfc_error ("Function result '%s' at %L shall not be a coarray or have "
+ gfc_error ("Function result %qs at %L shall not be a coarray or have "
"a coarray component", sym->name, &sym->declared_at);
return;
}
@@ -13463,7 +13463,7 @@ resolve_symbol (gfc_symbol *sym)
if (sym->attr.codimension && sym->ts.type == BT_DERIVED
&& sym->ts.u.derived->ts.is_iso_c)
{
- gfc_error ("Variable '%s' at %L of TYPE(C_PTR) or TYPE(C_FUNPTR) "
+ gfc_error ("Variable %qs at %L of TYPE(C_PTR) or TYPE(C_FUNPTR) "
"shall not be a coarray", sym->name, &sym->declared_at);
return;
}
@@ -13475,7 +13475,7 @@ resolve_symbol (gfc_symbol *sym)
&& (class_attr.codimension || class_attr.pointer || class_attr.dimension
|| class_attr.allocatable))
{
- gfc_error ("Variable '%s' at %L with coarray component shall be a "
+ gfc_error ("Variable %qs at %L with coarray component shall be a "
"nonpointer, nonallocatable scalar, which is not a coarray",
sym->name, &sym->declared_at);
return;
@@ -13490,7 +13490,7 @@ resolve_symbol (gfc_symbol *sym)
|| sym->ns->proc_name->attr.is_main_program
|| sym->attr.function || sym->attr.result || sym->attr.use_assoc))
{
- gfc_error ("Variable '%s' at %L is a coarray and is not ALLOCATABLE, SAVE "
+ gfc_error ("Variable %qs at %L is a coarray and is not ALLOCATABLE, SAVE "
"nor a dummy argument", sym->name, &sym->declared_at);
return;
}
@@ -13498,14 +13498,14 @@ resolve_symbol (gfc_symbol *sym)
else if (class_attr.codimension && !sym->attr.select_type_temporary
&& !class_attr.allocatable && as && as->cotype == AS_DEFERRED)
{
- gfc_error ("Coarray variable '%s' at %L shall not have codimensions with "
+ gfc_error ("Coarray variable %qs at %L shall not have codimensions with "
"deferred shape", sym->name, &sym->declared_at);
return;
}
else if (class_attr.codimension && class_attr.allocatable && as
&& (as->cotype != AS_DEFERRED || as->type != AS_DEFERRED))
{
- gfc_error ("Allocatable coarray variable '%s' at %L must have "
+ gfc_error ("Allocatable coarray variable %qs at %L must have "
"deferred shape", sym->name, &sym->declared_at);
return;
}
@@ -13517,7 +13517,7 @@ resolve_symbol (gfc_symbol *sym)
|| (class_attr.codimension && class_attr.allocatable))
&& sym->attr.dummy && sym->attr.intent == INTENT_OUT)
{
- gfc_error ("Variable '%s' at %L is INTENT(OUT) and can thus not be an "
+ gfc_error ("Variable %qs at %L is INTENT(OUT) and can thus not be an "
"allocatable coarray or have coarray components",
sym->name, &sym->declared_at);
return;
@@ -13526,8 +13526,8 @@ resolve_symbol (gfc_symbol *sym)
if (class_attr.codimension && sym->attr.dummy
&& sym->ns->proc_name && sym->ns->proc_name->attr.is_bind_c)
{
- gfc_error ("Coarray dummy variable '%s' at %L not allowed in BIND(C) "
- "procedure '%s'", sym->name, &sym->declared_at,
+ gfc_error ("Coarray dummy variable %qs at %L not allowed in BIND(C) "
+ "procedure %qs", sym->name, &sym->declared_at,
sym->ns->proc_name->name);
return;
}
@@ -13542,15 +13542,15 @@ resolve_symbol (gfc_symbol *sym)
if (gfc_logical_kinds[i].kind == sym->ts.kind)
break;
if (!gfc_logical_kinds[i].c_bool && sym->attr.dummy
- && !gfc_notify_std (GFC_STD_GNU, "LOGICAL dummy argument '%s' at "
+ && !gfc_notify_std (GFC_STD_GNU, "LOGICAL dummy argument %qs at "
"%L with non-C_Bool kind in BIND(C) procedure "
- "'%s'", sym->name, &sym->declared_at,
+ "%qs", sym->name, &sym->declared_at,
sym->ns->proc_name->name))
return;
else if (!gfc_logical_kinds[i].c_bool
&& !gfc_notify_std (GFC_STD_GNU, "LOGICAL result variable "
- "'%s' at %L with non-C_Bool kind in "
- "BIND(C) procedure '%s'", sym->name,
+ "%qs at %L with non-C_Bool kind in "
+ "BIND(C) procedure %qs", sym->name,
&sym->declared_at,
sym->attr.function ? sym->name
: sym->ns->proc_name->name))
@@ -13638,7 +13638,7 @@ resolve_symbol (gfc_symbol *sym)
&& sym->module == NULL
&& (sym->ns->proc_name == NULL
|| sym->ns->proc_name->attr.flavor != FL_MODULE)))
- gfc_error ("!$OMP DECLARE TARGET variable '%s' at %L isn't SAVEd",
+ gfc_error ("!$OMP DECLARE TARGET variable %qs at %L isn't SAVEd",
sym->name, &sym->declared_at);
/* If we have come this far we can apply default-initializers, as
@@ -13731,13 +13731,13 @@ check_data_variable (gfc_data_variable *var, locus *where)
if (sym->ns->is_block_data && !sym->attr.in_common)
{
- gfc_error ("BLOCK DATA element '%s' at %L must be in COMMON",
+ gfc_error ("BLOCK DATA element %qs at %L must be in COMMON",
sym->name, &sym->declared_at);
}
if (e->ref == NULL && sym->as)
{
- gfc_error ("DATA array '%s' at %L must be specified in a previous"
+ gfc_error ("DATA array %qs at %L must be specified in a previous"
" declaration", sym->name, where);
return false;
}
@@ -13746,7 +13746,7 @@ check_data_variable (gfc_data_variable *var, locus *where)
if (gfc_is_coindexed (e))
{
- gfc_error ("DATA element '%s' at %L cannot have a coindex", sym->name,
+ gfc_error ("DATA element %qs at %L cannot have a coindex", sym->name,
where);
return false;
}
@@ -13760,7 +13760,7 @@ check_data_variable (gfc_data_variable *var, locus *where)
&& ref->type == REF_ARRAY
&& ref->u.ar.type != AR_FULL)
{
- gfc_error ("DATA element '%s' at %L is a pointer and so must "
+ gfc_error ("DATA element %qs at %L is a pointer and so must "
"be a full array", sym->name, where);
return false;
}
@@ -14313,7 +14313,7 @@ resolve_equivalence_derived (gfc_symbol *derived, gfc_symbol *sym, gfc_expr *e)
/* Shall not be an object of nonsequence derived type. */
if (!derived->attr.sequence)
{
- gfc_error ("Derived type variable '%s' at %L must have SEQUENCE "
+ gfc_error ("Derived type variable %qs at %L must have SEQUENCE "
"attribute to be an EQUIVALENCE object", sym->name,
&e->where);
return false;
@@ -14322,7 +14322,7 @@ resolve_equivalence_derived (gfc_symbol *derived, gfc_symbol *sym, gfc_expr *e)
/* Shall not have allocatable components. */
if (derived->attr.alloc_comp)
{
- gfc_error ("Derived type variable '%s' at %L cannot have ALLOCATABLE "
+ gfc_error ("Derived type variable %qs at %L cannot have ALLOCATABLE "
"components to be an EQUIVALENCE object",sym->name,
&e->where);
return false;
@@ -14330,7 +14330,7 @@ resolve_equivalence_derived (gfc_symbol *derived, gfc_symbol *sym, gfc_expr *e)
if (sym->attr.in_common && gfc_has_default_initializer (sym->ts.u.derived))
{
- gfc_error ("Derived type variable '%s' at %L with default "
+ gfc_error ("Derived type variable %qs at %L with default "
"initialization cannot be in EQUIVALENCE with a variable "
"in COMMON", sym->name, &e->where);
return false;
@@ -14346,7 +14346,7 @@ resolve_equivalence_derived (gfc_symbol *derived, gfc_symbol *sym, gfc_expr *e)
in the structure. */
if (c->attr.pointer)
{
- gfc_error ("Derived type variable '%s' at %L with pointer "
+ gfc_error ("Derived type variable %qs at %L with pointer "
"component(s) cannot be an EQUIVALENCE object",
sym->name, &e->where);
return false;
@@ -14476,8 +14476,8 @@ resolve_equivalence (gfc_equiv *eq)
&& sym->ns->proc_name->attr.pure
&& sym->attr.in_common)
{
- gfc_error ("Common block member '%s' at %L cannot be an EQUIVALENCE "
- "object in the pure procedure '%s'",
+ gfc_error ("Common block member %qs at %L cannot be an EQUIVALENCE "
+ "object in the pure procedure %qs",
sym->name, &e->where, sym->ns->proc_name->name);
break;
}
@@ -14485,7 +14485,7 @@ resolve_equivalence (gfc_equiv *eq)
/* Shall not be a named constant. */
if (e->expr_type == EXPR_CONSTANT)
{
- gfc_error ("Named constant '%s' at %L cannot be an EQUIVALENCE "
+ gfc_error ("Named constant %qs at %L cannot be an EQUIVALENCE "
"object", sym->name, &e->where);
continue;
}
@@ -14533,14 +14533,14 @@ resolve_equivalence (gfc_equiv *eq)
&& !gfc_notify_std (GFC_STD_GNU, msg, sym->name, &e->where)))
continue;
- msg ="Non-CHARACTER object '%s' in default CHARACTER "
+ msg ="Non-CHARACTER object %qs in default CHARACTER "
"EQUIVALENCE statement at %L";
if (last_eq_type == SEQ_CHARACTER
&& eq_type != SEQ_CHARACTER
&& !gfc_notify_std (GFC_STD_GNU, msg, sym->name, &e->where))
continue;
- msg ="Non-NUMERIC object '%s' in default NUMERIC "
+ msg ="Non-NUMERIC object %qs in default NUMERIC "
"EQUIVALENCE statement at %L";
if (last_eq_type == SEQ_NUMERIC
&& eq_type != SEQ_NUMERIC
@@ -14558,7 +14558,7 @@ resolve_equivalence (gfc_equiv *eq)
if (e->ref->type == REF_ARRAY
&& !gfc_resolve_array_spec (e->ref->u.ar.as, 1))
{
- gfc_error ("Array '%s' at %L with non-constant bounds cannot be "
+ gfc_error ("Array %qs at %L with non-constant bounds cannot be "
"an EQUIVALENCE object", sym->name, &e->where);
continue;
}
@@ -14569,7 +14569,7 @@ resolve_equivalence (gfc_equiv *eq)
/* Shall not be a structure component. */
if (r->type == REF_COMPONENT)
{
- gfc_error ("Structure component '%s' at %L cannot be an "
+ gfc_error ("Structure component %qs at %L cannot be an "
"EQUIVALENCE object",
r->u.c.component->name, &e->where);
break;
@@ -14613,7 +14613,7 @@ resolve_fntype (gfc_namespace *ns)
&& !gfc_set_default_type (sym, 0, NULL)
&& !sym->attr.untyped)
{
- gfc_error ("Function '%s' at %L has no IMPLICIT type",
+ gfc_error ("Function %qs at %L has no IMPLICIT type",
sym->name, &sym->declared_at);
sym->attr.untyped = 1;
}
@@ -14623,8 +14623,8 @@ resolve_fntype (gfc_namespace *ns)
&& !gfc_check_symbol_access (sym->ts.u.derived)
&& gfc_check_symbol_access (sym))
{
- gfc_notify_std (GFC_STD_F2003, "PUBLIC function '%s' at "
- "%L of PRIVATE type '%s'", sym->name,
+ gfc_notify_std (GFC_STD_F2003, "PUBLIC function %qs at "
+ "%L of PRIVATE type %qs", sym->name,
&sym->declared_at, sym->ts.u.derived->name);
}
@@ -14636,7 +14636,7 @@ resolve_fntype (gfc_namespace *ns)
&& !gfc_set_default_type (el->sym, 0, NULL)
&& !el->sym->attr.untyped)
{
- gfc_error ("ENTRY '%s' at %L has no IMPLICIT type",
+ gfc_error ("ENTRY %qs at %L has no IMPLICIT type",
el->sym->name, &el->sym->declared_at);
el->sym->attr.untyped = 1;
}
@@ -14653,7 +14653,7 @@ check_uop_procedure (gfc_symbol *sym, locus where)
if (!sym->attr.function)
{
- gfc_error ("User operator procedure '%s' at %L must be a FUNCTION",
+ gfc_error ("User operator procedure %qs at %L must be a FUNCTION",
sym->name, &where);
return false;
}
@@ -14663,7 +14663,7 @@ check_uop_procedure (gfc_symbol *sym, locus where)
&& !(sym->result && sym->result->ts.u.cl
&& sym->result->ts.u.cl->length))
{
- gfc_error ("User operator procedure '%s' at %L cannot be assumed "
+ gfc_error ("User operator procedure %qs at %L cannot be assumed "
"character length", sym->name, &where);
return false;
}
@@ -14671,7 +14671,7 @@ check_uop_procedure (gfc_symbol *sym, locus where)
formal = gfc_sym_get_dummy_args (sym);
if (!formal || !formal->sym)
{
- gfc_error ("User operator procedure '%s' at %L must have at least "
+ gfc_error ("User operator procedure %qs at %L must have at least "
"one argument", sym->name, &where);
return false;
}
@@ -14785,7 +14785,7 @@ resolve_types (gfc_namespace *ns)
for (n = ns->contained; n; n = n->sibling)
{
if (gfc_pure (ns->proc_name) && !gfc_pure (n->proc_name))
- gfc_error ("Contained procedure '%s' at %L of a PURE procedure must "
+ gfc_error ("Contained procedure %qs at %L of a PURE procedure must "
"also be PURE", n->proc_name->name,
&n->proc_name->declared_at);
@@ -6928,7 +6928,7 @@ gfc_convert_char_constant (gfc_expr *e, bt type ATTRIBUTE_UNUSED, int kind)
if (!gfc_check_character_range (result->value.character.string[i],
kind))
{
- gfc_error ("Character '%s' in string at %L cannot be converted "
+ gfc_error ("Character %qs in string at %L cannot be converted "
"into character kind %d",
gfc_print_wide_char (result->value.character.string[i]),
&e->where, kind);
@@ -165,7 +165,7 @@ gfc_add_new_implicit_range (int c1, int c2)
{
if (new_flag[i])
{
- gfc_error ("Letter '%c' already set in IMPLICIT statement at %C",
+ gfc_error ("Letter %<%c%> already set in IMPLICIT statement at %C",
i + 'A');
return false;
}
@@ -253,7 +253,7 @@ gfc_set_default_type (gfc_symbol *sym, int error_flag, gfc_namespace *ns)
{
if (error_flag && !sym->attr.untyped)
{
- gfc_error ("Symbol '%s' at %L has no IMPLICIT type",
+ gfc_error ("Symbol %qs at %L has no IMPLICIT type",
sym->name, &sym->declared_at);
sym->attr.untyped = 1; /* Ensure we only give an error once. */
}
@@ -330,7 +330,7 @@ gfc_check_function_type (gfc_namespace *ns)
}
else if (!proc->result->attr.proc_pointer)
{
- gfc_error ("Function result '%s' at %L has no IMPLICIT type",
+ gfc_error ("Function result %qs at %L has no IMPLICIT type",
proc->result->name, &proc->result->declared_at);
proc->result->attr.untyped = 1;
}
@@ -772,7 +772,7 @@ conflict:
gfc_error ("%s attribute conflicts with %s attribute at %L",
a1, a2, where);
else
- gfc_error ("%s attribute conflicts with %s attribute in '%s' at %L",
+ gfc_error ("%s attribute conflicts with %s attribute in %qs at %L",
a1, a2, name, where);
return false;
@@ -787,7 +787,7 @@ conflict_std:
else
{
return gfc_notify_std (standard, "%s attribute "
- "with %s attribute in '%s' at %L",
+ "with %s attribute in %qs at %L",
a1, a2, name, where);
}
}
@@ -917,7 +917,7 @@ gfc_add_codimension (symbol_attribute *attr, const char *name, locus *where)
if (attr->flavor == FL_PROCEDURE && attr->if_source == IFSRC_IFBODY
&& !gfc_find_state (COMP_INTERFACE))
{
- gfc_error ("CODIMENSION specified for '%s' outside its INTERFACE body "
+ gfc_error ("CODIMENSION specified for %qs outside its INTERFACE body "
"at %L", name, where);
return false;
}
@@ -943,7 +943,7 @@ gfc_add_dimension (symbol_attribute *attr, const char *name, locus *where)
if (attr->flavor == FL_PROCEDURE && attr->if_source == IFSRC_IFBODY
&& !gfc_find_state (COMP_INTERFACE))
{
- gfc_error ("DIMENSION specified for '%s' outside its INTERFACE body "
+ gfc_error ("DIMENSION specified for %qs outside its INTERFACE body "
"at %L", name, where);
return false;
}
@@ -1502,7 +1502,7 @@ gfc_add_flavor (symbol_attribute *attr, sym_flavor f, const char *name,
where = &gfc_current_locus;
if (name)
- gfc_error ("%s attribute of '%s' conflicts with %s attribute at %L",
+ gfc_error ("%s attribute of %qs conflicts with %s attribute at %L",
gfc_code2string (flavors, attr->flavor), name,
gfc_code2string (flavors, f), where);
else
@@ -1660,14 +1660,14 @@ gfc_add_explicit_interface (gfc_symbol *sym, ifsrc source,
if (sym->attr.if_source != IFSRC_UNKNOWN
&& sym->attr.if_source != IFSRC_DECL)
{
- gfc_error ("Symbol '%s' at %L already has an explicit interface",
+ gfc_error ("Symbol %qs at %L already has an explicit interface",
sym->name, where);
return false;
}
if (source == IFSRC_IFBODY && (sym->attr.dimension || sym->attr.allocatable))
{
- gfc_error ("'%s' at %L has attributes specified outside its INTERFACE "
+ gfc_error ("%qs at %L has attributes specified outside its INTERFACE "
"body", sym->name, where);
return false;
}
@@ -1724,7 +1724,7 @@ gfc_add_type (gfc_symbol *sym, gfc_typespec *ts, locus *where)
|| (flavor == FL_PROCEDURE && sym->attr.subroutine)
|| flavor == FL_DERIVED || flavor == FL_NAMELIST)
{
- gfc_error ("Symbol '%s' at %L cannot have a type", sym->name, where);
+ gfc_error ("Symbol %qs at %L cannot have a type", sym->name, where);
return false;
}
@@ -1991,7 +1991,7 @@ gfc_use_derived (gfc_symbol *sym)
if (gfc_find_symbol (sym->name, sym->ns->parent, 1, &s))
{
- gfc_error ("Symbol '%s' at %C is ambiguous", sym->name);
+ gfc_error ("Symbol %qs at %C is ambiguous", sym->name);
return NULL;
}
@@ -2023,7 +2023,7 @@ gfc_use_derived (gfc_symbol *sym)
return s;
bad:
- gfc_error ("Derived type '%s' at %C is being used before it is defined",
+ gfc_error ("Derived type %qs at %C is being used before it is defined",
sym->name);
return NULL;
}
@@ -3979,7 +3979,7 @@ verify_bind_c_derived_type (gfc_symbol *derived_sym)
/* Make sure we don't have conflicts with the attributes. */
if (derived_sym->attr.access == ACCESS_PRIVATE)
{
- gfc_error ("Derived type '%s' at %L cannot be declared with both "
+ gfc_error ("Derived type %qs at %L cannot be declared with both "
"PRIVATE and BIND(C) attributes", derived_sym->name,
&(derived_sym->declared_at));
retval = false;
@@ -3987,7 +3987,7 @@ verify_bind_c_derived_type (gfc_symbol *derived_sym)
if (derived_sym->attr.sequence != 0)
{
- gfc_error ("Derived type '%s' at %L cannot have the SEQUENCE "
+ gfc_error ("Derived type %qs at %L cannot have the SEQUENCE "
"attribute because it is BIND(C)", derived_sym->name,
&(derived_sym->declared_at));
retval = false;
@@ -4467,12 +4467,12 @@ gfc_check_symbol_typed (gfc_symbol* sym, gfc_namespace* ns,
{
if (strict)
{
- gfc_error ("Symbol '%s' is used before it is typed at %L",
+ gfc_error ("Symbol %qs is used before it is typed at %L",
sym->name, &where);
return false;
}
- if (!gfc_notify_std (GFC_STD_GNU, "Symbol '%s' is used before"
+ if (!gfc_notify_std (GFC_STD_GNU, "Symbol %qs is used before"
" it is typed at %L", sym->name, &where))
return false;
}
@@ -1041,7 +1041,7 @@ align_segment (unsigned HOST_WIDE_INT *palign)
if (this_offset & (max_align - 1))
{
/* Aligning this field would misalign a previous field. */
- gfc_error ("The equivalence set for variable '%s' "
+ gfc_error ("The equivalence set for variable %qs "
"declared at %L violates alignment requirements",
s->sym->name, &s->sym->declared_at);
}
@@ -1106,8 +1106,8 @@ translate_common (gfc_common_head *common, gfc_symbol *var_list)
/* Verify that it ended up where we expect it. */
if (s->offset != current_offset)
{
- gfc_error ("Equivalence for '%s' does not match ordering of "
- "COMMON '%s' at %L", sym->name,
+ gfc_error ("Equivalence for %qs does not match ordering of "
+ "COMMON %qs at %L", sym->name,
common->name, &common->where);
}
}
@@ -1121,8 +1121,8 @@ translate_common (gfc_common_head *common, gfc_symbol *var_list)
add_equivalences (&saw_equiv);
if (current_segment->offset < 0)
- gfc_error ("The equivalence set for '%s' cause an invalid "
- "extension to COMMON '%s' at %L", sym->name,
+ gfc_error ("The equivalence set for %qs cause an invalid "
+ "extension to COMMON %qs at %L", sym->name,
common->name, &common->where);
if (gfc_option.flag_align_commons)
@@ -1468,7 +1468,7 @@ trans_this_image (gfc_se * se, gfc_expr *expr)
{
if (wi::ltu_p (dim_arg, 1)
|| wi::gtu_p (dim_arg, GFC_TYPE_ARRAY_CORANK (TREE_TYPE (desc))))
- gfc_error ("'dim' argument of %s intrinsic at %L is not a valid "
+ gfc_error ("%<dim%> argument of %s intrinsic at %L is not a valid "
"dimension index", expr->value.function.isym->name,
&expr->where);
}
@@ -1854,7 +1854,7 @@ gfc_conv_intrinsic_bound (gfc_se * se, gfc_expr * expr, int upper)
if (((!as || as->type != AS_ASSUMED_RANK)
&& wi::geu_p (bound, GFC_TYPE_ARRAY_RANK (TREE_TYPE (desc))))
|| wi::gtu_p (bound, GFC_MAX_DIMENSIONS))
- gfc_error ("'dim' argument of %s intrinsic at %L is not a valid "
+ gfc_error ("%<dim%> argument of %s intrinsic at %L is not a valid "
"dimension index", upper ? "UBOUND" : "LBOUND",
&expr->where);
}
@@ -2050,7 +2050,7 @@ conv_intrinsic_cobound (gfc_se * se, gfc_expr * expr)
{
if (wi::ltu_p (bound, 1)
|| wi::gtu_p (bound, GFC_TYPE_ARRAY_CORANK (TREE_TYPE (desc))))
- gfc_error ("'dim' argument of %s intrinsic at %L is not a valid "
+ gfc_error ("%<dim%> argument of %s intrinsic at %L is not a valid "
"dimension index", expr->value.function.isym->name,
&expr->where);
}
@@ -9,5 +9,5 @@ type t
end type t
class(t), allocatable :: var
-var = t() ! { dg-error "Assignment to an allocatable polymorphic variable at .1. requires -frealloc-lhs" }
+var = t() ! { dg-error "Assignment to an allocatable polymorphic variable at .1. requires '-frealloc-lhs'" }
end
@@ -13,7 +13,7 @@
!
34 5 i=0
! gfc_notify_std(GFC_STD_F95_DEL):
- do r1 = 1, 2 ! { dg-warning "Deleted feature: Loop variable" }
+ do r1 = 1, 2 ! { dg-error "Deleted feature: Loop variable" }
i = i+1
end do
call foo j bar
@@ -5,7 +5,7 @@
! free-form tests
! gfc_notify_std:
- function char_ (ch) ! { dg-warning "Obsolescent feature" }
+ function char_ (ch) ! { dg-error "Obsolescent feature" }
character(*) :: char_, ch
char_ = ch
end function char_