diff options
| author | Tobias Burnus <burnus@net-b.de> | 2014-12-13 00:12:06 +0100 |
|---|---|---|
| committer | Tobias Burnus <burnus@gcc.gnu.org> | 2014-12-13 00:12:06 +0100 |
| commit | a4d9b2212cbf2912387c215da744c217de80f5d2 (patch) | |
| tree | 142ed494ce58fe546f97386fe9da7a4610d92270 /gcc/fortran | |
| parent | 33948765f16435febf518b9ce4843b4b1e386677 (diff) | |
| download | gcc-a4d9b2212cbf2912387c215da744c217de80f5d2.zip gcc-a4d9b2212cbf2912387c215da744c217de80f5d2.tar.gz gcc-a4d9b2212cbf2912387c215da744c217de80f5d2.tar.bz2 | |
error.c (gfc_error): Add variant which takes a va_list.
2014-12-13 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.
Co-Authored-By: Manuel López-Ibáñez <manu@gcc.gnu.org>
From-SVN: r218694
Diffstat (limited to 'gcc/fortran')
| -rw-r--r-- | gcc/fortran/ChangeLog | 26 | ||||
| -rw-r--r-- | gcc/fortran/array.c | 2 | ||||
| -rw-r--r-- | gcc/fortran/check.c | 69 | ||||
| -rw-r--r-- | gcc/fortran/data.c | 4 | ||||
| -rw-r--r-- | gcc/fortran/decl.c | 44 | ||||
| -rw-r--r-- | gcc/fortran/error.c | 94 | ||||
| -rw-r--r-- | gcc/fortran/expr.c | 15 | ||||
| -rw-r--r-- | gcc/fortran/gfortran.h | 1 | ||||
| -rw-r--r-- | gcc/fortran/interface.c | 12 | ||||
| -rw-r--r-- | gcc/fortran/intrinsic.c | 2 | ||||
| -rw-r--r-- | gcc/fortran/io.c | 34 | ||||
| -rw-r--r-- | gcc/fortran/match.c | 48 | ||||
| -rw-r--r-- | gcc/fortran/matchexp.c | 4 | ||||
| -rw-r--r-- | gcc/fortran/module.c | 36 | ||||
| -rw-r--r-- | gcc/fortran/openmp.c | 42 | ||||
| -rw-r--r-- | gcc/fortran/parse.c | 16 | ||||
| -rw-r--r-- | gcc/fortran/primary.c | 40 | ||||
| -rw-r--r-- | gcc/fortran/resolve.c | 372 | ||||
| -rw-r--r-- | gcc/fortran/simplify.c | 2 | ||||
| -rw-r--r-- | gcc/fortran/symbol.c | 34 | ||||
| -rw-r--r-- | gcc/fortran/trans-common.c | 10 | ||||
| -rw-r--r-- | gcc/fortran/trans-intrinsic.c | 6 |
22 files changed, 508 insertions, 405 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 3092e3c..4d99f18 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,29 @@ +2014-12-13 Tobias Burnus <burnus@net-b.de> + Manuel López-Ibáñez <manu@gcc.gnu.org> + + * 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. + 2014-12-11 Richard Biener <rguenther@suse.de> PR tree-optimization/42108 diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c index e27ca01..300bfeb 100644 --- a/gcc/fortran/array.c +++ b/gcc/fortran/array.c @@ -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; } diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index ef40e66..527123d 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -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; diff --git a/gcc/fortran/data.c b/gcc/fortran/data.c index 5d0651e..8e072ee 100644 --- a/gcc/fortran/data.c +++ b/gcc/fortran/data.c @@ -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; } diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index c6b46b9..1c64873 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -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; } diff --git a/gcc/fortran/error.c b/gcc/fortran/error.c index f7a6a6b..f267344 100644 --- a/gcc/fortran/error.c +++ b/gcc/fortran/error.c @@ -68,6 +68,12 @@ gfc_push_suppress_errors (void) ++suppress_errors; } +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); + /* Leave one level of error suppressing. */ @@ -836,9 +842,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; @@ -935,7 +938,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; @@ -1012,6 +1015,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. */ @@ -1349,11 +1414,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) { @@ -1380,8 +1445,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); @@ -1392,11 +1457,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 diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index bfe8356..5c2a306 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -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; diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 9d96b85..42ed8eb 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -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. */ diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index 5f6ed83..04bcf12 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -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; } diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c index 5abd02d..e920a42 100644 --- a/gcc/fortran/intrinsic.c +++ b/gcc/fortran/intrinsic.c @@ -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) diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c index de8254a..ef0e59a 100644 --- a/gcc/fortran/io.c +++ b/gcc/fortran/io.c @@ -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); } diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index e322608..9e08513 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.c @@ -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; } diff --git a/gcc/fortran/matchexp.c b/gcc/fortran/matchexp.c index 1320b96..303dee1 100644 --- a/gcc/fortran/matchexp.c +++ b/gcc/fortran/matchexp.c @@ -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; diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c index 3adbe1a..84c1163 100644 --- a/gcc/fortran/module.c +++ b/gcc/fortran/module.c @@ -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; diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index b0309fc..84b17a7 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -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; diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index 970815e..ad3137b 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -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 { diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c index a9bf658..18791ce 100644 --- a/gcc/fortran/primary.c +++ b/gcc/fortran/primary.c @@ -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; } diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 3270943..d47bb7b 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -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); diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c index 095de6b..32d44ca 100644 --- a/gcc/fortran/simplify.c +++ b/gcc/fortran/simplify.c @@ -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); diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index aab144a..a39d4140 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -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; } diff --git a/gcc/fortran/trans-common.c b/gcc/fortran/trans-common.c index a7d89c2..1c54ef4 100644 --- a/gcc/fortran/trans-common.c +++ b/gcc/fortran/trans-common.c @@ -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) diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 4ebe492..bd3962e 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -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); } |