diff mbox

Always pass 0 or option number to gfc_warning*

Message ID alpine.DEB.2.10.1501302216290.29331@digraph.polyomino.org.uk
State New
Headers show

Commit Message

Joseph Myers Jan. 30, 2015, 10:17 p.m. UTC
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.  OK to
commit?

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.

Comments

Tobias Burnus Jan. 31, 2015, 7:28 a.m. UTC | #1
Joseph Myers wrote:
> 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.  OK to
> commit?

OK. Thanks for the patch.

Tobias

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

Patch

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