From 4166acc76b9450726817951d1a7fd1828bd04041 Mon Sep 17 00:00:00 2001 From: manu Date: Wed, 3 Dec 2014 17:50:06 +0000 Subject: [PATCH] gcc/testsuite/ChangeLog: MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit 2014-12-03 Manuel López-Ibáñez PR fortran/44054 * gfortran.dg/warnings_are_errors_1.f90: Update warnings to errors. * gfortran.dg/warnings_are_errors_1.f: Likewise. gcc/fortran/ChangeLog: 2014-12-03 Manuel López-Ibáñez PR fortran/44054 * gfortran.h (gfc_warning): Now returns bool. Add overload that accepts opt. (gfc_warning_1): Declare. * error.c (pp_warning_buffer,warningcount_buffered,werrorcount_buffered): New. (gfc_buffer_error): Set pp_warning_buffer.flush_p. (gfc_clear_pp_buffer): New. (gfc_warning_1): Renamed from gfc_warning. (gfc_warning): Add three new overloads. One that takes just a format string and ellipsis, another that takes also a warning option, and another that takes also va_list instead of ellipsis. (gfc_clear_warning): Clear pp_warning_buffer. (gfc_warning_check): Flush pp_warning_buffer and update warning and werror counters. (gfc_diagnostics_init): Init pp_warning_buffer. * Update all gfc_warning calls that do not multiple locations to use %qs and OPT_W*, otherwise use gfc_warning_1. gcc/ChangeLog: 2014-12-03 Manuel López-Ibáñez PR fortran/44054 * pretty-print.c (output_buffer::output_buffer): Init flush_p to true. (pp_flush): Flush only if flush_p. (pp_really_flush): New. * pretty-print.h (struct output_buffer): Add flush_p. (pp_really_flush): Declare. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@218326 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ChangeLog | 9 ++ gcc/fortran/ChangeLog | 22 ++++ gcc/fortran/arith.c | 14 +-- gcc/fortran/check.c | 6 +- gcc/fortran/decl.c | 19 ++-- gcc/fortran/dependency.c | 2 +- gcc/fortran/error.c | 124 ++++++++++++++++++++- gcc/fortran/expr.c | 26 +++-- gcc/fortran/frontend-passes.c | 7 +- gcc/fortran/gfortran.h | 4 +- gcc/fortran/interface.c | 30 ++--- gcc/fortran/intrinsic.c | 8 +- gcc/fortran/io.c | 4 +- gcc/fortran/primary.c | 9 +- gcc/fortran/resolve.c | 37 +++--- gcc/fortran/scanner.c | 3 +- gcc/fortran/simplify.c | 6 +- gcc/fortran/symbol.c | 10 +- gcc/fortran/trans-array.c | 12 +- gcc/fortran/trans-common.c | 18 +-- gcc/fortran/trans-decl.c | 38 ++++--- gcc/fortran/trans-expr.c | 6 +- gcc/fortran/trans-intrinsic.c | 3 +- gcc/fortran/trans-stmt.c | 2 +- gcc/pretty-print.c | 18 ++- gcc/pretty-print.h | 6 + gcc/testsuite/ChangeLog | 6 + gcc/testsuite/gfortran.dg/warnings_are_errors_1.f | 2 +- .../gfortran.dg/warnings_are_errors_1.f90 | 2 +- 29 files changed, 342 insertions(+), 111 deletions(-) diff --git a/gcc/ChangeLog b/gcc/ChangeLog index 5110db9..42a55e1 100644 --- a/gcc/ChangeLog +++ b/gcc/ChangeLog @@ -1,3 +1,12 @@ +2014-12-03 Manuel López-Ibáñez + + PR fortran/44054 + * pretty-print.c (output_buffer::output_buffer): Init flush_p to true. + (pp_flush): Flush only if flush_p. + (pp_really_flush): New. + * pretty-print.h (struct output_buffer): Add flush_p. + (pp_really_flush): Declare. + 2014-12-03 Jakub Jelinek * Makefile.in (ALL_HOST_BACKEND_OBJS): Add $(GENGTYPE_OBJS), diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 23ddc25..c645b6f 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,25 @@ +2014-12-03 Manuel López-Ibáñez + + PR fortran/44054 + * gfortran.h (gfc_warning): Now returns bool. Add overload that + accepts opt. + (gfc_warning_1): Declare. + * error.c + (pp_warning_buffer,warningcount_buffered,werrorcount_buffered): New. + (gfc_buffer_error): Set pp_warning_buffer.flush_p. + (gfc_clear_pp_buffer): New. + (gfc_warning_1): Renamed from gfc_warning. + (gfc_warning): Add three new overloads. One that takes just a + format string and ellipsis, another that takes also a warning + option, and another that takes also va_list instead of ellipsis. + (gfc_clear_warning): Clear pp_warning_buffer. + (gfc_warning_check): Flush pp_warning_buffer and update warning + and werror counters. + (gfc_diagnostics_init): Init pp_warning_buffer. + + * Update all gfc_warning calls that do not use multiple + locations to use %qs and OPT_W*, otherwise use gfc_warning_1. + 2014-12-02 Tobias Burnus Manuel López-Ibáñez diff --git a/gcc/fortran/arith.c b/gcc/fortran/arith.c index efbe6de..c692e62 100644 --- a/gcc/fortran/arith.c +++ b/gcc/fortran/arith.c @@ -545,7 +545,7 @@ check_result (arith rc, gfc_expr *x, gfc_expr *r, gfc_expr **rp) if (val == ARITH_UNDERFLOW) { if (warn_underflow) - gfc_warning (gfc_arith_error (val), &x->where); + gfc_warning (OPT_Wunderflow, gfc_arith_error (val), &x->where); val = ARITH_OK; } @@ -2078,7 +2078,7 @@ gfc_real2real (gfc_expr *src, int kind) if (rc == ARITH_UNDERFLOW) { if (warn_underflow) - gfc_warning (gfc_arith_error (rc), &src->where); + gfc_warning (OPT_Woverflow, gfc_arith_error (rc), &src->where); mpfr_set_ui (result->value.real, 0, GFC_RND_MODE); } else if (rc != ARITH_OK) @@ -2109,7 +2109,7 @@ gfc_real2complex (gfc_expr *src, int kind) if (rc == ARITH_UNDERFLOW) { if (warn_underflow) - gfc_warning (gfc_arith_error (rc), &src->where); + gfc_warning (OPT_Woverflow, gfc_arith_error (rc), &src->where); mpfr_set_ui (mpc_realref (result->value.complex), 0, GFC_RND_MODE); } else if (rc != ARITH_OK) @@ -2164,7 +2164,7 @@ gfc_complex2real (gfc_expr *src, int kind) if (rc == ARITH_UNDERFLOW) { if (warn_underflow) - gfc_warning (gfc_arith_error (rc), &src->where); + gfc_warning (OPT_Woverflow, gfc_arith_error (rc), &src->where); mpfr_set_ui (result->value.real, 0, GFC_RND_MODE); } if (rc != ARITH_OK) @@ -2195,7 +2195,7 @@ gfc_complex2complex (gfc_expr *src, int kind) if (rc == ARITH_UNDERFLOW) { if (warn_underflow) - gfc_warning (gfc_arith_error (rc), &src->where); + gfc_warning (OPT_Woverflow, gfc_arith_error (rc), &src->where); mpfr_set_ui (mpc_realref (result->value.complex), 0, GFC_RND_MODE); } else if (rc != ARITH_OK) @@ -2210,7 +2210,7 @@ gfc_complex2complex (gfc_expr *src, int kind) if (rc == ARITH_UNDERFLOW) { if (warn_underflow) - gfc_warning (gfc_arith_error (rc), &src->where); + gfc_warning (OPT_Woverflow, gfc_arith_error (rc), &src->where); mpfr_set_ui (mpc_imagref (result->value.complex), 0, GFC_RND_MODE); } else if (rc != ARITH_OK) @@ -2280,7 +2280,7 @@ 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 %s", + gfc_warning ("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 cea2689..c3f78e1 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -5081,9 +5081,9 @@ 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: " - "source size %ld < result size %ld", &source->where, - (long) source_size, (long) result_size); + gfc_warning ("Intrinsic TRANSFER at %L has partly undefined result: " + "source size %ld < result size %ld", &source->where, + (long) source_size, (long) result_size); return true; } diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index f11bcb0..f374b9a 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -1030,8 +1030,9 @@ gfc_verify_c_interop_param (gfc_symbol *sym) sym->name, &(sym->declared_at), sym->ns->proc_name->name); else if (warn_c_binding_type) - gfc_warning ("Variable '%s' at %L is a dummy argument of the " - "BIND(C) procedure '%s' but may not be C " + gfc_warning (OPT_Wc_binding_type, + "Variable %qs at %L is a dummy argument of the " + "BIND(C) procedure %qs but may not be C " "interoperable", sym->name, &(sym->declared_at), sym->ns->proc_name->name); @@ -3294,8 +3295,8 @@ gfc_match_import (void) if (gfc_find_symtree (gfc_current_ns->sym_root, name)) { - gfc_warning ("'%s' is already IMPORTed from host scoping unit " - "at %C.", name); + gfc_warning ("%qs is already IMPORTed from host scoping unit " + "at %C", name); goto next_item; } @@ -4031,7 +4032,8 @@ verify_bind_c_sym (gfc_symbol *tmp_sym, gfc_typespec *ts, /* Make sure it wasn't an implicitly typed result. */ if (tmp_sym->attr.implicit_type && warn_c_binding_type) { - gfc_warning ("Implicitly declared BIND(C) function '%s' at " + gfc_warning (OPT_Wc_binding_type, + "Implicitly declared BIND(C) function %qs at " "%L may not be C interoperable", tmp_sym->name, &tmp_sym->declared_at); tmp_sym->ts.f90_type = tmp_sym->ts.type; @@ -4052,9 +4054,10 @@ verify_bind_c_sym (gfc_symbol *tmp_sym, gfc_typespec *ts, /* See if we're dealing with a sym in a common block or not. */ if (is_in_common == 1 && warn_c_binding_type) { - gfc_warning ("Variable '%s' in common block '%s' at %L " + gfc_warning (OPT_Wc_binding_type, + "Variable %qs in common block %qs at %L " "may not be a C interoperable " - "kind though common block '%s' is BIND(C)", + "kind though common block %qs is BIND(C)", tmp_sym->name, com_block->name, &(tmp_sym->declared_at), com_block->name); } @@ -4065,7 +4068,7 @@ verify_bind_c_sym (gfc_symbol *tmp_sym, gfc_typespec *ts, "interoperable but it is BIND(C)", tmp_sym->name, &(tmp_sym->declared_at)); else if (warn_c_binding_type) - gfc_warning ("Variable '%s' at %L " + gfc_warning (OPT_Wc_binding_type, "Variable %qs at %L " "may not be a C interoperable " "kind but it is bind(c)", tmp_sym->name, &(tmp_sym->declared_at)); diff --git a/gcc/fortran/dependency.c b/gcc/fortran/dependency.c index 1864145..420ca70 100644 --- a/gcc/fortran/dependency.c +++ b/gcc/fortran/dependency.c @@ -956,7 +956,7 @@ gfc_check_argument_var_dependency (gfc_expr *var, sym_intent intent, If a dependency is found in the case elemental == ELEM_CHECK_VARIABLE, we will generate a temporary, so we don't need to bother the user. */ - gfc_warning ("INTENT(%s) actual argument at %L might " + gfc_warning_1 ("INTENT(%s) actual argument at %L might " "interfere with actual argument at %L.", intent == INTENT_OUT ? "OUT" : "INOUT", &var->where, &expr->where); diff --git a/gcc/fortran/error.c b/gcc/fortran/error.c index 70429d3..d6475f3 100644 --- a/gcc/fortran/error.c +++ b/gcc/fortran/error.c @@ -50,6 +50,10 @@ static int terminal_width, buffer_flag, errors, warnings; static gfc_error_buf error_buffer, warning_buffer, *cur_error_buffer; +static output_buffer pp_warning_buffer; +static int warningcount_buffered, werrorcount_buffered; + +#include /* For placement-new */ /* Go one level deeper suppressing errors. */ @@ -122,6 +126,7 @@ void gfc_buffer_error (int flag) { buffer_flag = flag; + pp_warning_buffer.flush_p = !flag; } @@ -804,10 +809,25 @@ gfc_increment_error_count (void) } +/* Clear any output buffered in a pretty-print output_buffer. */ + +static void +gfc_clear_pp_buffer (output_buffer *this_buffer) +{ + pretty_printer *pp = global_dc->printer; + output_buffer *tmp_buffer = pp->buffer; + pp->buffer = this_buffer; + pp_clear_output_area (pp); + pp->buffer = tmp_buffer; +} + + /* Issue a warning. */ +/* Use gfc_warning instead, unless two locations are used in the same + warning or for scanner.c, if the location is not properly set up. */ void -gfc_warning (const char *gmsgid, ...) +gfc_warning_1 (const char *gmsgid, ...) { va_list argp; @@ -833,6 +853,88 @@ gfc_warning (const char *gmsgid, ...) } +/* This is just a helper function to avoid duplicating the logic of + 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; + va_copy (argp, ap); + + diagnostic_info diagnostic; + bool fatal_errors = global_dc->fatal_errors; + pretty_printer *pp = global_dc->printer; + output_buffer *tmp_buffer = pp->buffer; + bool buffered_p = !pp_warning_buffer.flush_p; + + gfc_clear_pp_buffer (&pp_warning_buffer); + + if (buffered_p) + { + pp->buffer = &pp_warning_buffer; + global_dc->fatal_errors = false; + /* To prevent -fmax-errors= triggering. */ + --werrorcount; + } + + diagnostic_set_info (&diagnostic, gmsgid, &argp, UNKNOWN_LOCATION, + DK_WARNING); + diagnostic.option_index = opt; + bool ret = report_diagnostic (&diagnostic); + + if (buffered_p) + { + pp->buffer = tmp_buffer; + global_dc->fatal_errors = fatal_errors; + + warningcount_buffered = 0; + werrorcount_buffered = 0; + /* Undo the above --werrorcount if not Werror, otherwise + werrorcount is correct already. */ + if (!ret) + ++werrorcount; + else if (diagnostic.kind == DK_ERROR) + ++werrorcount_buffered; + else + ++werrorcount, --warningcount, ++warningcount_buffered; + } + + va_end (argp); + return ret; +} + +/* Issue a 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_1. */ + +bool +gfc_warning (int opt, const char *gmsgid, ...) +{ + va_list argp; + + va_start (argp, gmsgid); + bool ret = gfc_warning (opt, gmsgid, argp); + va_end (argp); + 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. */ @@ -1176,6 +1278,11 @@ void gfc_clear_warning (void) { warning_buffer.flag = 0; + + gfc_clear_pp_buffer (&pp_warning_buffer); + warningcount_buffered = 0; + werrorcount_buffered = 0; + pp_warning_buffer.flush_p = false; } @@ -1192,6 +1299,20 @@ gfc_warning_check (void) fputs (warning_buffer.message, stderr); warning_buffer.flag = 0; } + + /* This is for the new diagnostics machinery. */ + pretty_printer *pp = global_dc->printer; + output_buffer *tmp_buffer = pp->buffer; + pp->buffer = &pp_warning_buffer; + if (pp_last_position_in_text (pp) != NULL) + { + pp_really_flush (pp); + pp_warning_buffer.flush_p = true; + warningcount += warningcount_buffered; + werrorcount += werrorcount_buffered; + } + + pp->buffer = tmp_buffer; } @@ -1407,6 +1528,7 @@ gfc_diagnostics_init (void) diagnostic_finalizer (global_dc) = gfc_diagnostic_finalizer; diagnostic_format_decoder (global_dc) = gfc_format_decoder; global_dc->caret_char = '^'; + new (&pp_warning_buffer) output_buffer (); } void diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index 59f770c..edf8336 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -3173,7 +3173,8 @@ gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform) /* This is possibly a typo: x = f() instead of x => f(). */ if (warn_surprising && rvalue->expr_type == EXPR_FUNCTION && gfc_expr_attr (rvalue).pointer) - gfc_warning ("POINTER-valued function appears on right-hand side of " + gfc_warning (OPT_Wsurprising, + "POINTER-valued function appears on right-hand side of " "assignment at %L", &rvalue->where); /* Check size of array assignments. */ @@ -3198,9 +3199,10 @@ gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform) { int rc; if (warn_surprising) - gfc_warning ("BOZ literal at %L is bitwise transferred " - "non-integer symbol '%s'", &rvalue->where, - lvalue->symtree->n.sym->name); + gfc_warning (OPT_Wsurprising, + "BOZ literal at %L is bitwise transferred " + "non-integer symbol %qs", &rvalue->where, + lvalue->symtree->n.sym->name); if (!gfc_convert_boz (rvalue, &lvalue->ts)) return false; if ((rc = gfc_range_check (rvalue)) != ARITH_OK) @@ -3246,22 +3248,25 @@ gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform) mpfr_sub (diff, rv, rvalue->value.real, GFC_RND_MODE); if (!mpfr_zero_p (diff)) - gfc_warning ("Change of value in conversion from " - " %s to %s at %L", gfc_typename (&rvalue->ts), + gfc_warning (OPT_Wconversion, + "Change of value in conversion from " + " %qs to %qs at %L", gfc_typename (&rvalue->ts), gfc_typename (&lvalue->ts), &rvalue->where); mpfr_clear (rv); mpfr_clear (diff); } else - gfc_warning ("Possible change of value in conversion from %s " - "to %s at %L",gfc_typename (&rvalue->ts), + gfc_warning (OPT_Wconversion, + "Possible change of value in conversion from %qs " + "to %qs at %L", gfc_typename (&rvalue->ts), gfc_typename (&lvalue->ts), &rvalue->where); } else if (warn_conversion_extra && lvalue->ts.kind > rvalue->ts.kind) { - gfc_warning ("Conversion from %s to %s at %L", + gfc_warning (OPT_Wconversion_extra, + "Conversion from %qs to %qs at %L", gfc_typename (&rvalue->ts), gfc_typename (&lvalue->ts), &rvalue->where); } @@ -3783,7 +3788,8 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue) } if (warn) - gfc_warning ("Pointer at %L in pointer assignment might outlive the " + gfc_warning (OPT_Wtarget_lifetime, + "Pointer at %L in pointer assignment might outlive the " "pointer target", &lvalue->where); } diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c index 799d2fe..5485cd1 100644 --- a/gcc/fortran/frontend-passes.c +++ b/gcc/fortran/frontend-passes.c @@ -547,7 +547,8 @@ create_var (gfc_expr * e) result->ref->u.ar.as = symbol->ts.type == BT_CLASS ? CLASS_DATA (symbol)->as : symbol->as; if (warn_array_temporaries) - gfc_warning ("Creating array temporary at %L", &(e->where)); + gfc_warning (OPT_Warray_temporaries, + "Creating array temporary at %L", &(e->where)); } /* Generate the new assignment. */ @@ -570,10 +571,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 '%s' at %L", + gfc_warning ("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 '%s' at %L", + gfc_warning ("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 1bf9862..0baf041 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -2672,7 +2672,9 @@ void gfc_buffer_error (int); const char *gfc_print_wide_char (gfc_char_t); -void gfc_warning (const char *, ...) ATTRIBUTE_GCC_GFC(1,2); +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); diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index 2429fd2..bf07d43 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 '%s'", + gfc_warning ("Possible character length mismatch in argument %qs", s1->name);*/ break; @@ -1649,11 +1649,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 '%s' and '%s' in %s at %L", + gfc_warning ("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, '%s' has ambiguous " + gfc_warning ("Although not referenced, %qs has ambiguous " "interfaces at %L", interface_name, &p->where); return 1; } @@ -2147,8 +2147,9 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, return 0; } else if (warn_surprising && where && formal->attr.intent != INTENT_IN) - gfc_warning ("Passing coarray at %L to allocatable, noncoarray dummy " - "argument '%s', which is invalid if the allocation status" + gfc_warning (OPT_Wsurprising, + "Passing coarray at %L to allocatable, noncoarray dummy " + "argument %qs, which is invalid if the allocation status" " is modified", &actual->where, formal->name); } @@ -2673,13 +2674,13 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, if (where && (f->sym->attr.pointer || f->sym->attr.allocatable)) gfc_warning ("Character length mismatch (%ld/%ld) between actual " "argument and pointer or allocatable dummy argument " - "'%s' at %L", + "%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 " - "argument and assumed-shape dummy argument '%s' " + "argument and assumed-shape 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), @@ -2710,12 +2711,12 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, { if (a->expr->ts.type == BT_CHARACTER && !f->sym->as && where) gfc_warning ("Character length of actual argument shorter " - "than of dummy argument '%s' (%lu/%lu) at %L", + "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 " - "elements for dummy argument '%s' (%lu/%lu) at %L", + "elements for dummy argument %qs (%lu/%lu) at %L", f->sym->name, actual_size, formal_size, &a->expr->where); return 0; @@ -3146,7 +3147,7 @@ check_some_aliasing (gfc_formal_arglist *f, gfc_actual_arglist *a) || (f1_intent == INTENT_OUT && f2_intent == INTENT_OUT)) { gfc_warning ("Same actual argument associated with INTENT(%s) " - "argument '%s' and INTENT(%s) argument '%s' at %L", + "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, &p[i].a->expr->where); @@ -3261,10 +3262,12 @@ gfc_procedure_use (gfc_symbol *sym, gfc_actual_arglist **ap, locus *where) return false; } if (warn_implicit_interface) - gfc_warning ("Procedure '%s' called with an implicit interface at %L", + gfc_warning (OPT_Wimplicit_interface, + "Procedure %qs called with an implicit interface at %L", sym->name, where); else if (warn_implicit_procedure && sym->attr.proc == PROC_UNKNOWN) - gfc_warning ("Procedure '%s' called at %L is not explicitly declared", + gfc_warning (OPT_Wimplicit_procedure, + "Procedure %qs called at %L is not explicitly declared", sym->name, where); } @@ -3376,7 +3379,8 @@ gfc_ppc_use (gfc_component *comp, gfc_actual_arglist **ap, locus *where) if (warn_implicit_interface && comp->attr.if_source == IFSRC_UNKNOWN && !comp->attr.is_iso_c) - gfc_warning ("Procedure pointer component '%s' called with an implicit " + gfc_warning (OPT_Wimplicit_interface, + "Procedure pointer component %qs called with an implicit " "interface at %L", comp->name, where); if (comp->attr.if_source == IFSRC_UNKNOWN) diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c index 5dd4092..baaa05a 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 '%s' (is %s) is used at %L", + gfc_warning ("Intrinsic %qs (is %s) is used at %L", isym->name, _(symstd_msg), &where); return true; @@ -4824,12 +4824,14 @@ gfc_warn_intrinsic_shadow (const gfc_symbol* sym, bool in_module, bool func) /* Emit the warning. */ if (in_module || sym->ns->proc_name) - gfc_warning ("'%s' declared at %L may shadow the intrinsic of the same" + gfc_warning (OPT_Wintrinsic_shadow, + "%qs declared at %L may shadow the intrinsic of the same" " name. In order to call the intrinsic, explicit INTRINSIC" " declarations may be required.", sym->name, &sym->declared_at); else - gfc_warning ("'%s' declared at %L is also the name of an intrinsic. It can" + gfc_warning (OPT_Wintrinsic_shadow, + "%qs declared at %L is also the name of an intrinsic. It can" " only be called via an explicit interface or if declared" " EXTERNAL.", sym->name, &sym->declared_at); } diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c index 731c6dc..de8254a 100644 --- a/gcc/fortran/io.c +++ b/gcc/fortran/io.c @@ -1721,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 " - "has value '%s'", specifier, statement, + "has value %qs", specifier, statement, allowed_f2003[i]); return 1; } @@ -1748,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 " - "has value '%s'", specifier, statement, + "has value %qs", specifier, statement, allowed_gnu[i]); return 1; } diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c index a7a26a1..10ea61a 100644 --- a/gcc/fortran/primary.c +++ b/gcc/fortran/primary.c @@ -558,8 +558,9 @@ match_real_constant (gfc_expr **result, int signflag) "real-literal-constant at %C")) return MATCH_ERROR; else if (warn_real_q_constant) - gfc_warning("Extension: exponent-letter 'q' in real-literal-constant " - "at %C"); + gfc_warning (OPT_Wreal_q_constant, + "Extension: exponent-letter % in real-literal-constant " + "at %C"); } /* Scan exponent. */ @@ -727,7 +728,7 @@ done: case ARITH_UNDERFLOW: if (warn_underflow) - gfc_warning ("Real constant underflows its kind at %C"); + gfc_warning (OPT_Wunderflow, "Real constant underflows its kind at %C"); mpfr_set_ui (e->value.real, 0, GFC_RND_MODE); break; @@ -1072,7 +1073,7 @@ got_delim: /* We disable the warning for the following loop as the warning has already been printed in the loop above. */ save_warn_ampersand = warn_ampersand; - warn_ampersand = 0; + warn_ampersand = false; p = e->value.character.string; for (i = 0; i < length; i++) diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index dfc2eb6..6571578 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -1645,7 +1645,8 @@ gfc_resolve_intrinsic (gfc_symbol *sym, locus *loc) { if (sym->ts.type != BT_UNKNOWN && warn_surprising && !sym->attr.implicit_type) - gfc_warning ("Type specified for intrinsic function '%s' at %L is" + gfc_warning (OPT_Wsurprising, + "Type specified for intrinsic function %qs at %L is" " ignored", sym->name, &sym->declared_at); if (!sym->attr.function && @@ -1718,9 +1719,9 @@ 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 '%s' at %L is possibly calling" + gfc_warning ("Non-RECURSIVE procedure %qs at %L is possibly calling" " itself recursively. Declare it RECURSIVE or use" - " -frecursive", sym->name, &expr->where); + " %<-frecursive%>", sym->name, &expr->where); return true; } @@ -2101,7 +2102,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 ("'%s' at %L is an array and OPTIONAL; IF IT IS " + gfc_warning ("%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)", @@ -6332,8 +6333,8 @@ gfc_resolve_iterator (gfc_iterator *iter, bool real_ok, bool own_scope) cmp = mpfr_cmp (iter->end->value.real, iter->start->value.real); } if (warn_zerotrip && ((sgn > 0 && cmp < 0) || (sgn < 0 && cmp > 0))) - gfc_warning ("DO loop at %L will be executed zero times" - " (use -Wno-zerotrip to suppress)", + gfc_warning (OPT_Wzerotrip, + "DO loop at %L will be executed zero times", &iter->step->where); } @@ -7709,8 +7710,9 @@ resolve_select (gfc_code *code, bool select_type) && gfc_compare_expr (cp->low, cp->high, INTRINSIC_GT) > 0) { if (warn_surprising) - gfc_warning ("Range specification at %L can never " - "be matched", &cp->where); + gfc_warning (OPT_Wsurprising, + "Range specification at %L can never be matched", + &cp->where); cp->unreachable = 1; seen_unreachable = 1; @@ -7811,7 +7813,8 @@ resolve_select (gfc_code *code, bool select_type) /* More than two cases is legal but insane for logical selects. Issue a warning for it. */ if (warn_surprising && type == BT_LOGICAL && ncases > 2) - gfc_warning ("Logical SELECT CASE block at %L has more that two cases", + gfc_warning (OPT_Wsurprising, + "Logical SELECT CASE block at %L has more that two cases", &code->loc); } @@ -8799,7 +8802,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 '%s' is not used on the " + gfc_warning ("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); @@ -9181,8 +9184,9 @@ resolve_ordinary_assign (gfc_code *code, gfc_namespace *ns) { int rc; if (warn_surprising) - gfc_warning ("BOZ literal at %L is bitwise transferred " - "non-integer symbol '%s'", &code->loc, + gfc_warning (OPT_Wsurprising, + "BOZ literal at %L is bitwise transferred " + "non-integer symbol %qs", &code->loc, lhs->symtree->n.sym->name); if (!gfc_convert_boz (rhs, &lhs->ts)) @@ -10482,7 +10486,8 @@ resolve_charlen (gfc_charlen *cl) if (cl->length && !gfc_extract_int (cl->length, &i) && i < 0) { if (warn_surprising) - gfc_warning_now ("CHARACTER variable at %L has negative length %d," + gfc_warning_now (OPT_Wsurprising, + "CHARACTER variable at %L has negative length %d," " the length has been set to zero", &cl->length->where, i); gfc_replace_expr (cl->length, @@ -11499,7 +11504,8 @@ gfc_resolve_finalizers (gfc_symbol* derived, bool *finalizable) /* Warn if the procedure is non-scalar and not assumed shape. */ if (warn_surprising && arg->as && arg->as->rank != 0 && arg->as->type != AS_ASSUMED_SHAPE) - gfc_warning ("Non-scalar FINAL procedure at %L should have assumed" + gfc_warning (OPT_Wsurprising, + "Non-scalar FINAL procedure at %L should have assumed" " shape argument", &arg->declared_at); /* Check that it does not match in kind and rank with a FINAL procedure @@ -11557,7 +11563,8 @@ error: were nodes in the list, must have been for arrays. It is surely a good idea to have a scalar version there if there's something to finalize. */ if (warn_surprising && result && !seen_scalar) - gfc_warning ("Only array FINAL procedures declared for derived type '%s'" + gfc_warning (OPT_Wsurprising, + "Only array FINAL procedures declared for derived type %qs" " defined at %L, suggest also scalar one", derived->name, &derived->declared_at); diff --git a/gcc/fortran/scanner.c b/gcc/fortran/scanner.c index 8222b7e..0de0998 100644 --- a/gcc/fortran/scanner.c +++ b/gcc/fortran/scanner.c @@ -1155,7 +1155,8 @@ restart: { gfc_current_locus.nextc--; if (warn_ampersand && in_string == INSTRING_WARN) - gfc_warning ("Missing '&' in continued character " + gfc_warning (OPT_Wampersand, + "Missing %<&%> in continued character " "constant at %C"); } /* Both !$omp and !$ -fopenmp continuation lines have & on the diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c index 7ccabc7..095de6b 100644 --- a/gcc/fortran/simplify.c +++ b/gcc/fortran/simplify.c @@ -716,7 +716,8 @@ simplify_achar_char (gfc_expr *e, gfc_expr *k, const char *name, bool ascii) } if (ascii && warn_surprising && mpz_cmp_si (e->value.integer, 127) > 0) - gfc_warning ("Argument of %s function at %L outside of range [0,127]", + gfc_warning (OPT_Wsurprising, + "Argument of %s function at %L outside of range [0,127]", name, &e->where); if (kind == 1 && mpz_cmp_si (e->value.integer, 255) > 0) @@ -2505,7 +2506,8 @@ gfc_simplify_iachar (gfc_expr *e, gfc_expr *kind) index = e->value.character.string[0]; if (warn_surprising && index > 127) - gfc_warning ("Argument of IACHAR function at %L outside of range 0..127", + gfc_warning (OPT_Wsurprising, + "Argument of IACHAR function at %L outside of range 0..127", &e->where); k = get_kind (BT_INTEGER, kind, "IACHAR", gfc_default_integer_kind); diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index fa0ffe0..92a15d0 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 '%s' with BIND(C) attribute at %L is empty, " + gfc_warning ("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; @@ -3954,16 +3954,18 @@ verify_bind_c_derived_type (gfc_symbol *derived_sym) if (derived_sym->attr.is_bind_c == 1 && warn_c_binding_type) /* If the derived type is bind(c), all fields must be interop. */ - gfc_warning ("Component '%s' in derived type '%s' at %L " + gfc_warning (OPT_Wc_binding_type, + "Component %qs in derived type %qs at %L " "may not be C interoperable, even though " - "derived type '%s' is BIND(C)", + "derived type %qs is BIND(C)", curr_comp->name, derived_sym->name, &(curr_comp->loc), derived_sym->name); else if (warn_c_binding_type) /* If derived type is param to bind(c) routine, or to one of the iso_c_binding procs, it must be interoperable, so all fields must interop too. */ - gfc_warning ("Component '%s' in derived type '%s' at %L " + gfc_warning (OPT_Wc_binding_type, + "Component %qs in derived type %qs at %L " "may not be C interoperable", curr_comp->name, derived_sym->name, &(curr_comp->loc)); diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 47364da..f02ff32 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -1042,7 +1042,8 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss, gcc_assert (ss->loop->dimen == ss->dimen); if (warn_array_temporaries && where) - gfc_warning ("Creating array temporary at %L", where); + gfc_warning (OPT_Warray_temporaries, + "Creating array temporary at %L", where); /* Set the lower bound to zero. */ for (s = ss; s; s = s->parent) @@ -5922,7 +5923,8 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, stride = gfc_index_one_node; if (warn_array_temporaries) - gfc_warning ("Creating array temporary at %L", &loc); + gfc_warning (OPT_Warray_temporaries, + "Creating array temporary at %L", &loc); } /* This is for the case where the array data is used directly without @@ -7205,10 +7207,12 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, bool g77, if (warn_array_temporaries) { if (fsym) - gfc_warning ("Creating array temporary at %L for argument '%s'", + gfc_warning (OPT_Warray_temporaries, + "Creating array temporary at %L for argument %qs", &expr->where, fsym->name); else - gfc_warning ("Creating array temporary at %L", &expr->where); + gfc_warning (OPT_Warray_temporaries, + "Creating array temporary at %L", &expr->where); } ptr = build_call_expr_loc (input_location, diff --git a/gcc/fortran/trans-common.c b/gcc/fortran/trans-common.c index 0b4f5e6..f5d831f 100644 --- a/gcc/fortran/trans-common.c +++ b/gcc/fortran/trans-common.c @@ -397,7 +397,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 '%s' at %L shall be of the " + gfc_warning ("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), @@ -1136,12 +1136,12 @@ 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 '%s' in " - "COMMON '%s' at %L; reorder elements or use " + gfc_warning ("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 '%s' in " + gfc_warning ("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); @@ -1170,12 +1170,14 @@ translate_common (gfc_common_head *common, gfc_symbol *var_list) if (common_segment->offset != 0 && warn_align_commons) { if (strcmp (common->name, BLANK_COMMON_NAME)) - gfc_warning ("COMMON '%s' at %L requires %d bytes of padding; " - "reorder elements or use -fno-align-commons", + gfc_warning (OPT_Walign_commons, + "COMMON %qs at %L requires %d bytes of padding; " + "reorder elements or use %<-fno-align-commons%>", common->name, &common->where, (int)common_segment->offset); else - gfc_warning ("COMMON at %L requires %d bytes of padding; " - "reorder elements or use -fno-align-commons", + gfc_warning (OPT_Walign_commons, + "COMMON at %L requires %d bytes of padding; " + "reorder elements or use %<-fno-align-commons%>", &common->where, (int)common_segment->offset); } diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 713f969..780d350 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -3795,7 +3795,8 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block) } /* TODO: move to the appropriate place in resolve.c. */ if (warn_return_type && el == NULL) - gfc_warning ("Return value of function '%s' at %L not set", + gfc_warning (OPT_Wreturn_type, + "Return value of function %qs at %L not set", proc_sym->name, &proc_sym->declared_at); } else if (proc_sym->as) @@ -4430,7 +4431,8 @@ gfc_create_module_variable (gfc_symbol * sym) if (warn_unused_variable && !sym->attr.referenced && sym->attr.access == ACCESS_PRIVATE) - gfc_warning ("Unused PRIVATE module variable '%s' declared at %L", + gfc_warning (OPT_Wunused_value, + "Unused PRIVATE module variable %qs declared at %L", sym->name, &sym->declared_at); /* We always want module variables to be created. */ @@ -4992,12 +4994,14 @@ generate_local_decl (gfc_symbol * sym) if (warn_unused_dummy_argument && sym->attr.intent == INTENT_OUT) { if (sym->ts.type != BT_DERIVED) - gfc_warning ("Dummy argument '%s' at %L was declared " + gfc_warning (OPT_Wunused_dummy_argument, + "Dummy argument %qs at %L was declared " "INTENT(OUT) but was not set", sym->name, &sym->declared_at); else if (!gfc_has_default_initializer (sym->ts.u.derived) && !sym->ts.u.derived->attr.zero_comp) - gfc_warning ("Derived-type dummy argument '%s' at %L was " + gfc_warning (OPT_Wunused_dummy_argument, + "Derived-type dummy argument %qs at %L was " "declared INTENT(OUT) but was not set and " "does not have a default initializer", sym->name, &sym->declared_at); @@ -5006,8 +5010,9 @@ generate_local_decl (gfc_symbol * sym) } else if (warn_unused_dummy_argument) { - gfc_warning ("Unused dummy argument '%s' at %L", sym->name, - &sym->declared_at); + gfc_warning (OPT_Wunused_dummy_argument, + "Unused dummy argument %qs at %L", sym->name, + &sym->declared_at); if (sym->backend_decl != NULL_TREE) TREE_NO_WARNING(sym->backend_decl) = 1; } @@ -5020,7 +5025,8 @@ generate_local_decl (gfc_symbol * sym) { if (sym->attr.use_only) { - gfc_warning ("Unused module variable '%s' which has been " + gfc_warning (OPT_Wunused_variable, + "Unused module variable %qs which has been " "explicitly imported at %L", sym->name, &sym->declared_at); if (sym->backend_decl != NULL_TREE) @@ -5028,7 +5034,8 @@ generate_local_decl (gfc_symbol * sym) } else if (!sym->attr.use_assoc) { - gfc_warning ("Unused variable '%s' declared at %L", + gfc_warning (OPT_Wunused_variable, + "Unused variable %qs declared at %L", sym->name, &sym->declared_at); if (sym->backend_decl != NULL_TREE) TREE_NO_WARNING(sym->backend_decl) = 1; @@ -5076,10 +5083,12 @@ generate_local_decl (gfc_symbol * sym) && !sym->attr.referenced) { if (!sym->attr.use_assoc) - gfc_warning ("Unused parameter '%s' declared at %L", sym->name, + gfc_warning (OPT_Wunused_parameter, + "Unused parameter %qs declared at %L", sym->name, &sym->declared_at); else if (sym->attr.use_only) - gfc_warning ("Unused parameter '%s' which has been explicitly " + gfc_warning (OPT_Wunused_parameter, + "Unused parameter %qs which has been explicitly " "imported at %L", sym->name, &sym->declared_at); } } @@ -5094,7 +5103,8 @@ generate_local_decl (gfc_symbol * sym) && !sym->attr.use_assoc && sym->attr.if_source != IFSRC_IFBODY) { - gfc_warning ("Return value '%s' of function '%s' declared at " + gfc_warning (OPT_Wreturn_type, + "Return value %qs of function %qs declared at " "%L not set", sym->result->name, sym->name, &sym->result->declared_at); @@ -5121,7 +5131,8 @@ generate_local_decl (gfc_symbol * sym) if (!sym->attr.referenced) { if (warn_unused_dummy_argument) - gfc_warning ("Unused dummy argument '%s' at %L", sym->name, + gfc_warning (OPT_Wunused_dummy_argument, + "Unused dummy argument %qs at %L", sym->name, &sym->declared_at); } @@ -5801,7 +5812,8 @@ gfc_generate_function_code (gfc_namespace * ns) { /* TODO: move to the appropriate place in resolve.c. */ if (warn_return_type && sym == sym->result) - gfc_warning ("Return value of function '%s' at %L not set", + gfc_warning (OPT_Wreturn_type, + "Return value of function %qs at %L not set", sym->name, &sym->declared_at); if (warn_return_type) TREE_NO_WARNING(sym->backend_decl) = 1; diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index f8e4df8..7bdcc72 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -1112,10 +1112,12 @@ static void realloc_lhs_warning (bt type, bool array, locus *where) { if (array && type != BT_CLASS && type != BT_DERIVED && warn_realloc_lhs) - gfc_warning ("Code for reallocating the allocatable array at %L will " + gfc_warning (OPT_Wrealloc_lhs, + "Code for reallocating the allocatable array at %L will " "be added", where); else if (warn_realloc_lhs_all) - gfc_warning ("Code for reallocating the allocatable variable at %L " + gfc_warning (OPT_Wrealloc_lhs_all, + "Code for reallocating the allocatable variable at %L " "will be added", where); } diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index d597207..4ebe492 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -6147,7 +6147,8 @@ gfc_conv_intrinsic_transfer (gfc_se * se, gfc_expr * expr) tmp = gfc_build_addr_expr (NULL_TREE, argse.expr); if (warn_array_temporaries) - gfc_warning ("Creating array temporary at %L", &expr->where); + gfc_warning (OPT_Warray_temporaries, + "Creating array temporary at %L", &expr->where); source = build_call_expr_loc (input_location, gfor_fndecl_in_pack, 1, tmp); diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index d17b075..d28d67b 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -540,7 +540,7 @@ gfc_trans_return (gfc_code * code) if (!result) { gfc_warning ("An alternate return at %L without a * dummy argument", - &code->expr1->where); + &code->expr1->where); return gfc_generate_return (); } diff --git a/gcc/pretty-print.c b/gcc/pretty-print.c index b0c6182..92912ca 100644 --- a/gcc/pretty-print.c +++ b/gcc/pretty-print.c @@ -40,7 +40,8 @@ output_buffer::output_buffer () cur_chunk_array (), stream (stderr), line_length (), - digit_buffer () + digit_buffer (), + flush_p (true) { obstack_init (&formatted_obstack); obstack_init (&chunk_obstack); @@ -679,12 +680,25 @@ pp_format_verbatim (pretty_printer *pp, text_info *text) pp_wrapping_mode (pp) = oldmode; } -/* Flush the content of BUFFER onto the attached stream. */ +/* Flush the content of BUFFER onto the attached stream. This + function does nothing unless pp->output_buffer->flush_p. */ void pp_flush (pretty_printer *pp) { + pp_clear_state (pp); + if (!pp->buffer->flush_p) + return; pp_write_text_to_stream (pp); + fflush (pp_buffer (pp)->stream); +} + +/* Flush the content of BUFFER onto the attached stream independently + of the value of pp->output_buffer->flush_p. */ +void +pp_really_flush (pretty_printer *pp) +{ pp_clear_state (pp); + pp_write_text_to_stream (pp); fflush (pp_buffer (pp)->stream); } diff --git a/gcc/pretty-print.h b/gcc/pretty-print.h index e315c41..d9e49be 100644 --- a/gcc/pretty-print.h +++ b/gcc/pretty-print.h @@ -100,6 +100,11 @@ struct output_buffer /* This must be large enough to hold any printed integer or floating-point value. */ char digit_buffer[128]; + + /* Nonzero means that text should be flushed when + appropriate. Otherwise, text is buffered until either + pp_really_flush or pp_clear_output_area are called. */ + bool flush_p; }; /* The type of pretty-printer flags passed to clients. */ @@ -314,6 +319,7 @@ extern void pp_printf (pretty_printer *, const char *, ...) extern void pp_verbatim (pretty_printer *, const char *, ...) ATTRIBUTE_GCC_PPDIAG(2,3); extern void pp_flush (pretty_printer *); +extern void pp_really_flush (pretty_printer *); extern void pp_format (pretty_printer *, text_info *); extern void pp_output_formatted_text (pretty_printer *); extern void pp_format_verbatim (pretty_printer *, text_info *); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index a11ed3a..f39ea80 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2014-12-03 Manuel López-Ibáñez + + PR fortran/44054 + * gfortran.dg/warnings_are_errors_1.f90: Update warnings to errors. + * gfortran.dg/warnings_are_errors_1.f: Likewise. + 2014-12-03 David Edelsohn * g++.dg/ext/visibility/anon[12].C: Require visibility support. diff --git a/gcc/testsuite/gfortran.dg/warnings_are_errors_1.f b/gcc/testsuite/gfortran.dg/warnings_are_errors_1.f index 49bf112..510f93e 100644 --- a/gcc/testsuite/gfortran.dg/warnings_are_errors_1.f +++ b/gcc/testsuite/gfortran.dg/warnings_are_errors_1.f @@ -18,7 +18,7 @@ end do call foo j bar ! gfc_warning: - r2(4) = 0 ! { dg-warning "is out of bounds" } + r2(4) = 0 ! { dg-error "is out of bounds" } goto 3 45 end diff --git a/gcc/testsuite/gfortran.dg/warnings_are_errors_1.f90 b/gcc/testsuite/gfortran.dg/warnings_are_errors_1.f90 index 8ce4699..efb4508 100644 --- a/gcc/testsuite/gfortran.dg/warnings_are_errors_1.f90 +++ b/gcc/testsuite/gfortran.dg/warnings_are_errors_1.f90 @@ -17,7 +17,7 @@ implicit none ! gfc_warning: -1234 complex :: cplx ! { dg-warning "defined but cannot be used" } +1234 complex :: cplx ! { dg-error "defined but cannot be used" } cplx = 20. ! gfc_warning_now: -- 2.7.4