procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Always pass 0 or option number to gfc_warning*.

Browse source 
Similar to the issue with fatal_error that I fixed in
<https://gcc.gnu.org/ml/gcc-patches/2015-01/msg02690.html>, the
overloads of gfc_warning and gfc_warning_now (with and without a first
argument for an option number) also break gcc.pot regeneration because
xgettext expects the translated string argument to be in a fixed
position for a given function name.  This patch applies the
corresponding fix of always passing a first argument (option number or
0), just like the core diagnostic functions warning and warning_at,
and removing the problem overloads without it.

Bootstrapped with no regressions on x86_64-unknown-linux-gnu.

	* 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.

From-SVN: r220313
This commit is contained in:
Joseph Myers 2015-02-01 00:29:54 +00:00 • committed by Joseph Myers
parent 35fa7aa737
commit db30e21cbf
23 changed files with 109 additions and 119 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

13
gcc/fortran/ChangeLog
View file

@ -1,3 +1,16 @@
2015-02-01 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.
2015-01-30 Joseph Myers <joseph@codesourcery.com>
* f95-lang.c, gfortranspec.c, trans-const.c, trans-expr.c: All

7
gcc/fortran/arith.c
View file

@ -551,7 +551,7 @@ check_result (arith rc, gfc_expr *x, gfc_expr *r, gfc_expr **rp)
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_expr *src)
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));
}

2
gcc/fortran/check.c
View file

@ -5089,7 +5089,7 @@ 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: "
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);

2
gcc/fortran/data.c
View file

@ -164,7 +164,7 @@ create_character_initializer (gfc_expr *init, gfc_typespec *ts,
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;

8
gcc/fortran/decl.c
View file

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

31
gcc/fortran/error.c
View file

@ -904,17 +904,6 @@ 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,26 +1246,6 @@ 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

4
gcc/fortran/frontend-passes.c
View file

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

2
gcc/fortran/gfortran.h
View file

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

22
gcc/fortran/interface.c
View file

@ -1178,7 +1178,7 @@ check_dummy_characteristics (gfc_symbol *s1, gfc_symbol *s2,
case -2:
/* FIXME: Implement a warning for this case.
gfc_warning ("Possible character length mismatch in argument %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_symbol *s2,
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_symbol *s2,
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 *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 %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,14 +2705,16 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
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),
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, gfc_formal_arglist *formal,
&& 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_actual_arglist *a)
|| (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,

4
gcc/fortran/intrinsic.c
View file

@ -4316,7 +4316,7 @@ gfc_check_intrinsic_standard (const gfc_intrinsic_sym* isym,
{
/* Do only print a warning if not a GNU extension. */
if (!silent && isym->standard != GFC_STD_GNU)
gfc_warning ("Intrinsic %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_typespec *ts, int eflag, int wflag)
/* 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);
}

26
gcc/fortran/io.c
View file

@ -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, const char *allowed[],
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, const char *allowed[],
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, const char *allowed[],
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__); \

4
gcc/fortran/matchexp.c
View file

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

5
gcc/fortran/module.c
View file

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

2
gcc/fortran/openmp.c
View file

@ -2638,7 +2638,7 @@ resolve_oacc_positive_int_expr (gfc_expr *expr, const char *clause)
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);
}

16
gcc/fortran/options.c
View file

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

10
gcc/fortran/parse.c
View file

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

2
gcc/fortran/primary.c
View file

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

39
gcc/fortran/resolve.c
View file

@ -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 *c)
&& (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_array_spec *as)
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_array_spec *as)
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_array_spec *as)
{
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_array_spec *as)
}
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_array_spec *as)
{
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_array_spec *as)
}
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 char *fcn)
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 *code)
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 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 %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, gfc_namespace *ns)
(*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;

14
gcc/fortran/scanner.c
View file

@ -327,7 +327,7 @@ add_path_to_list (gfc_directorylist **list, const char *path,
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 char *path,
}
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, bool continue_flag)
}
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, bool continue_flag)
}
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 *pbuflen, const int *first_char)
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;

2
gcc/fortran/symbol.c
View file

@ -3874,7 +3874,7 @@ verify_bind_c_derived_type (gfc_symbol *derived_sym)
*/
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;

8
gcc/fortran/trans-common.c
View file

@ -407,7 +407,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 %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_symbol *var_list)
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);

2
gcc/fortran/trans-const.c
View file

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

3
gcc/fortran/trans-stmt.c
View file

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