From db30e21cbff7b9b2acd13ab83e25e3bf52f9696f Mon Sep 17 00:00:00 2001 From: Joseph Myers Date: Sun, 1 Feb 2015 00:29:54 +0000 Subject: [PATCH] Always pass 0 or option number to gfc_warning*. Similar to the issue with fatal_error that I fixed in , the overloads of gfc_warning and gfc_warning_now (with and without a first argument for an option number) also break gcc.pot regeneration because xgettext expects the translated string argument to be in a fixed position for a given function name. This patch applies the corresponding fix of always passing a first argument (option number or 0), just like the core diagnostic functions warning and warning_at, and removing the problem overloads without it. Bootstrapped with no regressions on x86_64-unknown-linux-gnu. * error.c (gfc_warning (const char *, ...), gfc_warning_now (const char *, ...)): Remove functions. * gfortran.h (gfc_warning (const char *, ...), gfc_warning_now (const char *, ...)): Remove declarations. * arith.c, check.c, data.c, decl.c, frontend-passes.c, interface.c, intrinsic.c, io.c, matchexp.c, module.c, openmp.c, options.c, parse.c, primary.c, resolve.c, scanner.c, symbol.c, trans-common.c, trans-const.c, trans-stmt.c: All callers of gfc_warning and gfc_warning_now changed to pass 0 or option number as first argument. From-SVN: r220313 --- gcc/fortran/ChangeLog | 13 ++++++++++++ gcc/fortran/arith.c | 7 ++++--- gcc/fortran/check.c | 2 +- gcc/fortran/data.c | 2 +- gcc/fortran/decl.c | 8 +++---- gcc/fortran/error.c | 31 ---------------------------- gcc/fortran/frontend-passes.c | 4 ++-- gcc/fortran/gfortran.h | 2 -- gcc/fortran/interface.c | 22 +++++++++++--------- gcc/fortran/intrinsic.c | 4 ++-- gcc/fortran/io.c | 26 ++++++++++++----------- gcc/fortran/matchexp.c | 4 ++-- gcc/fortran/module.c | 5 +++-- gcc/fortran/openmp.c | 2 +- gcc/fortran/options.c | 16 +++++++------- gcc/fortran/parse.c | 10 ++++----- gcc/fortran/primary.c | 2 +- gcc/fortran/resolve.c | 39 ++++++++++++++++++----------------- gcc/fortran/scanner.c | 14 ++++++------- gcc/fortran/symbol.c | 2 +- gcc/fortran/trans-common.c | 8 ++++--- gcc/fortran/trans-const.c | 2 +- gcc/fortran/trans-stmt.c | 3 ++- 23 files changed, 109 insertions(+), 119 deletions(-) diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 01462d2e312..7e455ef80d8 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,16 @@ +2015-02-01 Joseph Myers + + * error.c (gfc_warning (const char *, ...), gfc_warning_now (const + char *, ...)): Remove functions. + * gfortran.h (gfc_warning (const char *, ...), gfc_warning_now + (const char *, ...)): Remove declarations. + * arith.c, check.c, data.c, decl.c, frontend-passes.c, + interface.c, intrinsic.c, io.c, matchexp.c, module.c, openmp.c, + options.c, parse.c, primary.c, resolve.c, scanner.c, symbol.c, + trans-common.c, trans-const.c, trans-stmt.c: All callers of + gfc_warning and gfc_warning_now changed to pass 0 or option number + as first argument. + 2015-01-30 Joseph Myers * f95-lang.c, gfortranspec.c, trans-const.c, trans-expr.c: All diff --git a/gcc/fortran/arith.c b/gcc/fortran/arith.c index 5bcd9d02f28..b9c25c10e89 100644 --- a/gcc/fortran/arith.c +++ b/gcc/fortran/arith.c @@ -551,7 +551,7 @@ check_result (arith rc, gfc_expr *x, gfc_expr *r, gfc_expr **rp) if (val == ARITH_ASYMMETRIC) { - gfc_warning (gfc_arith_error (val), &x->where); + gfc_warning (0, gfc_arith_error (val), &x->where); val = ARITH_OK; } @@ -1966,7 +1966,7 @@ gfc_int2int (gfc_expr *src, int kind) { if (rc == ARITH_ASYMMETRIC) { - gfc_warning (gfc_arith_error (rc), &src->where); + gfc_warning (0, gfc_arith_error (rc), &src->where); } else { @@ -2280,7 +2280,8 @@ hollerith2representation (gfc_expr *result, gfc_expr *src) if (src_len > result_len) { - gfc_warning ("The Hollerith constant at %L is too long to convert to %qs", + gfc_warning (0, + "The Hollerith constant at %L is too long to convert to %qs", &src->where, gfc_typename(&result->ts)); } diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index 85fc241e2fe..3be4fb11e24 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -5089,7 +5089,7 @@ gfc_check_transfer (gfc_expr *source, gfc_expr *mold, gfc_expr *size) return true; if (source_size < result_size) - gfc_warning ("Intrinsic TRANSFER at %L has partly undefined result: " + gfc_warning (0, "Intrinsic TRANSFER at %L has partly undefined result: " "source size %ld < result size %ld", &source->where, (long) source_size, (long) result_size); diff --git a/gcc/fortran/data.c b/gcc/fortran/data.c index fa4e821f8ba..4fd84e4b415 100644 --- a/gcc/fortran/data.c +++ b/gcc/fortran/data.c @@ -164,7 +164,7 @@ create_character_initializer (gfc_expr *init, gfc_typespec *ts, if (len > end - start) { - gfc_warning_now ("Initialization string starting at %L was " + gfc_warning_now (0, "Initialization string starting at %L was " "truncated to fit the variable (%d/%d)", &rvalue->where, end - start, len); len = end - start; diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index c26ffebf27d..40d851c5f5c 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -2299,7 +2299,7 @@ kind_expr: if (ts->f90_type != BT_UNKNOWN && ts->f90_type != ts->type && !((ts->f90_type == BT_REAL && ts->type == BT_COMPLEX) || (ts->f90_type == BT_COMPLEX && ts->type == BT_REAL))) - gfc_warning_now ("C kind type parameter is for type %s but type at %L " + gfc_warning_now (0, "C kind type parameter is for type %s but type at %L " "is %s", gfc_basic_typename (ts->f90_type), &where, gfc_basic_typename (ts->type)); @@ -3318,7 +3318,7 @@ gfc_match_import (void) if (gfc_find_symtree (gfc_current_ns->sym_root, name)) { - gfc_warning ("%qs is already IMPORTed from host scoping unit " + gfc_warning (0, "%qs is already IMPORTed from host scoping unit " "at %C", name); goto next_item; } @@ -4156,7 +4156,7 @@ verify_bind_c_sym (gfc_symbol *tmp_sym, gfc_typespec *ts, && tmp_sym->binding_label) /* Use gfc_warning_now because we won't say that the symbol fails just because of this. */ - gfc_warning_now ("Symbol %qs at %L is marked PRIVATE but has been " + gfc_warning_now (0, "Symbol %qs at %L is marked PRIVATE but has been " "given the binding label %qs", tmp_sym->name, &(tmp_sym->declared_at), tmp_sym->binding_label); @@ -6625,7 +6625,7 @@ cray_pointer_decl (void) return MATCH_ERROR; } else if (cptr->ts.kind < gfc_index_integer_kind) - gfc_warning ("Cray pointer at %C has %d bytes of precision;" + gfc_warning (0, "Cray pointer at %C has %d bytes of precision;" " memory addresses require %d bytes", cptr->ts.kind, gfc_index_integer_kind); diff --git a/gcc/fortran/error.c b/gcc/fortran/error.c index 64ae37d642d..da0eb8f664e 100644 --- a/gcc/fortran/error.c +++ b/gcc/fortran/error.c @@ -904,17 +904,6 @@ gfc_warning (int opt, const char *gmsgid, ...) return ret; } -bool -gfc_warning (const char *gmsgid, ...) -{ - va_list argp; - - va_start (argp, gmsgid); - bool ret = gfc_warning (0, gmsgid, argp); - va_end (argp); - return ret; -} - /* Whether, for a feature included in a given standard set (GFC_STD_*), we should issue an error or a warning, or be quiet. */ @@ -1257,26 +1246,6 @@ gfc_warning_now (int opt, const char *gmsgid, ...) return ret; } -/* Immediate warning (i.e. do not buffer the warning). */ -/* This function uses the common diagnostics, but does not support - two locations; when being used in scanner.c, ensure that the location - is properly setup. Otherwise, use gfc_warning_now_1. */ - -bool -gfc_warning_now (const char *gmsgid, ...) -{ - va_list argp; - diagnostic_info diagnostic; - bool ret; - - va_start (argp, gmsgid); - diagnostic_set_info (&diagnostic, gmsgid, &argp, UNKNOWN_LOCATION, - DK_WARNING); - ret = report_diagnostic (&diagnostic); - va_end (argp); - return ret; -} - /* Immediate error (i.e. do not buffer). */ /* This function uses the common diagnostics, but does not support diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c index ddc982d3c52..446ef196e2c 100644 --- a/gcc/fortran/frontend-passes.c +++ b/gcc/fortran/frontend-passes.c @@ -678,10 +678,10 @@ do_warn_function_elimination (gfc_expr *e) if (e->expr_type != EXPR_FUNCTION) return; if (e->value.function.esym) - gfc_warning ("Removing call to function %qs at %L", + gfc_warning (0, "Removing call to function %qs at %L", e->value.function.esym->name, &(e->where)); else if (e->value.function.isym) - gfc_warning ("Removing call to function %qs at %L", + gfc_warning (0, "Removing call to function %qs at %L", e->value.function.isym->name, &(e->where)); } /* Callback function for the code walker for doing common function diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 287669b1f8b..6b9f7dd02a6 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -2646,10 +2646,8 @@ void gfc_buffer_error (bool); const char *gfc_print_wide_char (gfc_char_t); void gfc_warning_1 (const char *, ...) ATTRIBUTE_GCC_GFC(1,2); -bool gfc_warning (const char *, ...) ATTRIBUTE_GCC_GFC(1,2); bool gfc_warning (int opt, const char *, ...) ATTRIBUTE_GCC_GFC(2,3); void gfc_warning_now_1 (const char *, ...) ATTRIBUTE_GCC_GFC(1,2); -bool gfc_warning_now (const char *, ...) ATTRIBUTE_GCC_GFC(1,2); bool gfc_warning_now (int opt, const char *, ...) ATTRIBUTE_GCC_GFC(2,3); void gfc_clear_warning (void); diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index 837dc8c4228..320eb01809a 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -1178,7 +1178,7 @@ check_dummy_characteristics (gfc_symbol *s1, gfc_symbol *s2, case -2: /* FIXME: Implement a warning for this case. - gfc_warning ("Possible character length mismatch in argument %qs", + gfc_warning (0, "Possible character length mismatch in argument %qs", s1->name);*/ break; @@ -1237,7 +1237,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 %qs", + gfc_warning (0, "Possible shape mismatch in argument %qs", s1->name);*/ break; @@ -1398,7 +1398,7 @@ check_result_characteristics (gfc_symbol *s1, gfc_symbol *s2, case -2: /* FIXME: Implement a warning for this case. - gfc_warning ("Possible shape mismatch in return value");*/ + gfc_warning (0, "Possible shape mismatch in return value");*/ break; case 0: @@ -1660,11 +1660,11 @@ check_interface1 (gfc_interface *p, gfc_interface *q0, p->sym->name, q->sym->name, interface_name, &p->where); else if (!p->sym->attr.use_assoc && q->sym->attr.use_assoc) - gfc_warning ("Ambiguous interfaces %qs and %qs in %s at %L", + gfc_warning (0, "Ambiguous interfaces %qs and %qs in %s at %L", p->sym->name, q->sym->name, interface_name, &p->where); else - gfc_warning ("Although not referenced, %qs has ambiguous " + gfc_warning (0, "Although not referenced, %qs has ambiguous " "interfaces at %L", interface_name, &p->where); return 1; } @@ -2705,14 +2705,16 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, f->sym->ts.u.cl->length->value.integer) != 0)) { if (where && (f->sym->attr.pointer || f->sym->attr.allocatable)) - gfc_warning ("Character length mismatch (%ld/%ld) between actual " + gfc_warning (0, + "Character length mismatch (%ld/%ld) between actual " "argument and pointer or allocatable dummy argument " "%qs at %L", mpz_get_si (a->expr->ts.u.cl->length->value.integer), mpz_get_si (f->sym->ts.u.cl->length->value.integer), f->sym->name, &a->expr->where); else if (where) - gfc_warning ("Character length mismatch (%ld/%ld) between actual " + gfc_warning (0, + "Character length mismatch (%ld/%ld) between actual " "argument and assumed-shape dummy argument %qs " "at %L", mpz_get_si (a->expr->ts.u.cl->length->value.integer), @@ -2743,12 +2745,12 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, && f->sym->attr.flavor != FL_PROCEDURE) { if (a->expr->ts.type == BT_CHARACTER && !f->sym->as && where) - gfc_warning ("Character length of actual argument shorter " + gfc_warning (0, "Character length of actual argument shorter " "than of dummy argument %qs (%lu/%lu) at %L", f->sym->name, actual_size, formal_size, &a->expr->where); else if (where) - gfc_warning ("Actual argument contains too few " + gfc_warning (0, "Actual argument contains too few " "elements for dummy argument %qs (%lu/%lu) at %L", f->sym->name, actual_size, formal_size, &a->expr->where); @@ -3184,7 +3186,7 @@ check_some_aliasing (gfc_formal_arglist *f, gfc_actual_arglist *a) || (f1_intent == INTENT_OUT && f2_intent == INTENT_IN) || (f1_intent == INTENT_OUT && f2_intent == INTENT_OUT)) { - gfc_warning ("Same actual argument associated with INTENT(%s) " + gfc_warning (0, "Same actual argument associated with INTENT(%s) " "argument %qs and INTENT(%s) argument %qs at %L", gfc_intent_string (f1_intent), p[i].f->sym->name, gfc_intent_string (f2_intent), p[j].f->sym->name, diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c index 3585e722c2a..a958f8ec9d1 100644 --- a/gcc/fortran/intrinsic.c +++ b/gcc/fortran/intrinsic.c @@ -4316,7 +4316,7 @@ gfc_check_intrinsic_standard (const gfc_intrinsic_sym* isym, { /* Do only print a warning if not a GNU extension. */ if (!silent && isym->standard != GFC_STD_GNU) - gfc_warning ("Intrinsic %qs (is %s) is used at %L", + gfc_warning (0, "Intrinsic %qs (is %s) is used at %L", isym->name, _(symstd_msg), &where); return true; @@ -4617,7 +4617,7 @@ gfc_convert_type_warn (gfc_expr *expr, gfc_typespec *ts, int eflag, int wflag) /* At this point, a conversion is necessary. A warning may be needed. */ if ((gfc_option.warn_std & sym->standard) != 0) { - gfc_warning_now ("Extension: Conversion from %s to %s at %L", + gfc_warning_now (0, "Extension: Conversion from %s to %s at %L", gfc_typename (&from_ts), gfc_typename (ts), &expr->where); } diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c index a13d1aed044..7ba6b092e98 100644 --- a/gcc/fortran/io.c +++ b/gcc/fortran/io.c @@ -165,7 +165,7 @@ next_char (gfc_instring in_string) gfc_current_locus = old_locus; if (!(gfc_option.allow_std & GFC_STD_GNU) && !inhibit_warnings) - gfc_warning ("Extension: backslash character at %C"); + gfc_warning (0, "Extension: backslash character at %C"); } if (mode == MODE_COPY) @@ -201,7 +201,7 @@ next_char_not_space (bool *error) if (c == '\t') { if (gfc_option.allow_std & GFC_STD_GNU) - gfc_warning ("Extension: Tab character in format at %C"); + gfc_warning (0, "Extension: Tab character in format at %C"); else { gfc_error ("Extension: Tab character in format at %C"); @@ -681,7 +681,7 @@ format_item_1: return false; if (t != FMT_RPAREN || level > 0) { - gfc_warning ("$ should be the last specifier in format at %L", + gfc_warning (0, "$ should be the last specifier in format at %L", &format_locus); goto optional_comma_1; } @@ -779,7 +779,7 @@ data_desc: case WARNING: if (mode != MODE_FORMAT) format_locus.nextc += format_string_pos; - gfc_warning ("Extension: Missing positive width after L " + gfc_warning (0, "Extension: Missing positive width after L " "descriptor at %L", &format_locus); saved_token = t; break; @@ -874,7 +874,7 @@ data_desc: goto fail; } else - gfc_warning ("Period required in format " + gfc_warning (0, "Period required in format " "specifier %s at %L", token_to_string (t), &format_locus); /* If we go to finished, we need to unwind this @@ -946,7 +946,7 @@ data_desc: } if (mode != MODE_FORMAT) format_locus.nextc += format_string_pos; - gfc_warning ("Period required in format specifier at %L", + gfc_warning (0, "Period required in format specifier at %L", &format_locus); saved_token = t; break; @@ -968,7 +968,7 @@ data_desc: { if (mode != MODE_FORMAT) format_locus.nextc += format_string_pos; - gfc_warning ("The H format specifier at %L is" + gfc_warning (0, "The H format specifier at %L is" " a Fortran 95 deleted feature", &format_locus); } if (mode == MODE_STRING) @@ -1173,7 +1173,8 @@ check_format_string (gfc_expr *e, bool is_input) if (e->value.character.string[i] != ' ') { format_locus.nextc += format_length + 1; - gfc_warning ("Extraneous characters in format at %L", &format_locus); + gfc_warning (0, + "Extraneous characters in format at %L", &format_locus); break; } return rv; @@ -1720,7 +1721,7 @@ compare_to_allowed_values (const char *specifier, const char *allowed[], if (n == WARNING || (warn && n == ERROR)) { - gfc_warning ("Fortran 2003: %s specifier in %s statement at %C " + gfc_warning (0, "Fortran 2003: %s specifier in %s statement at %C " "has value %qs", specifier, statement, allowed_f2003[i]); return 1; @@ -1747,7 +1748,7 @@ compare_to_allowed_values (const char *specifier, const char *allowed[], if (n == WARNING || (warn && n == ERROR)) { - gfc_warning ("Extension: %s specifier in %s statement at %C " + gfc_warning (0, "Extension: %s specifier in %s statement at %C " "has value %qs", specifier, statement, allowed_gnu[i]); return 1; @@ -1768,7 +1769,8 @@ 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 %qs", + gfc_warning (0, + "%s specifier in %s statement at %C has invalid value %qs", specifier, statement, s); free (s); return 1; @@ -2047,7 +2049,7 @@ gfc_match_open (void) #define warn_or_error(...) \ { \ if (warn) \ - gfc_warning (__VA_ARGS__); \ + gfc_warning (0, __VA_ARGS__); \ else \ { \ gfc_error (__VA_ARGS__); \ diff --git a/gcc/fortran/matchexp.c b/gcc/fortran/matchexp.c index fc35c8c0558..02f43a04db1 100644 --- a/gcc/fortran/matchexp.c +++ b/gcc/fortran/matchexp.c @@ -321,7 +321,7 @@ match_ext_mult_operand (gfc_expr **result) return MATCH_ERROR; } else - gfc_warning ("Extension: Unary operator following " + gfc_warning (0, "Extension: Unary operator following " "arithmetic operator (use parentheses) at %C"); m = match_ext_mult_operand (&e); @@ -430,7 +430,7 @@ match_ext_add_operand (gfc_expr **result) return MATCH_ERROR; } else - gfc_warning ("Extension: Unary operator following " + gfc_warning (0, "Extension: Unary operator following " "arithmetic operator (use parentheses) at %C"); m = match_ext_add_operand (&e); diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c index 69dc182d52b..df612ae953a 100644 --- a/gcc/fortran/module.c +++ b/gcc/fortran/module.c @@ -6491,7 +6491,7 @@ use_iso_fortran_env_module (void) if ((flag_default_integer || flag_default_real) && symbol[i].id == ISOFORTRANENV_NUMERIC_STORAGE_SIZE) - gfc_warning_now ("Use of the NUMERIC_STORAGE_SIZE named " + gfc_warning_now (0, "Use of the NUMERIC_STORAGE_SIZE named " "constant from intrinsic module " "ISO_FORTRAN_ENV at %L is incompatible with " "option %qs", &u->where, @@ -6558,7 +6558,8 @@ use_iso_fortran_env_module (void) if ((flag_default_integer || flag_default_real) && symbol[i].id == ISOFORTRANENV_NUMERIC_STORAGE_SIZE) - gfc_warning_now ("Use of the NUMERIC_STORAGE_SIZE named constant " + gfc_warning_now (0, + "Use of the NUMERIC_STORAGE_SIZE named constant " "from intrinsic module ISO_FORTRAN_ENV at %C is " "incompatible with option %s", flag_default_integer diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index 422e977d089..21de6072cc2 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -2638,7 +2638,7 @@ resolve_oacc_positive_int_expr (gfc_expr *expr, const char *clause) resolve_oacc_scalar_int_expr (expr, clause); if (expr->expr_type == EXPR_CONSTANT && expr->ts.type == BT_INTEGER && mpz_sgn(expr->value.integer) <= 0) - gfc_warning ("INTEGER expression of %s clause at %L must be positive", + gfc_warning (0, "INTEGER expression of %s clause at %L must be positive", clause, &expr->where); } diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c index 4bae04e1352..60473dd2376 100644 --- a/gcc/fortran/options.c +++ b/gcc/fortran/options.c @@ -300,7 +300,7 @@ gfc_post_options (const char **pfilename) if (gfc_current_form == FORM_UNKNOWN) { gfc_current_form = FORM_FREE; - gfc_warning_now ("Reading file %qs as free form", + gfc_warning_now (0, "Reading file %qs as free form", (filename[0] == '\0') ? "" : filename); } } @@ -310,10 +310,10 @@ gfc_post_options (const char **pfilename) if (gfc_current_form == FORM_FREE) { if (gfc_option.flag_d_lines == 0) - gfc_warning_now ("%<-fd-lines-as-comments%> has no effect " + gfc_warning_now (0, "%<-fd-lines-as-comments%> has no effect " "in free form"); else if (gfc_option.flag_d_lines == 1) - gfc_warning_now ("%<-fd-lines-as-code%> has no effect in free form"); + gfc_warning_now (0, "%<-fd-lines-as-code%> has no effect in free form"); if (warn_line_truncation == -1) warn_line_truncation = 1; @@ -344,18 +344,18 @@ gfc_post_options (const char **pfilename) if (!flag_automatic && flag_max_stack_var_size != -2 && flag_max_stack_var_size != 0) - gfc_warning_now ("Flag %<-fno-automatic%> overwrites %<-fmax-stack-var-size=%d%>", + gfc_warning_now (0, "Flag %<-fno-automatic%> overwrites %<-fmax-stack-var-size=%d%>", flag_max_stack_var_size); else if (!flag_automatic && flag_recursive) - gfc_warning_now ("Flag %<-fno-automatic%> overwrites %<-frecursive%>"); + gfc_warning_now (0, "Flag %<-fno-automatic%> overwrites %<-frecursive%>"); else if (!flag_automatic && flag_openmp) - gfc_warning_now ("Flag %<-fno-automatic%> overwrites %<-frecursive%> implied by " + gfc_warning_now (0, "Flag %<-fno-automatic%> overwrites %<-frecursive%> implied by " "%<-fopenmp%>"); else if (flag_max_stack_var_size != -2 && flag_recursive) - gfc_warning_now ("Flag %<-frecursive%> overwrites %<-fmax-stack-var-size=%d%>", + gfc_warning_now (0, "Flag %<-frecursive%> overwrites %<-fmax-stack-var-size=%d%>", flag_max_stack_var_size); else if (flag_max_stack_var_size != -2 && flag_openmp) - gfc_warning_now ("Flag %<-fmax-stack-var-size=%d%> overwrites %<-frecursive%> " + gfc_warning_now (0, "Flag %<-fmax-stack-var-size=%d%> overwrites %<-frecursive%> " "implied by %<-fopenmp%>", flag_max_stack_var_size); /* Implement -frecursive as -fmax-stack-var-size=-1. */ diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index 34e30263836..2c7c554d367 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -973,7 +973,7 @@ next_free (void) if (gfc_match_eos () == MATCH_YES) { - gfc_warning_now ("Ignoring statement label in empty statement " + gfc_warning_now (0, "Ignoring statement label in empty statement " "at %L", &label_locus); gfc_free_st_label (gfc_statement_label); gfc_statement_label = NULL; @@ -1178,7 +1178,7 @@ next_fixed (void) if (digit_flag) { if (label == 0) - gfc_warning_now ("Zero is not a valid statement label at %C"); + gfc_warning_now (0, "Zero is not a valid statement label at %C"); else { /* We've found a valid statement label. */ @@ -1234,7 +1234,7 @@ next_fixed (void) blank_line: if (digit_flag) - gfc_warning_now ("Ignoring statement label in empty statement at %L", + gfc_warning_now (0, "Ignoring statement label in empty statement at %L", &label_locus); gfc_current_locus.lb->truncated = 0; @@ -2683,7 +2683,7 @@ endType: } if (gfc_current_block ()->attr.sequence) - gfc_warning ("SEQUENCE attribute at %C already specified in " + gfc_warning (0, "SEQUENCE attribute at %C already specified in " "TYPE statement"); if (seen_sequence) @@ -4345,7 +4345,7 @@ parse_oacc_loop (gfc_statement acc_st) st = next_statement (); if (st == ST_OACC_END_LOOP) - gfc_warning ("Redundant !$ACC END LOOP at %C"); + gfc_warning (0, "Redundant !$ACC END LOOP at %C"); if ((acc_st == ST_OACC_PARALLEL_LOOP && st == ST_OACC_END_PARALLEL_LOOP) || (acc_st == ST_OACC_KERNELS_LOOP && st == ST_OACC_END_KERNELS_LOOP) || (acc_st == ST_OACC_LOOP && st == ST_OACC_END_LOOP)) diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c index 141f8cc1ed6..67a7f8a99b3 100644 --- a/gcc/fortran/primary.c +++ b/gcc/fortran/primary.c @@ -865,7 +865,7 @@ next_string_char (gfc_char_t delimiter, int *ret) gfc_current_locus = old_locus; if (!(gfc_option.allow_std & GFC_STD_GNU) && !inhibit_warnings) - gfc_warning ("Extension: backslash character at %C"); + gfc_warning (0, "Extension: backslash character at %C"); } if (c != delimiter) diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 3fe09f6252d..bb4240446bf 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -1728,7 +1728,7 @@ resolve_procedure_expression (gfc_expr* expr) /* A non-RECURSIVE procedure that is used as procedure expression within its own body is in danger of being called recursively. */ if (is_illegal_recursion (sym, gfc_current_ns)) - gfc_warning ("Non-RECURSIVE procedure %qs at %L is possibly calling" + gfc_warning (0, "Non-RECURSIVE procedure %qs at %L is possibly calling" " itself recursively. Declare it RECURSIVE or use" " %<-frecursive%>", sym->name, &expr->where); @@ -2120,7 +2120,7 @@ resolve_elemental_actual (gfc_expr *expr, gfc_code *c) && (set_by_optional || arg->expr->rank != rank) && !(isym && isym->id == GFC_ISYM_CONVERSION)) { - gfc_warning ("%qs at %L is an array and OPTIONAL; IF IT IS " + gfc_warning (0, "%qs at %L is an array and OPTIONAL; IF IT IS " "MISSING, it cannot be the actual argument of an " "ELEMENTAL procedure unless there is a non-optional " "argument with the same rank (12.4.1.5)", @@ -3631,7 +3631,7 @@ resolve_operator (gfc_expr *e) else msg = "Inequality comparison for %s at %L"; - gfc_warning (msg, gfc_typename (&op1->ts), &op1->where); + gfc_warning (0, msg, gfc_typename (&op1->ts), &op1->where); } } @@ -3964,12 +3964,12 @@ check_dimension (int i, gfc_array_ref *ar, gfc_array_spec *as) if (compare_bound (ar->start[i], as->lower[i]) == CMP_LT) { if (i < as->rank) - gfc_warning ("Array reference at %L is out of bounds " + gfc_warning (0, "Array reference at %L is out of bounds " "(%ld < %ld) in dimension %d", &ar->c_where[i], mpz_get_si (ar->start[i]->value.integer), mpz_get_si (as->lower[i]->value.integer), i+1); else - gfc_warning ("Array reference at %L is out of bounds " + gfc_warning (0, "Array reference at %L is out of bounds " "(%ld < %ld) in codimension %d", &ar->c_where[i], mpz_get_si (ar->start[i]->value.integer), mpz_get_si (as->lower[i]->value.integer), @@ -3979,12 +3979,12 @@ check_dimension (int i, gfc_array_ref *ar, gfc_array_spec *as) if (compare_bound (ar->start[i], as->upper[i]) == CMP_GT) { if (i < as->rank) - gfc_warning ("Array reference at %L is out of bounds " + gfc_warning (0, "Array reference at %L is out of bounds " "(%ld > %ld) in dimension %d", &ar->c_where[i], mpz_get_si (ar->start[i]->value.integer), mpz_get_si (as->upper[i]->value.integer), i+1); else - gfc_warning ("Array reference at %L is out of bounds " + gfc_warning (0, "Array reference at %L is out of bounds " "(%ld > %ld) in codimension %d", &ar->c_where[i], mpz_get_si (ar->start[i]->value.integer), mpz_get_si (as->upper[i]->value.integer), @@ -4021,7 +4021,7 @@ check_dimension (int i, gfc_array_ref *ar, gfc_array_spec *as) { if (compare_bound (AR_START, as->lower[i]) == CMP_LT) { - gfc_warning ("Lower array reference at %L is out of bounds " + gfc_warning (0, "Lower array reference at %L is out of bounds " "(%ld < %ld) in dimension %d", &ar->c_where[i], mpz_get_si (AR_START->value.integer), mpz_get_si (as->lower[i]->value.integer), i+1); @@ -4029,7 +4029,7 @@ check_dimension (int i, gfc_array_ref *ar, gfc_array_spec *as) } if (compare_bound (AR_START, as->upper[i]) == CMP_GT) { - gfc_warning ("Lower array reference at %L is out of bounds " + gfc_warning (0, "Lower array reference at %L is out of bounds " "(%ld > %ld) in dimension %d", &ar->c_where[i], mpz_get_si (AR_START->value.integer), mpz_get_si (as->upper[i]->value.integer), i+1); @@ -4045,7 +4045,7 @@ check_dimension (int i, gfc_array_ref *ar, gfc_array_spec *as) { if (compare_bound_mpz_t (as->lower[i], last_value) == CMP_GT) { - gfc_warning ("Upper array reference at %L is out of bounds " + gfc_warning (0, "Upper array reference at %L is out of bounds " "(%ld < %ld) in dimension %d", &ar->c_where[i], mpz_get_si (last_value), mpz_get_si (as->lower[i]->value.integer), i+1); @@ -4054,7 +4054,7 @@ check_dimension (int i, gfc_array_ref *ar, gfc_array_spec *as) } if (compare_bound_mpz_t (as->upper[i], last_value) == CMP_LT) { - gfc_warning ("Upper array reference at %L is out of bounds " + gfc_warning (0, "Upper array reference at %L is out of bounds " "(%ld > %ld) in dimension %d", &ar->c_where[i], mpz_get_si (last_value), mpz_get_si (as->upper[i]->value.integer), i+1); @@ -7195,7 +7195,7 @@ resolve_allocate_deallocate (gfc_code *code, const char *fcn) if (errmsg) { if (!stat) - gfc_warning ("ERRMSG at %L is useless without a STAT tag", + gfc_warning (0, "ERRMSG at %L is useless without a STAT tag", &errmsg->where); gfc_check_vardef_context (errmsg, false, false, false, @@ -7643,7 +7643,7 @@ resolve_select (gfc_code *code, bool select_type) if (cp->low && gfc_check_integer_range (cp->low->value.integer, case_expr->ts.kind) != ARITH_OK) - gfc_warning ("Expression in CASE statement at %L is " + gfc_warning (0, "Expression in CASE statement at %L is " "not in the range of %s", &cp->low->where, gfc_typename (&case_expr->ts)); @@ -7651,7 +7651,7 @@ resolve_select (gfc_code *code, bool select_type) && cp->low != cp->high && gfc_check_integer_range (cp->high->value.integer, case_expr->ts.kind) != ARITH_OK) - gfc_warning ("Expression in CASE statement at %L is " + gfc_warning (0, "Expression in CASE statement at %L is " "not in the range of %s", &cp->high->where, gfc_typename (&case_expr->ts)); } @@ -8653,7 +8653,8 @@ resolve_branch (gfc_st_label *label, gfc_code *code) if (code->here == label) { - gfc_warning ("Branch at %L may result in an infinite loop", &code->loc); + gfc_warning (0, + "Branch at %L may result in an infinite loop", &code->loc); return; } @@ -8860,7 +8861,7 @@ gfc_resolve_assign_in_forall (gfc_code *code, int nvar, gfc_expr **var_expr) assignment. Emit a warning rather than an error because the mask could be resolving this problem. */ if (!find_forall_index (code->expr1, forall_index, 0)) - gfc_warning ("The FORALL with index %qs is not used on the " + gfc_warning (0, "The FORALL with index %qs is not used on the " "left side of the assignment at %L and so might " "cause multiple assignment to this object", var_expr[n]->symtree->name, &code->expr1->where); @@ -9702,7 +9703,7 @@ generate_component_assignments (gfc_code **code, gfc_namespace *ns) (*code)->expr1->rank ? 1 : 0); if (depth > 1) { - gfc_warning ("TODO: type-bound defined assignment(s) at %L not " + gfc_warning (0, "TODO: type-bound defined assignment(s) at %L not " "done because multiple part array references would " "occur in intermediate expressions.", &(*code)->loc); return; @@ -14344,12 +14345,12 @@ warn_unused_fortran_label (gfc_st_label *label) switch (label->referenced) { case ST_LABEL_UNKNOWN: - gfc_warning ("Label %d at %L defined but not used", label->value, + gfc_warning (0, "Label %d at %L defined but not used", label->value, &label->where); break; case ST_LABEL_BAD_TARGET: - gfc_warning ("Label %d at %L defined but cannot be used", + gfc_warning (0, "Label %d at %L defined but cannot be used", label->value, &label->where); break; diff --git a/gcc/fortran/scanner.c b/gcc/fortran/scanner.c index 4a71cb20dcf..4389880b3b7 100644 --- a/gcc/fortran/scanner.c +++ b/gcc/fortran/scanner.c @@ -327,7 +327,7 @@ add_path_to_list (gfc_directorylist **list, const char *path, if (stat (q, &st)) { if (errno != ENOENT) - gfc_warning_now ("Include directory %qs: %s", path, + gfc_warning_now (0, "Include directory %qs: %s", path, xstrerror(errno)); else if (warn) gfc_warning_now (OPT_Wmissing_include_dirs, @@ -336,7 +336,7 @@ add_path_to_list (gfc_directorylist **list, const char *path, } else if (!S_ISDIR (st.st_mode)) { - gfc_warning_now ("%qs is not a directory", path); + gfc_warning_now (0, "%qs is not a directory", path); return; } @@ -739,7 +739,7 @@ skip_oacc_attribute (locus start, locus old_loc, bool continue_flag) } else { - gfc_warning_now ("!$ACC at %C starts a commented " + gfc_warning_now (0, "!$ACC at %C starts a commented " "line as it neither is followed " "by a space nor is a " "continuation line"); @@ -779,7 +779,7 @@ skip_omp_attribute (locus start, locus old_loc, bool continue_flag) } else { - gfc_warning_now ("!$OMP at %C starts a commented " + gfc_warning_now (0, "!$OMP at %C starts a commented " "line as it neither is followed " "by a space nor is a " "continuation line"); @@ -1306,7 +1306,7 @@ restart: if (++continue_count == gfc_option.max_continue_free) { if (gfc_notification_std (GFC_STD_GNU) || pedantic) - gfc_warning ("Limit of %d continuations exceeded in " + gfc_warning (0, "Limit of %d continuations exceeded in " "statement at %C", gfc_option.max_continue_free); } } @@ -1477,7 +1477,7 @@ restart: if (++continue_count == gfc_option.max_continue_fixed) { if (gfc_notification_std (GFC_STD_GNU) || pedantic) - gfc_warning ("Limit of %d continuations exceeded in " + gfc_warning (0, "Limit of %d continuations exceeded in " "statement at %C", gfc_option.max_continue_fixed); } @@ -1718,7 +1718,7 @@ load_line (FILE *input, gfc_char_t **pbuf, int *pbuflen, const int *first_char) gfc_error_now ("%<&%> not allowed by itself in line %d", current_line); else - gfc_warning_now ("%<&%> not allowed by itself in line %d", + gfc_warning_now (0, "%<&%> not allowed by itself in line %d", current_line); } break; diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index dc300992202..32eea2141be 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -3874,7 +3874,7 @@ verify_bind_c_derived_type (gfc_symbol *derived_sym) */ if (curr_comp == NULL) { - gfc_warning ("Derived type %qs with BIND(C) attribute at %L is empty, " + gfc_warning (0, "Derived type %qs with BIND(C) attribute at %L is empty, " "and may be inaccessible by the C companion processor", derived_sym->name, &(derived_sym->declared_at)); derived_sym->ts.is_c_interop = 1; diff --git a/gcc/fortran/trans-common.c b/gcc/fortran/trans-common.c index 6dd11062ae8..8064d891870 100644 --- a/gcc/fortran/trans-common.c +++ b/gcc/fortran/trans-common.c @@ -407,7 +407,7 @@ build_common_decl (gfc_common_head *com, tree union_type, bool is_init) blank common blocks may be of different sizes. */ if (!tree_int_cst_equal (DECL_SIZE_UNIT (decl), size) && strcmp (com->name, BLANK_COMMON_NAME)) - gfc_warning ("Named COMMON block %qs at %L shall be of the " + gfc_warning (0, "Named COMMON block %qs at %L shall be of the " "same size as elsewhere (%lu vs %lu bytes)", com->name, &com->where, (unsigned long) TREE_INT_CST_LOW (size), @@ -1146,12 +1146,14 @@ translate_common (gfc_common_head *common, gfc_symbol *var_list) if (warn_align_commons) { if (strcmp (common->name, BLANK_COMMON_NAME)) - gfc_warning ("Padding of %d bytes required before %qs in " + gfc_warning (0, + "Padding of %d bytes required before %qs in " "COMMON %qs at %L; reorder elements or use " "-fno-align-commons", (int)offset, s->sym->name, common->name, &common->where); else - gfc_warning ("Padding of %d bytes required before %qs in " + gfc_warning (0, + "Padding of %d bytes required before %qs in " "COMMON at %L; reorder elements or use " "-fno-align-commons", (int)offset, s->sym->name, &common->where); diff --git a/gcc/fortran/trans-const.c b/gcc/fortran/trans-const.c index eb447a5d761..76463449522 100644 --- a/gcc/fortran/trans-const.c +++ b/gcc/fortran/trans-const.c @@ -332,7 +332,7 @@ gfc_conv_constant_to_tree (gfc_expr * expr) gfc_build_string_const (expr->representation.length, expr->representation.string)); if (!integer_zerop (tmp) && !integer_onep (tmp)) - gfc_warning ("Assigning value other than 0 or 1 to LOGICAL" + gfc_warning (0, "Assigning value other than 0 or 1 to LOGICAL" " has undefined result at %L", &expr->where); return fold_convert (gfc_get_logical_type (expr->ts.kind), tmp); } diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index 52caaa4a8cb..96e5abd6bed 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -550,7 +550,8 @@ gfc_trans_return (gfc_code * code) result = gfc_get_fake_result_decl (NULL, 0); if (!result) { - gfc_warning ("An alternate return at %L without a * dummy argument", + gfc_warning (0, + "An alternate return at %L without a * dummy argument", &code->expr1->where); return gfc_generate_return (); } -- 2.30.2