gcc/fortran/
* gfortran.h (gfc_option_t): Remove flags moved as Var to .opt.
(gfc_error_now_1): Renamed from gfc_error_now.
(gfc_error_now): Renamed from gfc_error_now_2.
(gfc_warning_now_1): Renamed from gfc_warning_now.
(gfc_warning_now): Renamed from gfc_warning_now_2.
* error.c (gfc_error_now_1): Renamed from gfc_error_now.
(gfc_error_now): Renamed from gfc_error_now_2.
(gfc_warning_now_1): Renamed from gfc_warning_now.
(gfc_warning_now): Renamed from gfc_warning_now_2.
(gfc_get_errors): Include common diagnostic in count.
* lang.opt (Wc-binding-type, Wconversion, Wconversion-extra,
Wintrinsics-std): Create a Var for those warnings.
* check.c (gfc_check_cmplx): Pass warning flag to
diagnostic function.
* decl.c (get_proc_name, gfc_verify_c_interop_param, build_sym
gfc_set_constant_character_len, verify_bind_c_sym): Ditto; use
_1 for old diagnostic, remove _2 for new diagnostic.
* expr.c (gfc_check_assign, gfc_check_vardef_context): Ditto.
* frontend-passes.c (doloop_code, do_function): Ditto.
* intrinsic.c (gfc_is_intrinsic, gfc_convert_type_warn): Ditto.
* match.c (gfc_match_common): Ditto.
* module.c (use_iso_fortran_env_module, gfc_use_module): Ditto.
* parse.c (decode_statement, decode_gcc_attribute, next_free,
next_fixed, gfc_check_do_variable): Ditto.
* resolve.c (resolve_common_vars, resolve_ordinary_assign):
Ditto.
* scanner.c (add_path_to_list, skip_free_comments,
gfc_next_char_literal, gfc_gobble_whitespace, load_line,
preprocessor_line, load_file): Ditto.
* symbol.c (gfc_set_default_type, verify_bind_c_derived_type):
Ditto.
* options.c (gfc_post_options): Ditto.
(gfc_init_options, set_Wall, gfc_handle_option): Ditto; remove
flags which now have a Var.
* invoke.texi (Wconversion-extra): Make clear that the flag
does not imply -Wconversion.
gcc/testsuite/
* gfortran.dg/empty_label.f: Change test to continue testing
for -fmax-errors=1.
* gfortran.dg/empty_label.f90: Ditto.
* gfortran.dg/warnings_are_errors_1.f90: Update dg-*.
@@ -1398,17 +1398,18 @@ gfc_check_cmplx (gfc_expr *x, gfc_expr *y, gfc_expr *kind)
if (!kind_check (kind, 2, BT_COMPLEX))
return false;
- if (!kind && gfc_option.gfc_warn_conversion
+ if (!kind && warn_conversion
&& x->ts.type == BT_REAL && x->ts.kind > gfc_default_real_kind)
- gfc_warning_now ("Conversion from %s to default-kind COMPLEX(%d) at %L "
- "might lose precision, consider using the KIND argument",
- gfc_typename (&x->ts), gfc_default_real_kind, &x->where);
- else if (y && !kind && gfc_option.gfc_warn_conversion
+ gfc_warning_now (OPT_Wconversion, "Conversion from %s to default-kind "
+ "COMPLEX(%d) at %L might lose precision, consider using "
+ "the KIND argument", gfc_typename (&x->ts),
+ gfc_default_real_kind, &x->where);
+ else if (y && !kind && warn_conversion
&& y->ts.type == BT_REAL && y->ts.kind > gfc_default_real_kind)
- gfc_warning_now ("Conversion from %s to default-kind COMPLEX(%d) at %L "
- "might lose precision, consider using the KIND argument",
- gfc_typename (&y->ts), gfc_default_real_kind, &y->where);
-
+ gfc_warning_now (OPT_Wconversion, "Conversion from %s to default-kind "
+ "COMPLEX(%d) at %L might lose precision, consider using "
+ "the KIND argument", gfc_typename (&y->ts),
+ gfc_default_real_kind, &y->where);
return true;
}
@@ -898,17 +898,17 @@ get_proc_name (const char *name, gfc_symbol **result, bool module_fcn_entry)
&& sym->attr.proc != 0
&& (sym->attr.subroutine || sym->attr.function)
&& sym->attr.if_source != IFSRC_UNKNOWN)
- gfc_error_now ("Procedure '%s' at %C is already defined at %L",
- name, &sym->declared_at);
+ gfc_error_now_1 ("Procedure '%s' at %C is already defined at %L",
+ name, &sym->declared_at);
/* Trap a procedure with a name the same as interface in the
encompassing scope. */
if (sym->attr.generic != 0
&& (sym->attr.subroutine || sym->attr.function)
&& !sym->attr.mod_proc)
- gfc_error_now ("Name '%s' at %C is already defined"
- " as a generic interface at %L",
- name, &sym->declared_at);
+ gfc_error_now_1 ("Name '%s' at %C is already defined"
+ " as a generic interface at %L",
+ name, &sym->declared_at);
/* Trap declarations of attributes in encompassing scope. The
signature for this is that ts.kind is set. Legitimate
@@ -919,9 +919,9 @@ get_proc_name (const char *name, gfc_symbol **result, bool module_fcn_entry)
&& gfc_current_ns->parent != NULL
&& sym->attr.access == 0
&& !module_fcn_entry)
- gfc_error_now ("Procedure '%s' at %C has an explicit interface "
- "and must not have attributes declared at %L",
- name, &sym->declared_at);
+ gfc_error_now_1 ("Procedure '%s' at %C has an explicit interface "
+ "and must not have attributes declared at %L",
+ name, &sym->declared_at);
}
if (gfc_current_ns->parent == NULL || *result == NULL)
@@ -990,9 +990,9 @@ gfc_verify_c_interop_param (gfc_symbol *sym)
{
if (sym->attr.is_bind_c == 0)
{
- gfc_error_now_2 ("Procedure %qs at %L must have the BIND(C) "
- "attribute to be C interoperable", sym->name,
- &(sym->declared_at));
+ gfc_error_now ("Procedure %qs at %L must have the BIND(C) "
+ "attribute to be C interoperable", sym->name,
+ &(sym->declared_at));
return false;
}
else
@@ -1029,7 +1029,7 @@ gfc_verify_c_interop_param (gfc_symbol *sym)
"because it is polymorphic",
sym->name, &(sym->declared_at),
sym->ns->proc_name->name);
- else if (gfc_option.warn_c_binding_type)
+ 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 "
"interoperable",
@@ -1182,9 +1182,9 @@ build_sym (const char *name, gfc_charlen *cl, bool cl_deferred,
if (sym->common_block != NULL && sym->common_block->is_bind_c == 1
&& sym->ts.is_c_interop != 1)
{
- gfc_error_now ("Variable '%s' in common block '%s' at %C "
+ gfc_error_now ("Variable %qs in common block %qs at %C "
"must be declared with a C interoperable "
- "kind since common block '%s' is BIND(C)",
+ "kind since common block %qs is BIND(C)",
sym->name, sym->common_block->name,
sym->common_block->name);
gfc_clear_error ();
@@ -1224,9 +1224,9 @@ gfc_set_constant_character_len (int len, gfc_expr *expr, int check_len)
gfc_wide_memset (&s[slen], ' ', len - slen);
if (warn_character_truncation && slen > len)
- gfc_warning_now_2 (OPT_Wcharacter_truncation,
- "CHARACTER expression at %L is being truncated "
- "(%d/%d)", &expr->where, slen, len);
+ gfc_warning_now (OPT_Wcharacter_truncation,
+ "CHARACTER expression at %L is being truncated "
+ "(%d/%d)", &expr->where, slen, len);
/* Apply the standard by 'hand' otherwise it gets cleared for
initializers. */
@@ -4029,7 +4029,7 @@ verify_bind_c_sym (gfc_symbol *tmp_sym, gfc_typespec *ts,
{
tmp_sym = tmp_sym->result;
/* Make sure it wasn't an implicitly typed result. */
- if (tmp_sym->attr.implicit_type && gfc_option.warn_c_binding_type)
+ if (tmp_sym->attr.implicit_type && warn_c_binding_type)
{
gfc_warning ("Implicitly declared BIND(C) function '%s' at "
"%L may not be C interoperable", tmp_sym->name,
@@ -4050,7 +4050,7 @@ verify_bind_c_sym (gfc_symbol *tmp_sym, gfc_typespec *ts,
if (!gfc_verify_c_interop (&(tmp_sym->ts)))
{
/* See if we're dealing with a sym in a common block or not. */
- if (is_in_common == 1 && gfc_option.warn_c_binding_type)
+ if (is_in_common == 1 && warn_c_binding_type)
{
gfc_warning ("Variable '%s' in common block '%s' at %L "
"may not be a C interoperable "
@@ -4064,7 +4064,7 @@ verify_bind_c_sym (gfc_symbol *tmp_sym, gfc_typespec *ts,
gfc_error ("Type declaration '%s' at %L is not C "
"interoperable but it is BIND(C)",
tmp_sym->name, &(tmp_sym->declared_at));
- else if (gfc_option.warn_c_binding_type)
+ else if (warn_c_binding_type)
gfc_warning ("Variable '%s' at %L "
"may not be a C interoperable "
"kind but it is bind(c)",
@@ -4130,8 +4130,8 @@ verify_bind_c_sym (gfc_symbol *tmp_sym, gfc_typespec *ts,
&& tmp_sym->binding_label)
/* Use gfc_warning_now because we won't say that the symbol fails
just because of this. */
- gfc_warning_now ("Symbol '%s' at %L is marked PRIVATE but has been "
- "given the binding label '%s'", tmp_sym->name,
+ gfc_warning_now ("Symbol %qs at %L is marked PRIVATE but has been "
+ "given the binding label %qs", tmp_sym->name,
&(tmp_sym->declared_at), tmp_sym->binding_label);
return retval;
@@ -933,10 +933,11 @@ gfc_notify_std (int std, const char *gmsgid, ...)
/* Immediate warning (i.e. do not buffer the warning). */
-/* Use gfc_warning_now_2 instead, unless gmsgid contains a %L. */
+/* Use gfc_warning_now instead, unless two locations are used in the same
+ warning or for scanner.c, if the location is not properly set up. */
void
-gfc_warning_now (const char *gmsgid, ...)
+gfc_warning_now_1 (const char *gmsgid, ...)
{
va_list argp;
int i;
@@ -1094,10 +1095,12 @@ gfc_diagnostic_finalizer (diagnostic_context *context,
}
/* Immediate warning (i.e. do not buffer the warning). */
-/* This function uses the common diagnostics, but does not support %L, yet. */
+/* This function uses the common diagnostics, but does not support
+ two locations; when being used in scanner.c, ensure that the location
+ is properly setup. Otherwise, use gfc_warning_now_1. */
bool
-gfc_warning_now_2 (int opt, const char *gmsgid, ...)
+gfc_warning_now (int opt, const char *gmsgid, ...)
{
va_list argp;
diagnostic_info diagnostic;
@@ -1113,10 +1116,12 @@ gfc_warning_now_2 (int opt, const char *gmsgid, ...)
}
/* Immediate warning (i.e. do not buffer the warning). */
-/* This function uses the common diagnostics, but does not support %L, yet. */
+/* This function uses the common diagnostics, but does not support
+ two locations; when being used in scanner.c, ensure that the location
+ is properly setup. Otherwise, use gfc_warning_now_1. */
bool
-gfc_warning_now_2 (const char *gmsgid, ...)
+gfc_warning_now (const char *gmsgid, ...)
{
va_list argp;
diagnostic_info diagnostic;
@@ -1132,10 +1137,12 @@ gfc_warning_now_2 (const char *gmsgid, ...)
/* Immediate error (i.e. do not buffer). */
-/* This function uses the common diagnostics, but does not support %L, yet. */
+/* 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_error_now_1. */
void
-gfc_error_now_2 (const char *gmsgid, ...)
+gfc_error_now (const char *gmsgid, ...)
{
va_list argp;
diagnostic_info diagnostic;
@@ -1241,10 +1248,11 @@ warning:
/* Immediate error. */
-/* Use gfc_error_now_2 instead, unless gmsgid contains a %L. */
+/* Use gfc_error_now instead, unless two locations are used in the same
+ warning or for scanner.c, if the location is not properly set up. */
void
-gfc_error_now (const char *gmsgid, ...)
+gfc_error_now_1 (const char *gmsgid, ...)
{
va_list argp;
int i;
@@ -1382,9 +1390,9 @@ void
gfc_get_errors (int *w, int *e)
{
if (w != NULL)
- *w = warnings;
+ *w = warnings + warningcount + werrorcount;
if (e != NULL)
- *e = errors;
+ *e = errors + errorcount + sorrycount + werrorcount;
}
@@ -21,6 +21,7 @@ along with GCC; see the file COPYING3. If not see
#include "config.h"
#include "system.h"
#include "coretypes.h"
+#include "flags.h"
#include "gfortran.h"
#include "arith.h"
#include "match.h"
@@ -3227,7 +3228,7 @@ gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform)
if (rvalue->expr_type == EXPR_CONSTANT && lvalue->ts.type == rvalue->ts.type
&& (lvalue->ts.type == BT_REAL || lvalue->ts.type == BT_COMPLEX))
{
- if (lvalue->ts.kind < rvalue->ts.kind && gfc_option.gfc_warn_conversion)
+ if (lvalue->ts.kind < rvalue->ts.kind && warn_conversion)
{
/* As a special bonus, don't warn about REAL rvalues which are not
changed by the conversion if -Wconversion is specified. */
@@ -3258,8 +3259,7 @@ gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform)
gfc_typename (&lvalue->ts), &rvalue->where);
}
- else if (gfc_option.warn_conversion_extra
- && lvalue->ts.kind > rvalue->ts.kind)
+ else if (warn_conversion_extra && lvalue->ts.kind > rvalue->ts.kind)
{
gfc_warning ("Conversion from %s to %s at %L",
gfc_typename (&rvalue->ts),
@@ -4971,11 +4971,12 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj,
if (gfc_dep_compare_expr (ec, en) == 0)
{
if (context)
- gfc_error_now ("Elements with the same value at %L"
- " and %L in vector subscript"
- " in a variable definition"
- " context (%s)", &(ec->where),
- &(en->where), context);
+ gfc_error_now_1 ("Elements with the same value "
+ "at %L and %L in vector "
+ "subscript in a variable "
+ "definition context (%s)",
+ &(ec->where), &(en->where),
+ context);
return false;
}
}
@@ -1708,17 +1708,19 @@ doloop_code (gfc_code **c, int *walk_subtrees ATTRIBUTE_UNUSED,
&& a->expr->symtree->n.sym == do_sym)
{
if (f->sym->attr.intent == INTENT_OUT)
- gfc_error_now("Variable '%s' at %L set to undefined value "
- "inside loop beginning at %L as INTENT(OUT) "
- "argument to subroutine '%s'", do_sym->name,
- &a->expr->where, &doloop_list[i]->loc,
- co->symtree->n.sym->name);
+ gfc_error_now_1 ("Variable '%s' at %L set to undefined "
+ "value inside loop beginning at %L as "
+ "INTENT(OUT) argument to subroutine '%s'",
+ do_sym->name, &a->expr->where,
+ &doloop_list[i]->loc,
+ co->symtree->n.sym->name);
else if (f->sym->attr.intent == INTENT_INOUT)
- gfc_error_now("Variable '%s' at %L not definable inside loop "
- "beginning at %L as INTENT(INOUT) argument to "
- "subroutine '%s'", do_sym->name,
- &a->expr->where, &doloop_list[i]->loc,
- co->symtree->n.sym->name);
+ gfc_error_now_1 ("Variable '%s' at %L not definable inside "
+ "loop beginning at %L as INTENT(INOUT) "
+ "argument to subroutine '%s'",
+ do_sym->name, &a->expr->where,
+ &doloop_list[i]->loc,
+ co->symtree->n.sym->name);
}
}
a = a->next;
@@ -1778,17 +1780,17 @@ do_function (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED,
&& a->expr->symtree->n.sym == do_sym)
{
if (f->sym->attr.intent == INTENT_OUT)
- gfc_error_now("Variable '%s' at %L set to undefined value "
- "inside loop beginning at %L as INTENT(OUT) "
- "argument to function '%s'", do_sym->name,
- &a->expr->where, &doloop_list[i]->loc,
- expr->symtree->n.sym->name);
+ gfc_error_now_1 ("Variable '%s' at %L set to undefined value "
+ "inside loop beginning at %L as INTENT(OUT) "
+ "argument to function '%s'", do_sym->name,
+ &a->expr->where, &doloop_list[i]->loc,
+ expr->symtree->n.sym->name);
else if (f->sym->attr.intent == INTENT_INOUT)
- gfc_error_now("Variable '%s' at %L not definable inside loop "
- "beginning at %L as INTENT(INOUT) argument to "
- "function '%s'", do_sym->name,
- &a->expr->where, &doloop_list[i]->loc,
- expr->symtree->n.sym->name);
+ gfc_error_now_1 ("Variable '%s' at %L not definable inside loop"
+ " beginning at %L as INTENT(INOUT) argument to"
+ " function '%s'", do_sym->name,
+ &a->expr->where, &doloop_list[i]->loc,
+ expr->symtree->n.sym->name);
}
}
a = a->next;
@@ -2444,9 +2444,6 @@ typedef struct
int warn_aliasing;
int warn_ampersand;
- int gfc_warn_conversion;
- int warn_c_binding_type;
- int warn_conversion_extra;
int warn_function_elimination;
int warn_implicit_interface;
int warn_implicit_procedure;
@@ -2454,7 +2451,6 @@ typedef struct
int warn_surprising;
int warn_underflow;
int warn_intrinsic_shadow;
- int warn_intrinsics_std;
int warn_array_temp;
int warn_align_commons;
int warn_real_q_constant;
@@ -2695,16 +2691,16 @@ 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_now (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
-bool gfc_warning_now_2 (const char *gmsgid, ...) ATTRIBUTE_GCC_GFC(1,2);
-bool gfc_warning_now_2 (int opt, const char *gmsgid, ...) ATTRIBUTE_GCC_GFC(2,3);
+void gfc_warning_now_1 (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
+bool gfc_warning_now (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
+bool gfc_warning_now (int opt, const char *, ...) ATTRIBUTE_GCC_GFC(2,3);
void gfc_clear_warning (void);
void gfc_warning_check (void);
void gfc_error (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
+void gfc_error_now_1 (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
void gfc_error_now (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
-void gfc_error_now_2 (const char *gmsgid, ...) ATTRIBUTE_GCC_GFC(1,2);
void gfc_fatal_error (const char *, ...) ATTRIBUTE_NORETURN ATTRIBUTE_GCC_GFC(1,2);
void gfc_internal_error (const char *, ...) ATTRIBUTE_NORETURN ATTRIBUTE_GCC_GFC(1,2);
void gfc_clear_error (void);
@@ -1050,11 +1050,10 @@ gfc_is_intrinsic (gfc_symbol* sym, int subroutine_flag, locus loc)
if (!gfc_check_intrinsic_standard (isym, &symstd, false, loc)
&& !sym->attr.artificial)
{
- if (sym->attr.proc == PROC_UNKNOWN
- && gfc_option.warn_intrinsics_std)
- gfc_warning_now ("The intrinsic '%s' at %L is not included in the"
- " selected standard but %s and '%s' will be"
- " treated as if declared EXTERNAL. Use an"
+ if (sym->attr.proc == PROC_UNKNOWN && warn_intrinsics_std)
+ gfc_warning_now (OPT_Wintrinsics_std, "The intrinsic %qs at %L is not "
+ "included in the selected standard but %s and %qs will"
+ " be treated as if declared EXTERNAL. Use an"
" appropriate -std=* option or define"
" -fall-intrinsics to allow this intrinsic.",
sym->name, &loc, symstd, sym->name);
@@ -4652,14 +4651,14 @@ gfc_convert_type_warn (gfc_expr *expr, gfc_typespec *ts, int eflag, int wflag)
/* Larger kinds can hold values of smaller kinds without problems.
Hence, only warn if target kind is smaller than the source
kind - or if -Wconversion-extra is specified. */
- if (gfc_option.warn_conversion_extra)
- gfc_warning_now ("Conversion from %s to %s at %L",
+ if (warn_conversion && from_ts.kind > ts->kind)
+ gfc_warning_now (OPT_Wconversion, "Possible change of value in "
+ "conversion from %s to %s at %L",
gfc_typename (&from_ts), gfc_typename (ts),
&expr->where);
- else if (gfc_option.gfc_warn_conversion
- && from_ts.kind > ts->kind)
- gfc_warning_now ("Possible change of value in conversion "
- "from %s to %s at %L", gfc_typename (&from_ts),
+ else if (warn_conversion_extra)
+ gfc_warning_now (OPT_Wconversion_extra, "Conversion from %s to %s "
+ "at %L", gfc_typename (&from_ts),
gfc_typename (ts), &expr->where);
}
else if ((from_ts.type == BT_REAL && ts->type == BT_INTEGER)
@@ -4668,18 +4667,17 @@ gfc_convert_type_warn (gfc_expr *expr, gfc_typespec *ts, int eflag, int wflag)
{
/* Conversion from REAL/COMPLEX to INTEGER or COMPLEX to REAL
usually comes with a loss of information, regardless of kinds. */
- if (gfc_option.warn_conversion_extra
- || gfc_option.gfc_warn_conversion)
- gfc_warning_now ("Possible change of value in conversion "
- "from %s to %s at %L", gfc_typename (&from_ts),
- gfc_typename (ts), &expr->where);
+ if (warn_conversion)
+ gfc_warning_now (OPT_Wconversion, "Possible change of value in "
+ "conversion from %s to %s at %L",
+ gfc_typename (&from_ts), gfc_typename (ts),
+ &expr->where);
}
else if (from_ts.type == BT_HOLLERITH || ts->type == BT_HOLLERITH)
{
/* If HOLLERITH is involved, all bets are off. */
- if (gfc_option.warn_conversion_extra
- || gfc_option.gfc_warn_conversion)
- gfc_warning_now ("Conversion from %s to %s at %L",
+ if (warn_conversion)
+ gfc_warning_now (OPT_Wconversion, "Conversion from %s to %s at %L",
gfc_typename (&from_ts), gfc_typename (ts),
&expr->where);
}
@@ -803,7 +803,8 @@ the expression after conversion. Implied by @option{-Wall}.
@opindex @code{Wconversion-extra}
@cindex warnings, conversion
@cindex conversion
-Warn about implicit conversions between different types and kinds.
+Warn about implicit conversions between different types and kinds. This
+option does @emph{not} imply @option{-Wconversion}.
@item -Wextra
@opindex @code{Wextra}
@@ -210,7 +210,7 @@ Fortran Warning
Warn about creation of array temporaries
Wc-binding-type
-Fortran Warning
+Fortran Var(warn_c_binding_type) Warning LangEnabledBy(Fortran,Wall)
Warn if the type of a variable might be not interoperable with C
Wdate-time
@@ -226,11 +226,11 @@ Fortran Warning
Warn about equality comparisons involving REAL or COMPLEX expressions
Wconversion
-Fortran Warning
+Fortran Var(warn_conversion) Warning LangEnabledBy(Fortran,Wall)
; Documented in C
Wconversion-extra
-Fortran Warning
+Fortran Var(warn_conversion_extra) Warning
Warn about most implicit conversions
Wextra
@@ -254,7 +254,7 @@ Fortran Warning
Warn about truncated source lines
Wintrinsics-std
-Fortran Warning
+Fortran Var(warn_intrinsics_std) Warning LangEnabledBy(Fortran,Wall)
Warn on intrinsics not part of the selected standard
Wmissing-include-dirs
@@ -4299,18 +4299,18 @@ gfc_match_common (void)
/* If we find an error, just print it and continue,
cause it's just semantic, and we can see if there
are more errors. */
- gfc_error_now ("Variable '%s' at %L in common block '%s' "
- "at %C must be declared with a C "
- "interoperable kind since common block "
- "'%s' is bind(c)",
- sym->name, &(sym->declared_at), t->name,
- t->name);
+ gfc_error_now_1 ("Variable '%s' at %L in common block '%s' "
+ "at %C must be declared with a C "
+ "interoperable kind since common block "
+ "'%s' is bind(c)",
+ sym->name, &(sym->declared_at), t->name,
+ t->name);
}
if (sym->attr.is_bind_c == 1)
- gfc_error_now ("Variable '%s' in common block "
- "'%s' at %C can not be bind(c) since "
- "it is not global", sym->name, t->name);
+ gfc_error_now ("Variable %qs in common block %qs at %C can not "
+ "be bind(c) since it is not global", sym->name,
+ t->name);
}
if (sym->attr.in_common)
@@ -6602,7 +6602,7 @@ use_iso_fortran_env_module (void)
gfc_warning_now ("Use of the NUMERIC_STORAGE_SIZE named "
"constant from intrinsic module "
"ISO_FORTRAN_ENV at %L is incompatible with "
- "option %s", &u->where,
+ "option %qs", &u->where,
gfc_option.flag_default_integer
? "-fdefault-integer-8"
: "-fdefault-real-8");
@@ -6745,8 +6745,8 @@ gfc_use_module (gfc_use_list *module)
current_intmod = INTMOD_NONE;
if (!only_flag)
- gfc_warning_now_2 (OPT_Wuse_without_only,
- "USE statement at %C has no ONLY qualifier");
+ gfc_warning_now (OPT_Wuse_without_only,
+ "USE statement at %C has no ONLY qualifier");
filename = XALLOCAVEC (char, strlen (module_name) + strlen (MODULE_EXTENSION)
+ 1);
@@ -96,16 +96,12 @@ gfc_init_options (unsigned int decoded_options_count,
gfc_option.warn_aliasing = 0;
gfc_option.warn_ampersand = 0;
gfc_option.warn_array_temp = 0;
- gfc_option.warn_c_binding_type = 0;
- gfc_option.gfc_warn_conversion = 0;
- gfc_option.warn_conversion_extra = 0;
gfc_option.warn_function_elimination = 0;
gfc_option.warn_implicit_interface = 0;
gfc_option.warn_line_truncation = 0;
gfc_option.warn_surprising = 0;
gfc_option.warn_underflow = 1;
gfc_option.warn_intrinsic_shadow = 0;
- gfc_option.warn_intrinsics_std = 0;
gfc_option.warn_align_commons = 1;
gfc_option.warn_real_q_constant = 0;
gfc_option.warn_unused_dummy_argument = 0;
@@ -359,8 +355,8 @@ gfc_post_options (const char **pfilename)
if (gfc_current_form == FORM_UNKNOWN)
{
gfc_current_form = FORM_FREE;
- gfc_warning_now_2 ("Reading file %qs as free form",
- (filename[0] == '\0') ? "<stdin>" : filename);
+ gfc_warning_now ("Reading file %qs as free form",
+ (filename[0] == '\0') ? "<stdin>" : filename);
}
}
@@ -369,10 +365,10 @@ gfc_post_options (const char **pfilename)
if (gfc_current_form == FORM_FREE)
{
if (gfc_option.flag_d_lines == 0)
- gfc_warning_now_2 ("%<-fd-lines-as-comments%> has no effect "
+ gfc_warning_now ("%<-fd-lines-as-comments%> has no effect "
"in free form");
else if (gfc_option.flag_d_lines == 1)
- gfc_warning_now_2 ("%<-fd-lines-as-code%> has no effect in free form");
+ gfc_warning_now ("%<-fd-lines-as-code%> has no effect in free form");
}
/* If -pedantic, warn about the use of GNU extensions. */
@@ -390,20 +386,20 @@ gfc_post_options (const char **pfilename)
if (!gfc_option.flag_automatic && gfc_option.flag_max_stack_var_size != -2
&& gfc_option.flag_max_stack_var_size != 0)
- gfc_warning_now_2 ("Flag %<-fno-automatic%> overwrites %<-fmax-stack-var-size=%d%>",
+ gfc_warning_now ("Flag %<-fno-automatic%> overwrites %<-fmax-stack-var-size=%d%>",
gfc_option.flag_max_stack_var_size);
else if (!gfc_option.flag_automatic && gfc_option.flag_recursive)
- gfc_warning_now_2 ("Flag %<-fno-automatic%> overwrites %<-frecursive%>");
+ gfc_warning_now ("Flag %<-fno-automatic%> overwrites %<-frecursive%>");
else if (!gfc_option.flag_automatic && gfc_option.gfc_flag_openmp)
- gfc_warning_now_2 ("Flag %<-fno-automatic%> overwrites %<-frecursive%> implied by "
+ gfc_warning_now ("Flag %<-fno-automatic%> overwrites %<-frecursive%> implied by "
"%<-fopenmp%>");
else if (gfc_option.flag_max_stack_var_size != -2
&& gfc_option.flag_recursive)
- gfc_warning_now_2 ("Flag %<-frecursive%> overwrites %<-fmax-stack-var-size=%d%>",
+ gfc_warning_now ("Flag %<-frecursive%> overwrites %<-fmax-stack-var-size=%d%>",
gfc_option.flag_max_stack_var_size);
else if (gfc_option.flag_max_stack_var_size != -2
&& gfc_option.gfc_flag_openmp)
- gfc_warning_now_2 ("Flag %<-fmax-stack-var-size=%d%> overwrites %<-frecursive%> "
+ gfc_warning_now ("Flag %<-fmax-stack-var-size=%d%> overwrites %<-frecursive%> "
"implied by %<-fopenmp%>",
gfc_option.flag_max_stack_var_size);
@@ -452,13 +448,10 @@ set_Wall (int setting)
{
gfc_option.warn_aliasing = setting;
gfc_option.warn_ampersand = setting;
- gfc_option.warn_c_binding_type = setting;
- gfc_option.gfc_warn_conversion = setting;
gfc_option.warn_line_truncation = setting;
gfc_option.warn_surprising = setting;
gfc_option.warn_underflow = setting;
gfc_option.warn_intrinsic_shadow = setting;
- gfc_option.warn_intrinsics_std = setting;
gfc_option.warn_real_q_constant = setting;
gfc_option.warn_unused_dummy_argument = setting;
gfc_option.warn_target_lifetime = setting;
@@ -657,22 +650,10 @@ gfc_handle_option (size_t scode, const char *arg, int value,
gfc_option.warn_array_temp = value;
break;
- case OPT_Wc_binding_type:
- gfc_option.warn_c_binding_type = value;
- break;
-
case OPT_Wcompare_reals:
gfc_option.warn_compare_reals = value;
break;
- case OPT_Wconversion:
- gfc_option.gfc_warn_conversion = value;
- break;
-
- case OPT_Wconversion_extra:
- gfc_option.warn_conversion_extra = value;
- break;
-
case OPT_Wextra:
set_Wextra (value);
break;
@@ -1063,10 +1044,6 @@ gfc_handle_option (size_t scode, const char *arg, int value,
gfc_option.warn_std = 0;
break;
- case OPT_Wintrinsics_std:
- gfc_option.warn_intrinsics_std = value;
- break;
-
case OPT_fshort_enums:
/* Handled in language-independent code. */
break;
@@ -550,7 +550,7 @@ decode_statement (void)
stored an error message of some sort. */
if (gfc_error_check () == 0)
- gfc_error_now_2 ("Unclassifiable statement at %C");
+ gfc_error_now ("Unclassifiable statement at %C");
reject_statement ();
@@ -797,7 +797,7 @@ decode_gcc_attribute (void)
stored an error message of some sort. */
if (gfc_error_check () == 0)
- gfc_error_now_2 ("Unclassifiable GCC directive at %C");
+ gfc_error_now ("Unclassifiable GCC directive at %C");
reject_statement ();
@@ -836,17 +836,17 @@ next_free (void)
gfc_match_small_literal_int (&i, &cnt);
if (cnt > 5)
- gfc_error_now_2 ("Too many digits in statement label at %C");
+ gfc_error_now ("Too many digits in statement label at %C");
if (i == 0)
- gfc_error_now_2 ("Zero is not a valid statement label at %C");
+ gfc_error_now ("Zero is not a valid statement label at %C");
do
c = gfc_next_ascii_char ();
while (ISDIGIT(c));
if (!gfc_is_whitespace (c))
- gfc_error_now_2 ("Non-numeric character in statement label at %C");
+ gfc_error_now ("Non-numeric character in statement label at %C");
return ST_NONE;
}
@@ -858,7 +858,7 @@ next_free (void)
if (at_bol && gfc_peek_ascii_char () == ';')
{
- gfc_error_now_2 ("Semicolon at %C needs to be preceded by "
+ gfc_error_now ("Semicolon at %C needs to be preceded by "
"statement");
gfc_next_ascii_char (); /* Eat up the semicolon. */
return ST_NONE;
@@ -917,8 +917,8 @@ next_free (void)
if (at_bol && c == ';')
{
if (!(gfc_option.allow_std & GFC_STD_F2008))
- gfc_error_now_2 ("Fortran 2008: Semicolon at %C without preceding "
- "statement");
+ gfc_error_now ("Fortran 2008: Semicolon at %C without preceding "
+ "statement");
gfc_next_ascii_char (); /* Eat up the semicolon. */
return ST_NONE;
}
@@ -1017,7 +1017,7 @@ next_fixed (void)
if (digit_flag)
{
if (label == 0)
- gfc_warning_now_2 ("Zero is not a valid statement label at %C");
+ gfc_warning_now ("Zero is not a valid statement label at %C");
else
{
/* We've found a valid statement label. */
@@ -3505,8 +3505,8 @@ gfc_check_do_variable (gfc_symtree *st)
for (s=gfc_state_stack; s; s = s->previous)
if (s->do_variable == st)
{
- gfc_error_now("Variable '%s' at %C cannot be redefined inside "
- "loop beginning at %L", st->name, &s->head->loc);
+ gfc_error_now_1 ("Variable '%s' at %C cannot be redefined inside "
+ "loop beginning at %L", st->name, &s->head->loc);
return 1;
}
@@ -924,7 +924,7 @@ resolve_common_vars (gfc_symbol *sym, bool named_common)
}
if (UNLIMITED_POLY (csym))
- gfc_error_now ("'%s' in cannot appear in COMMON at %L "
+ gfc_error_now ("%qs in cannot appear in COMMON at %L "
"[F2008:C5100]", csym->name, &csym->declared_at);
if (csym->ts.type != BT_DERIVED)
@@ -932,15 +932,15 @@ resolve_common_vars (gfc_symbol *sym, bool named_common)
if (!(csym->ts.u.derived->attr.sequence
|| csym->ts.u.derived->attr.is_bind_c))
- gfc_error_now ("Derived type variable '%s' in COMMON at %L "
+ gfc_error_now ("Derived type variable %qs in COMMON at %L "
"has neither the SEQUENCE nor the BIND(C) "
"attribute", csym->name, &csym->declared_at);
if (csym->ts.u.derived->attr.alloc_comp)
- gfc_error_now ("Derived type variable '%s' in COMMON at %L "
+ gfc_error_now ("Derived type variable %qs in COMMON at %L "
"has an ultimate component that is "
"allocatable", csym->name, &csym->declared_at);
if (gfc_has_default_initializer (csym->ts.u.derived))
- gfc_error_now ("Derived type variable '%s' in COMMON at %L "
+ gfc_error_now ("Derived type variable %qs in COMMON at %L "
"may not have default initializer", csym->name,
&csym->declared_at);
@@ -9224,10 +9224,10 @@ resolve_ordinary_assign (gfc_code *code, gfc_namespace *ns)
rlen = mpz_get_si (rhs->ts.u.cl->length->value.integer);
if (rlen && llen && rlen > llen)
- gfc_warning_now_2 (OPT_Wcharacter_truncation,
- "CHARACTER expression will be truncated "
- "in assignment (%d/%d) at %L",
- llen, rlen, &code->loc);
+ gfc_warning_now (OPT_Wcharacter_truncation,
+ "CHARACTER expression will be truncated "
+ "in assignment (%d/%d) at %L",
+ llen, rlen, &code->loc);
}
/* Ensure that a vector index expression for the lvalue is evaluated
@@ -324,16 +324,16 @@ add_path_to_list (gfc_directorylist **list, const char *path,
if (stat (q, &st))
{
if (errno != ENOENT)
- gfc_warning_now_2 ("Include directory %qs: %s", path,
- xstrerror(errno));
+ gfc_warning_now ("Include directory %qs: %s", path,
+ xstrerror(errno));
else if (warn)
- gfc_warning_now_2 (OPT_Wmissing_include_dirs,
- "Nonexistent include directory %qs", path);
+ gfc_warning_now (OPT_Wmissing_include_dirs,
+ "Nonexistent include directory %qs", path);
return;
}
else if (!S_ISDIR (st.st_mode))
{
- gfc_warning_now_2 ("%qs is not a directory", path);
+ gfc_warning_now ("%qs is not a directory", path);
return;
}
@@ -775,10 +775,10 @@ skip_free_comments (void)
}
}
else
- gfc_warning_now ("!$OMP at %C starts a commented "
- "line as it neither is followed "
- "by a space nor is a "
- "continuation line");
+ gfc_warning_now_1 ("!$OMP at %C starts a commented "
+ "line as it neither is followed "
+ "by a space nor is a "
+ "continuation line");
}
gfc_current_locus = old_loc;
next_char ();
@@ -1056,7 +1056,7 @@ restart:
gfc_current_locus.lb->truncated = 0;
gfc_current_locus.nextc = gfc_current_locus.lb->line + maxlen;
- gfc_warning_now ("Line truncated at %L", &gfc_current_locus);
+ gfc_warning_now_1 ("Line truncated at %L", &gfc_current_locus);
gfc_current_locus.nextc = current_nextc;
}
@@ -1194,7 +1194,7 @@ restart:
&& gfc_current_locus.lb->truncated)
{
gfc_current_locus.lb->truncated = 0;
- gfc_warning_now ("Line truncated at %L", &gfc_current_locus);
+ gfc_warning_now_1 ("Line truncated at %L", &gfc_current_locus);
}
prev_openmp_flag = openmp_flag;
@@ -1388,7 +1388,7 @@ gfc_gobble_whitespace (void)
if (cur_linenum != linenum)
{
linenum = cur_linenum;
- gfc_warning_now ("Nonconforming tab character at %C");
+ gfc_warning_now_1 ("Nonconforming tab character at %C");
}
}
}
@@ -1476,11 +1476,11 @@ load_line (FILE *input, gfc_char_t **pbuf, int *pbuflen, const int *first_char)
&& !seen_printable && seen_ampersand)
{
if (pedantic)
- gfc_error_now_2 ("%<&%> not allowed by itself in line %d",
- current_line);
+ gfc_error_now ("%<&%> not allowed by itself in line %d",
+ current_line);
else
- gfc_warning_now_2 ("%<&%> not allowed by itself in line %d",
- current_line);
+ gfc_warning_now ("%<&%> not allowed by itself in line %d",
+ current_line);
}
break;
}
@@ -1537,9 +1537,9 @@ load_line (FILE *input, gfc_char_t **pbuf, int *pbuflen, const int *first_char)
if (warn_tabs && seen_comment == 0 && current_line != linenum)
{
linenum = current_line;
- gfc_warning_now_2 (OPT_Wtabs,
- "Nonconforming tab character in column %d "
- "of line %d", i+1, linenum);
+ gfc_warning_now (OPT_Wtabs,
+ "Nonconforming tab character in column %d "
+ "of line %d", i+1, linenum);
}
while (i < 6)
@@ -1763,9 +1763,9 @@ preprocessor_line (gfc_char_t *c)
if (!current_file->up
|| filename_cmp (current_file->up->filename, filename) != 0)
{
- gfc_warning_now ("%s:%d: file %s left but not entered",
- current_file->filename, current_file->line,
- filename);
+ gfc_warning_now_1 ("%s:%d: file %s left but not entered",
+ current_file->filename, current_file->line,
+ filename);
if (unescape)
free (wide_filename);
free (filename);
@@ -1797,7 +1797,7 @@ preprocessor_line (gfc_char_t *c)
return;
bad_cpp_line:
- gfc_warning_now ("%s:%d: Illegal preprocessor directive",
+ gfc_warning_now_1 ("%s:%d: Illegal preprocessor directive",
current_file->filename, current_file->line);
current_file->line++;
}
@@ -1922,7 +1922,7 @@ load_file (const char *realfilename, const char *displayedname, bool initial)
input = gfc_open_file (realfilename);
if (input == NULL)
{
- gfc_error_now_2 ("Can't open file %qs", filename);
+ gfc_error_now ("Can't open file %qs", filename);
return false;
}
}
@@ -270,11 +270,12 @@ gfc_set_default_type (gfc_symbol *sym, int error_flag, gfc_namespace *ns)
&& !gfc_build_class_symbol (&sym->ts, &sym->attr, &sym->as))
return false;
- if (sym->attr.is_bind_c == 1 && gfc_option.warn_c_binding_type)
+ if (sym->attr.is_bind_c == 1 && warn_c_binding_type)
{
/* BIND(C) variables should not be implicitly declared. */
- gfc_warning_now ("Implicitly declared BIND(C) variable '%s' at %L may "
- "not be C interoperable", sym->name, &sym->declared_at);
+ gfc_warning_now (OPT_Wc_binding_type, "Implicitly declared BIND(C) "
+ "variable %qs at %L may not be C interoperable",
+ sym->name, &sym->declared_at);
sym->ts.f90_type = sym->ts.type;
}
@@ -284,14 +285,15 @@ gfc_set_default_type (gfc_symbol *sym, int error_flag, gfc_namespace *ns)
&& (sym->ns->proc_name->attr.subroutine != 0
|| sym->ns->proc_name->attr.function != 0)
&& sym->ns->proc_name->attr.is_bind_c != 0
- && gfc_option.warn_c_binding_type)
+ && warn_c_binding_type)
{
/* Dummy args to a BIND(C) routine may not be interoperable if
they are implicitly typed. */
- gfc_warning_now ("Implicitly declared variable '%s' at %L may not "
- "be C interoperable but it is a dummy argument to "
- "the BIND(C) procedure '%s' at %L", sym->name,
- &(sym->declared_at), sym->ns->proc_name->name,
+ gfc_warning_now (OPT_Wc_binding_type, "Implicitly declared variable "
+ "%qs at %L may not be C interoperable but it is a "
+ "dummy argument to the BIND(C) procedure %qs at %L",
+ sym->name, &(sym->declared_at),
+ sym->ns->proc_name->name,
&(sym->ns->proc_name->declared_at));
sym->ts.f90_type = sym->ts.type;
}
@@ -3854,7 +3856,7 @@ verify_bind_c_derived_type (gfc_symbol *derived_sym)
if (derived_sym->attr.is_bind_c != 1)
{
derived_sym->ts.is_c_interop = 0;
- gfc_error_now ("Derived type '%s' declared at %L must have the BIND "
+ gfc_error_now ("Derived type %qs declared at %L must have the BIND "
"attribute to be C interoperable", derived_sym->name,
&(derived_sym->declared_at));
retval = false;
@@ -3949,8 +3951,7 @@ verify_bind_c_derived_type (gfc_symbol *derived_sym)
recompiles with different flags (e.g., -m32 and -m64 on
x86_64 and using integer(4) to claim interop with a
C_LONG). */
- if (derived_sym->attr.is_bind_c == 1
- && gfc_option.warn_c_binding_type)
+ 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 "
@@ -3958,7 +3959,7 @@ verify_bind_c_derived_type (gfc_symbol *derived_sym)
"derived type '%s' is BIND(C)",
curr_comp->name, derived_sym->name,
&(curr_comp->loc), derived_sym->name);
- else if (gfc_option.warn_c_binding_type)
+ 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. */
@@ -1,6 +1,7 @@
C { dg-do compile }
C { dg-options "-Werror -fmax-errors=1" }
-100 ! { dg-warning "empty statement" }
+100 ! { dg-error "empty statement" }
end
-C { dg-error "count reached limit" "" { target *-*-* } 0 }
-C { dg-excess-errors "compilation terminated" }
+subroutine foo ! Not checked ...
+end function ! ... but an error
+C { dg-excess-errors "warnings being treated as errors" }
@@ -1,6 +1,7 @@
! { dg-do compile }
! { dg-options "-Werror -fmax-errors=1" }
-100 ! { dg-warning "empty statement" }
+100 ! { dg-error "empty statement" }
end
-! { dg-error "count reached limit" "" { target *-*-* } 0 }
-! { dg-excess-errors "compilation terminated" }
+subroutine foo ! Not checked ...
+end function ! ... but an error
+! { dg-excess-errors "warnings being treated as errors" }
@@ -21,6 +21,7 @@
cplx = 20.
! gfc_warning_now:
- 1 ! { dg-warning "Ignoring statement label in empty statement" }
+ 1 ! { dg-error "Ignoring statement label in empty statement" }
end
! { dg-final { output-exists-not } }
+! { dg-excess-errors "warnings being treated as errors" }