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:
parent
d6d34aa913
commit
48749dbcc4
29 changed files with 343 additions and 112 deletions
|
@ -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),
|
||||
|
|
|
@ -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>
|
||||
|
||||
|
|
|
@ -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));
|
||||
}
|
||||
|
||||
|
|
|
@ -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;
|
||||
}
|
||||
|
|
|
@ -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));
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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);
|
||||
}
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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);
|
||||
}
|
||||
|
|
|
@ -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;
|
||||
}
|
||||
|
|
|
@ -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++)
|
||||
|
|
|
@ -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);
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -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));
|
||||
|
|
|
@ -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,
|
||||
|
|
|
@ -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);
|
||||
}
|
||||
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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);
|
||||
}
|
||||
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -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 ();
|
||||
}
|
||||
|
||||
|
|
|
@ -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);
|
||||
}
|
||||
|
||||
|
|
|
@ -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 *);
|
||||
|
|
|
@ -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.
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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:
|
||||
|
|
Loading…
Add table
Reference in a new issue