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