re PR fortran/44054 (Handle -Werror, -Werror=, -fdiagnostics-show-option, !GCC$ diagnostic (pragmas) and color)

gcc/testsuite/ChangeLog:

2014-12-03  Manuel López-Ibáñez  <manu@gcc.gnu.org>

	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  <manu@gcc.gnu.org>

	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  <manu@gcc.gnu.org>

	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.

From-SVN: r218326
This commit is contained in:
Manuel López-Ibáñez 2014-12-03 17:50:06 +00:00
parent d6d34aa913
commit 48749dbcc4
29 changed files with 343 additions and 112 deletions

View File

@ -1,3 +1,12 @@
2014-12-03 Manuel López-Ibáñez <manu@gcc.gnu.org>
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 <jakub@redhat.com>
* Makefile.in (ALL_HOST_BACKEND_OBJS): Add $(GENGTYPE_OBJS),

View File

@ -1,3 +1,25 @@
2014-12-03 Manuel López-Ibáñez <manu@gcc.gnu.org>
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 <burnus@net-b.de>
Manuel López-Ibáñez <manu@gcc.gnu.org>

View File

@ -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));
}

View File

@ -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;
}

View File

@ -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));

View File

@ -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);

View File

@ -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 <new> /* 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

View File

@ -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);
}

View File

@ -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

View File

@ -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);

View File

@ -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)

View File

@ -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);
}

View File

@ -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;
}

View File

@ -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 %<q%> 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++)

View File

@ -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);

View File

@ -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

View File

@ -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);

View File

@ -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));

View File

@ -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,

View File

@ -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);
}

View File

@ -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;

View File

@ -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);
}

View File

@ -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);

View File

@ -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 ();
}

View File

@ -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_write_text_to_stream (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);
}

View File

@ -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 *);

View File

@ -1,3 +1,9 @@
2014-12-03 Manuel López-Ibáñez <manu@gcc.gnu.org>
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 <dje.gcc@gmail.com>
* g++.dg/ext/visibility/anon[12].C: Require visibility support.

View File

@ -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

View File

@ -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: