From: Manuel López-Ibáñez <manu@gcc.gnu.org>
Date: Wed, 3 Dec 2014 17:50:06 +0000 (+0000)
Subject: re PR fortran/44054 (Handle -Werror, -Werror=, -fdiagnostics-show-option, !GCC$ diagn... 
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=48749dbcc461753861059d1fc48c40d2e0aefaa2;p=gcc.git

re PR fortran/44054 (Handle -Werror, -Werror=, -fdiagnostics-show-option, !GCC$ diagnostic (pragmas) and color)

gcc/testsuite/ChangeLog:

2014-12-03  Manuel López-Ibáñez  <manu@gcc.gnu.org>

	PR fortran/44054
	* gfortran.dg/warnings_are_errors_1.f90: Update warnings to errors.
	* gfortran.dg/warnings_are_errors_1.f: Likewise.

gcc/fortran/ChangeLog:

2014-12-03  Manuel López-Ibáñez  <manu@gcc.gnu.org>

	PR fortran/44054
	* gfortran.h (gfc_warning): Now returns bool. Add overload that
	accepts opt.
	(gfc_warning_1): Declare.
	* error.c
	(pp_warning_buffer,warningcount_buffered,werrorcount_buffered):	New.
	(gfc_buffer_error): Set pp_warning_buffer.flush_p.
	(gfc_clear_pp_buffer): New.
	(gfc_warning_1): Renamed from gfc_warning.
	(gfc_warning): Add three new overloads. One that takes just a
	format string and ellipsis, another that takes also a warning
	option, and another that takes also va_list instead of ellipsis.
	(gfc_clear_warning): Clear pp_warning_buffer.
	(gfc_warning_check): Flush pp_warning_buffer and update warning
	and werror counters.
	(gfc_diagnostics_init): Init pp_warning_buffer.

	* Update all gfc_warning calls that do not multiple
	locations to use %qs and OPT_W*, otherwise use gfc_warning_1.

gcc/ChangeLog:

2014-12-03  Manuel López-Ibáñez  <manu@gcc.gnu.org>

	PR fortran/44054
	* pretty-print.c (output_buffer::output_buffer): Init flush_p to true.
	(pp_flush): Flush only if flush_p.
	(pp_really_flush): New.
	* pretty-print.h (struct output_buffer): Add flush_p.
	(pp_really_flush): Declare.

From-SVN: r218326
---

diff --git a/gcc/ChangeLog b/gcc/ChangeLog
index 5110db93684..42a55e15a3c 100644
--- a/gcc/ChangeLog
+++ b/gcc/ChangeLog
@@ -1,3 +1,12 @@
+2014-12-03  Manuel López-Ibáñez  <manu@gcc.gnu.org>
+
+	PR fortran/44054
+	* pretty-print.c (output_buffer::output_buffer): Init flush_p to true.
+	(pp_flush): Flush only if flush_p.
+	(pp_really_flush): New.
+	* pretty-print.h (struct output_buffer): Add flush_p.
+	(pp_really_flush): Declare.
+
 2014-12-03  Jakub Jelinek  <jakub@redhat.com>
 
 	* Makefile.in (ALL_HOST_BACKEND_OBJS): Add $(GENGTYPE_OBJS),
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 23ddc2593c8..c645b6fd401 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,25 @@
+2014-12-03  Manuel López-Ibáñez  <manu@gcc.gnu.org>
+
+	PR fortran/44054
+	* gfortran.h (gfc_warning): Now returns bool. Add overload that
+	accepts opt.
+	(gfc_warning_1): Declare.
+	* error.c
+	(pp_warning_buffer,warningcount_buffered,werrorcount_buffered):	New.
+	(gfc_buffer_error): Set pp_warning_buffer.flush_p.
+	(gfc_clear_pp_buffer): New.
+	(gfc_warning_1): Renamed from gfc_warning.
+	(gfc_warning): Add three new overloads. One that takes just a
+	format string and ellipsis, another that takes also a warning
+	option, and another that takes also va_list instead of ellipsis.
+	(gfc_clear_warning): Clear pp_warning_buffer.
+	(gfc_warning_check): Flush pp_warning_buffer and update warning
+	and werror counters.
+	(gfc_diagnostics_init): Init pp_warning_buffer.
+
+	* Update all gfc_warning calls that do not use multiple
+	locations to use %qs and OPT_W*, otherwise use gfc_warning_1.
+
 2014-12-02  Tobias Burnus  <burnus@net-b.de>
 	    Manuel López-Ibáñez  <manu@gcc.gnu.org>
 
diff --git a/gcc/fortran/arith.c b/gcc/fortran/arith.c
index efbe6de2d70..c692e623349 100644
--- a/gcc/fortran/arith.c
+++ b/gcc/fortran/arith.c
@@ -545,7 +545,7 @@ check_result (arith rc, gfc_expr *x, gfc_expr *r, gfc_expr **rp)
   if (val == ARITH_UNDERFLOW)
     {
       if (warn_underflow)
-	gfc_warning (gfc_arith_error (val), &x->where);
+	gfc_warning (OPT_Wunderflow, gfc_arith_error (val), &x->where);
       val = ARITH_OK;
     }
 
@@ -2078,7 +2078,7 @@ gfc_real2real (gfc_expr *src, int kind)
   if (rc == ARITH_UNDERFLOW)
     {
       if (warn_underflow)
-	gfc_warning (gfc_arith_error (rc), &src->where);
+	gfc_warning (OPT_Woverflow, gfc_arith_error (rc), &src->where);
       mpfr_set_ui (result->value.real, 0, GFC_RND_MODE);
     }
   else if (rc != ARITH_OK)
@@ -2109,7 +2109,7 @@ gfc_real2complex (gfc_expr *src, int kind)
   if (rc == ARITH_UNDERFLOW)
     {
       if (warn_underflow)
-	gfc_warning (gfc_arith_error (rc), &src->where);
+	gfc_warning (OPT_Woverflow, gfc_arith_error (rc), &src->where);
       mpfr_set_ui (mpc_realref (result->value.complex), 0, GFC_RND_MODE);
     }
   else if (rc != ARITH_OK)
@@ -2164,7 +2164,7 @@ gfc_complex2real (gfc_expr *src, int kind)
   if (rc == ARITH_UNDERFLOW)
     {
       if (warn_underflow)
-	gfc_warning (gfc_arith_error (rc), &src->where);
+	gfc_warning (OPT_Woverflow, gfc_arith_error (rc), &src->where);
       mpfr_set_ui (result->value.real, 0, GFC_RND_MODE);
     }
   if (rc != ARITH_OK)
@@ -2195,7 +2195,7 @@ gfc_complex2complex (gfc_expr *src, int kind)
   if (rc == ARITH_UNDERFLOW)
     {
       if (warn_underflow)
-	gfc_warning (gfc_arith_error (rc), &src->where);
+	gfc_warning (OPT_Woverflow, gfc_arith_error (rc), &src->where);
       mpfr_set_ui (mpc_realref (result->value.complex), 0, GFC_RND_MODE);
     }
   else if (rc != ARITH_OK)
@@ -2210,7 +2210,7 @@ gfc_complex2complex (gfc_expr *src, int kind)
   if (rc == ARITH_UNDERFLOW)
     {
       if (warn_underflow)
-	gfc_warning (gfc_arith_error (rc), &src->where);
+	gfc_warning (OPT_Woverflow, gfc_arith_error (rc), &src->where);
       mpfr_set_ui (mpc_imagref (result->value.complex), 0, GFC_RND_MODE);
     }
   else if (rc != ARITH_OK)
@@ -2280,7 +2280,7 @@ hollerith2representation (gfc_expr *result, gfc_expr *src)
 
   if (src_len > result_len)
     {
-      gfc_warning ("The Hollerith constant at %L is too long to convert to %s",
+      gfc_warning ("The Hollerith constant at %L is too long to convert to %qs",
 		   &src->where, gfc_typename(&result->ts));
     }
 
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index cea2689d5d1..c3f78e1c248 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -5081,9 +5081,9 @@ gfc_check_transfer (gfc_expr *source, gfc_expr *mold, gfc_expr *size)
     return true;
 
   if (source_size < result_size)
-    gfc_warning("Intrinsic TRANSFER at %L has partly undefined result: "
-		"source size %ld < result size %ld", &source->where,
-		(long) source_size, (long) result_size);
+    gfc_warning ("Intrinsic TRANSFER at %L has partly undefined result: "
+		 "source size %ld < result size %ld", &source->where,
+		 (long) source_size, (long) result_size);
 
   return true;
 }
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index f11bcb024fa..f374b9a245c 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -1030,8 +1030,9 @@ gfc_verify_c_interop_param (gfc_symbol *sym)
 			   sym->name, &(sym->declared_at),
 			   sym->ns->proc_name->name);
 	      else if (warn_c_binding_type)
-		gfc_warning ("Variable '%s' at %L is a dummy argument of the "
-			     "BIND(C) procedure '%s' but may not be C "
+		gfc_warning (OPT_Wc_binding_type,
+			     "Variable %qs at %L is a dummy argument of the "
+			     "BIND(C) procedure %qs but may not be C "
 			     "interoperable",
 			     sym->name, &(sym->declared_at),
 			     sym->ns->proc_name->name);
@@ -3294,8 +3295,8 @@ gfc_match_import (void)
 
 	  if (gfc_find_symtree (gfc_current_ns->sym_root, name))
 	    {
-	      gfc_warning ("'%s' is already IMPORTed from host scoping unit "
-			   "at %C.", name);
+	      gfc_warning ("%qs is already IMPORTed from host scoping unit "
+			   "at %C", name);
 	      goto next_item;
 	    }
 
@@ -4031,7 +4032,8 @@ verify_bind_c_sym (gfc_symbol *tmp_sym, gfc_typespec *ts,
       /* Make sure it wasn't an implicitly typed result.  */
       if (tmp_sym->attr.implicit_type && warn_c_binding_type)
 	{
-	  gfc_warning ("Implicitly declared BIND(C) function '%s' at "
+	  gfc_warning (OPT_Wc_binding_type,
+		       "Implicitly declared BIND(C) function %qs at "
                        "%L may not be C interoperable", tmp_sym->name,
                        &tmp_sym->declared_at);
 	  tmp_sym->ts.f90_type = tmp_sym->ts.type;
@@ -4052,9 +4054,10 @@ verify_bind_c_sym (gfc_symbol *tmp_sym, gfc_typespec *ts,
 	  /* See if we're dealing with a sym in a common block or not.	*/
 	  if (is_in_common == 1 && warn_c_binding_type)
 	    {
-	      gfc_warning ("Variable '%s' in common block '%s' at %L "
+	      gfc_warning (OPT_Wc_binding_type,
+			   "Variable %qs in common block %qs at %L "
                            "may not be a C interoperable "
-                           "kind though common block '%s' is BIND(C)",
+                           "kind though common block %qs is BIND(C)",
                            tmp_sym->name, com_block->name,
                            &(tmp_sym->declared_at), com_block->name);
 	    }
@@ -4065,7 +4068,7 @@ verify_bind_c_sym (gfc_symbol *tmp_sym, gfc_typespec *ts,
                            "interoperable but it is BIND(C)",
                            tmp_sym->name, &(tmp_sym->declared_at));
               else if (warn_c_binding_type)
-                gfc_warning ("Variable '%s' at %L "
+                gfc_warning (OPT_Wc_binding_type, "Variable %qs at %L "
                              "may not be a C interoperable "
                              "kind but it is bind(c)",
                              tmp_sym->name, &(tmp_sym->declared_at));
diff --git a/gcc/fortran/dependency.c b/gcc/fortran/dependency.c
index 18641451935..420ca705496 100644
--- a/gcc/fortran/dependency.c
+++ b/gcc/fortran/dependency.c
@@ -956,7 +956,7 @@ gfc_check_argument_var_dependency (gfc_expr *var, sym_intent intent,
 		     If a dependency is found in the case
 		     elemental == ELEM_CHECK_VARIABLE, we will generate
 		     a temporary, so we don't need to bother the user.  */
-		  gfc_warning ("INTENT(%s) actual argument at %L might "
+		  gfc_warning_1 ("INTENT(%s) actual argument at %L might "
 			       "interfere with actual argument at %L.",
 		   	       intent == INTENT_OUT ? "OUT" : "INOUT",
 		   	       &var->where, &expr->where);
diff --git a/gcc/fortran/error.c b/gcc/fortran/error.c
index 70429d3e122..d6475f37248 100644
--- a/gcc/fortran/error.c
+++ b/gcc/fortran/error.c
@@ -50,6 +50,10 @@ static int terminal_width, buffer_flag, errors, warnings;
 
 static gfc_error_buf error_buffer, warning_buffer, *cur_error_buffer;
 
+static output_buffer pp_warning_buffer;
+static int warningcount_buffered, werrorcount_buffered;
+
+#include <new> /* For placement-new */
 
 /* Go one level deeper suppressing errors.  */
 
@@ -122,6 +126,7 @@ void
 gfc_buffer_error (int flag)
 {
   buffer_flag = flag;
+  pp_warning_buffer.flush_p = !flag;
 }
 
 
@@ -804,10 +809,25 @@ gfc_increment_error_count (void)
 }
 
 
+/* Clear any output buffered in a pretty-print output_buffer.  */
+
+static void
+gfc_clear_pp_buffer (output_buffer *this_buffer)
+{
+  pretty_printer *pp = global_dc->printer;
+  output_buffer *tmp_buffer = pp->buffer;
+  pp->buffer = this_buffer;
+  pp_clear_output_area (pp);
+  pp->buffer = tmp_buffer;
+}
+
+
 /* Issue a warning.  */
+/* Use gfc_warning instead, unless two locations are used in the same
+   warning or for scanner.c, if the location is not properly set up.  */
 
 void
-gfc_warning (const char *gmsgid, ...)
+gfc_warning_1 (const char *gmsgid, ...)
 {
   va_list argp;
 
@@ -833,6 +853,88 @@ gfc_warning (const char *gmsgid, ...)
 }
 
 
+/* This is just a helper function to avoid duplicating the logic of
+   gfc_warning.  */
+
+static bool
+gfc_warning (int opt, const char *gmsgid, va_list ap) ATTRIBUTE_GCC_GFC(2,0);
+
+static bool
+gfc_warning (int opt, const char *gmsgid, va_list ap)
+{
+  va_list argp;
+  va_copy (argp, ap);
+
+  diagnostic_info diagnostic;
+  bool fatal_errors = global_dc->fatal_errors;
+  pretty_printer *pp = global_dc->printer;
+  output_buffer *tmp_buffer = pp->buffer;
+  bool buffered_p = !pp_warning_buffer.flush_p;
+
+  gfc_clear_pp_buffer (&pp_warning_buffer);
+
+  if (buffered_p)
+    {
+      pp->buffer = &pp_warning_buffer;
+      global_dc->fatal_errors = false;
+      /* To prevent -fmax-errors= triggering.  */
+      --werrorcount;
+    }
+
+  diagnostic_set_info (&diagnostic, gmsgid, &argp, UNKNOWN_LOCATION,
+		       DK_WARNING);
+  diagnostic.option_index = opt;
+  bool ret = report_diagnostic (&diagnostic);
+
+  if (buffered_p)
+    {
+      pp->buffer = tmp_buffer;
+      global_dc->fatal_errors = fatal_errors;
+
+      warningcount_buffered = 0;
+      werrorcount_buffered = 0;
+      /* Undo the above --werrorcount if not Werror, otherwise
+	 werrorcount is correct already.  */
+      if (!ret)
+	++werrorcount;
+      else if (diagnostic.kind == DK_ERROR)
+	++werrorcount_buffered;
+      else 
+	++werrorcount, --warningcount, ++warningcount_buffered;
+    }
+  
+  va_end (argp);
+  return ret;
+}
+
+/* Issue a warning.  */
+/* This function uses the common diagnostics, but does not support
+   two locations; when being used in scanner.c, ensure that the location
+   is properly setup. Otherwise, use gfc_warning_1.   */
+
+bool
+gfc_warning (int opt, const char *gmsgid, ...)
+{
+  va_list argp;
+
+  va_start (argp, gmsgid);
+  bool ret = gfc_warning (opt, gmsgid, argp);
+  va_end (argp);
+  return ret;
+}
+
+bool
+gfc_warning (const char *gmsgid, ...)
+{
+  va_list argp;
+
+  va_start (argp, gmsgid);
+  bool ret = gfc_warning (0, gmsgid, argp);
+  va_end (argp);
+  return ret;
+}
+
+
 /* Whether, for a feature included in a given standard set (GFC_STD_*),
    we should issue an error or a warning, or be quiet.  */
 
@@ -1176,6 +1278,11 @@ void
 gfc_clear_warning (void)
 {
   warning_buffer.flag = 0;
+
+  gfc_clear_pp_buffer (&pp_warning_buffer);
+  warningcount_buffered = 0;
+  werrorcount_buffered = 0;
+  pp_warning_buffer.flush_p = false;
 }
 
 
@@ -1192,6 +1299,20 @@ gfc_warning_check (void)
 	fputs (warning_buffer.message, stderr);
       warning_buffer.flag = 0;
     }
+
+  /* This is for the new diagnostics machinery.  */
+  pretty_printer *pp = global_dc->printer;
+  output_buffer *tmp_buffer = pp->buffer;
+  pp->buffer = &pp_warning_buffer;
+  if (pp_last_position_in_text (pp) != NULL)
+    {
+      pp_really_flush (pp);
+      pp_warning_buffer.flush_p = true;
+      warningcount += warningcount_buffered;
+      werrorcount += werrorcount_buffered;
+    }
+
+  pp->buffer = tmp_buffer;
 }
 
 
@@ -1407,6 +1528,7 @@ gfc_diagnostics_init (void)
   diagnostic_finalizer (global_dc) = gfc_diagnostic_finalizer;
   diagnostic_format_decoder (global_dc) = gfc_format_decoder;
   global_dc->caret_char = '^';
+  new (&pp_warning_buffer) output_buffer ();
 }
 
 void
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 59f770c7ada..edf83363ba6 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -3173,7 +3173,8 @@ gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform)
   /* This is possibly a typo: x = f() instead of x => f().  */
   if (warn_surprising
       && rvalue->expr_type == EXPR_FUNCTION && gfc_expr_attr (rvalue).pointer)
-    gfc_warning ("POINTER-valued function appears on right-hand side of "
+    gfc_warning (OPT_Wsurprising,
+		 "POINTER-valued function appears on right-hand side of "
 		 "assignment at %L", &rvalue->where);
 
   /* Check size of array assignments.  */
@@ -3198,9 +3199,10 @@ gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform)
     {
       int rc;
       if (warn_surprising)
-        gfc_warning ("BOZ literal at %L is bitwise transferred "
-                     "non-integer symbol '%s'", &rvalue->where,
-                     lvalue->symtree->n.sym->name);
+	gfc_warning (OPT_Wsurprising,
+		     "BOZ literal at %L is bitwise transferred "
+		     "non-integer symbol %qs", &rvalue->where,
+		     lvalue->symtree->n.sym->name);
       if (!gfc_convert_boz (rvalue, &lvalue->ts))
 	return false;
       if ((rc = gfc_range_check (rvalue)) != ARITH_OK)
@@ -3246,22 +3248,25 @@ gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform)
 	      mpfr_sub (diff, rv, rvalue->value.real, GFC_RND_MODE);
 
 	      if (!mpfr_zero_p (diff))
-		gfc_warning ("Change of value in conversion from "
-			     " %s to %s at %L", gfc_typename (&rvalue->ts),
+		gfc_warning (OPT_Wconversion, 
+			     "Change of value in conversion from "
+			     " %qs to %qs at %L", gfc_typename (&rvalue->ts),
 			     gfc_typename (&lvalue->ts), &rvalue->where);
 
 	      mpfr_clear (rv);
 	      mpfr_clear (diff);
 	    }
 	  else
-	    gfc_warning ("Possible change of value in conversion from %s "
-			 "to %s at %L",gfc_typename (&rvalue->ts),
+	    gfc_warning (OPT_Wconversion,
+			 "Possible change of value in conversion from %qs "
+			 "to %qs at %L", gfc_typename (&rvalue->ts),
 			 gfc_typename (&lvalue->ts), &rvalue->where);
 
 	}
       else if (warn_conversion_extra && lvalue->ts.kind > rvalue->ts.kind)
 	{
-	  gfc_warning ("Conversion from %s to %s at %L",
+	  gfc_warning (OPT_Wconversion_extra,
+		       "Conversion from %qs to %qs at %L",
 		       gfc_typename (&rvalue->ts),
 		       gfc_typename (&lvalue->ts), &rvalue->where);
 	}
@@ -3783,7 +3788,8 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue)
 	  }
 
       if (warn)
-	gfc_warning ("Pointer at %L in pointer assignment might outlive the "
+	gfc_warning (OPT_Wtarget_lifetime,
+		     "Pointer at %L in pointer assignment might outlive the "
 		     "pointer target", &lvalue->where);
     }
 
diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c
index 799d2fedddc..5485cd14761 100644
--- a/gcc/fortran/frontend-passes.c
+++ b/gcc/fortran/frontend-passes.c
@@ -547,7 +547,8 @@ create_var (gfc_expr * e)
       result->ref->u.ar.as = symbol->ts.type == BT_CLASS
 			     ? CLASS_DATA (symbol)->as : symbol->as;
       if (warn_array_temporaries)
-	gfc_warning ("Creating array temporary at %L", &(e->where));
+	gfc_warning (OPT_Warray_temporaries,
+		     "Creating array temporary at %L", &(e->where));
     }
 
   /* Generate the new assignment.  */
@@ -570,10 +571,10 @@ do_warn_function_elimination (gfc_expr *e)
   if (e->expr_type != EXPR_FUNCTION)
     return;
   if (e->value.function.esym)
-    gfc_warning ("Removing call to function '%s' at %L",
+    gfc_warning ("Removing call to function %qs at %L",
 		 e->value.function.esym->name, &(e->where));
   else if (e->value.function.isym)
-    gfc_warning ("Removing call to function '%s' at %L",
+    gfc_warning ("Removing call to function %qs at %L",
 		 e->value.function.isym->name, &(e->where));
 }
 /* Callback function for the code walker for doing common function
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 1bf9862d23c..0baf041641e 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2672,7 +2672,9 @@ void gfc_buffer_error (int);
 
 const char *gfc_print_wide_char (gfc_char_t);
 
-void gfc_warning (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
+void gfc_warning_1 (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
+bool gfc_warning (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
+bool gfc_warning (int opt, const char *, ...) ATTRIBUTE_GCC_GFC(2,3);
 void gfc_warning_now_1 (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
 bool gfc_warning_now (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
 bool gfc_warning_now (int opt, const char *, ...) ATTRIBUTE_GCC_GFC(2,3);
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 2429fd20e24..bf07d43d3b7 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -1178,7 +1178,7 @@ check_dummy_characteristics (gfc_symbol *s1, gfc_symbol *s2,
 
 	case -2:
 	  /* FIXME: Implement a warning for this case.
-	  gfc_warning ("Possible character length mismatch in argument '%s'",
+	  gfc_warning ("Possible character length mismatch in argument %qs",
 		       s1->name);*/
 	  break;
 
@@ -1649,11 +1649,11 @@ check_interface1 (gfc_interface *p, gfc_interface *q0,
 			 p->sym->name, q->sym->name, interface_name,
 			 &p->where);
 	    else if (!p->sym->attr.use_assoc && q->sym->attr.use_assoc)
-	      gfc_warning ("Ambiguous interfaces '%s' and '%s' in %s at %L",
+	      gfc_warning ("Ambiguous interfaces %qs and %qs in %s at %L",
 			   p->sym->name, q->sym->name, interface_name,
 			   &p->where);
 	    else
-	      gfc_warning ("Although not referenced, '%s' has ambiguous "
+	      gfc_warning ("Although not referenced, %qs has ambiguous "
 			   "interfaces at %L", interface_name, &p->where);
 	    return 1;
 	  }
@@ -2147,8 +2147,9 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
 	    return 0;
 	}
       else if (warn_surprising && where && formal->attr.intent != INTENT_IN)
-	gfc_warning ("Passing coarray at %L to allocatable, noncoarray dummy "
-		     "argument '%s', which is invalid if the allocation status"
+	gfc_warning (OPT_Wsurprising,
+		     "Passing coarray at %L to allocatable, noncoarray dummy "
+		     "argument %qs, which is invalid if the allocation status"
 		     " is modified",  &actual->where, formal->name);
     }
 
@@ -2673,13 +2674,13 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
 	   if (where && (f->sym->attr.pointer || f->sym->attr.allocatable))
 	     gfc_warning ("Character length mismatch (%ld/%ld) between actual "
 			  "argument and pointer or allocatable dummy argument "
-			  "'%s' at %L",
+			  "%qs at %L",
 			  mpz_get_si (a->expr->ts.u.cl->length->value.integer),
 			  mpz_get_si (f->sym->ts.u.cl->length->value.integer),
 			  f->sym->name, &a->expr->where);
 	   else if (where)
 	     gfc_warning ("Character length mismatch (%ld/%ld) between actual "
-			  "argument and assumed-shape dummy argument '%s' "
+			  "argument and assumed-shape dummy argument %qs "
 			  "at %L",
 			  mpz_get_si (a->expr->ts.u.cl->length->value.integer),
 			  mpz_get_si (f->sym->ts.u.cl->length->value.integer),
@@ -2710,12 +2711,12 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
 	{
 	  if (a->expr->ts.type == BT_CHARACTER && !f->sym->as && where)
 	    gfc_warning ("Character length of actual argument shorter "
-			 "than of dummy argument '%s' (%lu/%lu) at %L",
+			 "than of dummy argument %qs (%lu/%lu) at %L",
 			 f->sym->name, actual_size, formal_size,
 			 &a->expr->where);
           else if (where)
 	    gfc_warning ("Actual argument contains too few "
-			 "elements for dummy argument '%s' (%lu/%lu) at %L",
+			 "elements for dummy argument %qs (%lu/%lu) at %L",
 			 f->sym->name, actual_size, formal_size,
 			 &a->expr->where);
 	  return  0;
@@ -3146,7 +3147,7 @@ check_some_aliasing (gfc_formal_arglist *f, gfc_actual_arglist *a)
 	      || (f1_intent == INTENT_OUT && f2_intent == INTENT_OUT))
 	    {
 	      gfc_warning ("Same actual argument associated with INTENT(%s) "
-			   "argument '%s' and INTENT(%s) argument '%s' at %L",
+			   "argument %qs and INTENT(%s) argument %qs at %L",
 			   gfc_intent_string (f1_intent), p[i].f->sym->name,
 			   gfc_intent_string (f2_intent), p[j].f->sym->name,
 			   &p[i].a->expr->where);
@@ -3261,10 +3262,12 @@ gfc_procedure_use (gfc_symbol *sym, gfc_actual_arglist **ap, locus *where)
 	  return false;
 	}
       if (warn_implicit_interface)
-	gfc_warning ("Procedure '%s' called with an implicit interface at %L",
+	gfc_warning (OPT_Wimplicit_interface,
+		     "Procedure %qs called with an implicit interface at %L",
 		     sym->name, where);
       else if (warn_implicit_procedure && sym->attr.proc == PROC_UNKNOWN)
-	gfc_warning ("Procedure '%s' called at %L is not explicitly declared",
+	gfc_warning (OPT_Wimplicit_procedure,
+		     "Procedure %qs called at %L is not explicitly declared",
 		     sym->name, where);
     }
 
@@ -3376,7 +3379,8 @@ gfc_ppc_use (gfc_component *comp, gfc_actual_arglist **ap, locus *where)
   if (warn_implicit_interface
       && comp->attr.if_source == IFSRC_UNKNOWN
       && !comp->attr.is_iso_c)
-    gfc_warning ("Procedure pointer component '%s' called with an implicit "
+    gfc_warning (OPT_Wimplicit_interface,
+		 "Procedure pointer component %qs called with an implicit "
 		 "interface at %L", comp->name, where);
 
   if (comp->attr.if_source == IFSRC_UNKNOWN)
diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index 5dd4092e63a..baaa05a43b1 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -4316,7 +4316,7 @@ gfc_check_intrinsic_standard (const gfc_intrinsic_sym* isym,
     {
       /* Do only print a warning if not a GNU extension.  */
       if (!silent && isym->standard != GFC_STD_GNU)
-	gfc_warning ("Intrinsic '%s' (is %s) is used at %L",
+	gfc_warning ("Intrinsic %qs (is %s) is used at %L",
 		     isym->name, _(symstd_msg), &where);
 
       return true;
@@ -4824,12 +4824,14 @@ gfc_warn_intrinsic_shadow (const gfc_symbol* sym, bool in_module, bool func)
 
   /* Emit the warning.  */
   if (in_module || sym->ns->proc_name)
-    gfc_warning ("'%s' declared at %L may shadow the intrinsic of the same"
+    gfc_warning (OPT_Wintrinsic_shadow,
+		 "%qs declared at %L may shadow the intrinsic of the same"
 		 " name.  In order to call the intrinsic, explicit INTRINSIC"
 		 " declarations may be required.",
 		 sym->name, &sym->declared_at);
   else
-    gfc_warning ("'%s' declared at %L is also the name of an intrinsic.  It can"
+    gfc_warning (OPT_Wintrinsic_shadow,
+		 "%qs declared at %L is also the name of an intrinsic.  It can"
 		 " only be called via an explicit interface or if declared"
 		 " EXTERNAL.", sym->name, &sym->declared_at);
 }
diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c
index 731c6dcc567..de8254ae92b 100644
--- a/gcc/fortran/io.c
+++ b/gcc/fortran/io.c
@@ -1721,7 +1721,7 @@ compare_to_allowed_values (const char *specifier, const char *allowed[],
 	if (n == WARNING || (warn && n == ERROR))
 	  {
 	    gfc_warning ("Fortran 2003: %s specifier in %s statement at %C "
-			 "has value '%s'", specifier, statement,
+			 "has value %qs", specifier, statement,
 			 allowed_f2003[i]);
 	    return 1;
 	  }
@@ -1748,7 +1748,7 @@ compare_to_allowed_values (const char *specifier, const char *allowed[],
 	if (n == WARNING || (warn && n == ERROR))
 	  {
 	    gfc_warning ("Extension: %s specifier in %s statement at %C "
-			 "has value '%s'", specifier, statement,
+			 "has value %qs", specifier, statement,
 			 allowed_gnu[i]);
 	    return 1;
 	  }
diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c
index a7a26a15b93..10ea61af306 100644
--- a/gcc/fortran/primary.c
+++ b/gcc/fortran/primary.c
@@ -558,8 +558,9 @@ match_real_constant (gfc_expr **result, int signflag)
 			   "real-literal-constant at %C"))
 	return MATCH_ERROR;
       else if (warn_real_q_constant)
-	gfc_warning("Extension: exponent-letter 'q' in real-literal-constant "
-		    "at %C");
+	gfc_warning (OPT_Wreal_q_constant,
+		     "Extension: exponent-letter %<q%> in real-literal-constant "
+		     "at %C");
     }
 
   /* Scan exponent.  */
@@ -727,7 +728,7 @@ done:
 
     case ARITH_UNDERFLOW:
       if (warn_underflow)
-	gfc_warning ("Real constant underflows its kind at %C");
+	gfc_warning (OPT_Wunderflow, "Real constant underflows its kind at %C");
       mpfr_set_ui (e->value.real, 0, GFC_RND_MODE);
       break;
 
@@ -1072,7 +1073,7 @@ got_delim:
   /* We disable the warning for the following loop as the warning has already
      been printed in the loop above.  */
   save_warn_ampersand = warn_ampersand;
-  warn_ampersand = 0;
+  warn_ampersand = false;
 
   p = e->value.character.string;
   for (i = 0; i < length; i++)
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index dfc2eb67d95..6571578ecac 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -1645,7 +1645,8 @@ gfc_resolve_intrinsic (gfc_symbol *sym, locus *loc)
     {
       if (sym->ts.type != BT_UNKNOWN && warn_surprising
 	  && !sym->attr.implicit_type)
-	gfc_warning ("Type specified for intrinsic function '%s' at %L is"
+	gfc_warning (OPT_Wsurprising,
+		     "Type specified for intrinsic function %qs at %L is"
 		      " ignored", sym->name, &sym->declared_at);
 
       if (!sym->attr.function &&
@@ -1718,9 +1719,9 @@ resolve_procedure_expression (gfc_expr* expr)
   /* A non-RECURSIVE procedure that is used as procedure expression within its
      own body is in danger of being called recursively.  */
   if (is_illegal_recursion (sym, gfc_current_ns))
-    gfc_warning ("Non-RECURSIVE procedure '%s' at %L is possibly calling"
+    gfc_warning ("Non-RECURSIVE procedure %qs at %L is possibly calling"
 		 " itself recursively.  Declare it RECURSIVE or use"
-		 " -frecursive", sym->name, &expr->where);
+		 " %<-frecursive%>", sym->name, &expr->where);
 
   return true;
 }
@@ -2101,7 +2102,7 @@ resolve_elemental_actual (gfc_expr *expr, gfc_code *c)
 	  && (set_by_optional || arg->expr->rank != rank)
 	  && !(isym && isym->id == GFC_ISYM_CONVERSION))
 	{
-	  gfc_warning ("'%s' at %L is an array and OPTIONAL; IF IT IS "
+	  gfc_warning ("%qs at %L is an array and OPTIONAL; IF IT IS "
 		       "MISSING, it cannot be the actual argument of an "
 		       "ELEMENTAL procedure unless there is a non-optional "
 		       "argument with the same rank (12.4.1.5)",
@@ -6332,8 +6333,8 @@ gfc_resolve_iterator (gfc_iterator *iter, bool real_ok, bool own_scope)
 	  cmp = mpfr_cmp (iter->end->value.real, iter->start->value.real);
 	}
       if (warn_zerotrip && ((sgn > 0 && cmp < 0) || (sgn < 0 && cmp > 0)))
-	gfc_warning ("DO loop at %L will be executed zero times"
-		     " (use -Wno-zerotrip to suppress)",
+	gfc_warning (OPT_Wzerotrip,
+		     "DO loop at %L will be executed zero times",
 		     &iter->step->where);
     }
 
@@ -7709,8 +7710,9 @@ resolve_select (gfc_code *code, bool select_type)
 	      && gfc_compare_expr (cp->low, cp->high, INTRINSIC_GT) > 0)
 	    {
 	      if (warn_surprising)
-		gfc_warning ("Range specification at %L can never "
-			     "be matched", &cp->where);
+		gfc_warning (OPT_Wsurprising,
+			     "Range specification at %L can never be matched",
+			     &cp->where);
 
 	      cp->unreachable = 1;
 	      seen_unreachable = 1;
@@ -7811,7 +7813,8 @@ resolve_select (gfc_code *code, bool select_type)
   /* More than two cases is legal but insane for logical selects.
      Issue a warning for it.  */
   if (warn_surprising && type == BT_LOGICAL && ncases > 2)
-    gfc_warning ("Logical SELECT CASE block at %L has more that two cases",
+    gfc_warning (OPT_Wsurprising,
+		 "Logical SELECT CASE block at %L has more that two cases",
 		 &code->loc);
 }
 
@@ -8799,7 +8802,7 @@ gfc_resolve_assign_in_forall (gfc_code *code, int nvar, gfc_expr **var_expr)
 	     assignment.  Emit a warning rather than an error because the
 	     mask could be resolving this problem.  */
 	  if (!find_forall_index (code->expr1, forall_index, 0))
-	    gfc_warning ("The FORALL with index '%s' is not used on the "
+	    gfc_warning ("The FORALL with index %qs is not used on the "
 			 "left side of the assignment at %L and so might "
 			 "cause multiple assignment to this object",
 			 var_expr[n]->symtree->name, &code->expr1->where);
@@ -9181,8 +9184,9 @@ resolve_ordinary_assign (gfc_code *code, gfc_namespace *ns)
     {
       int rc;
       if (warn_surprising)
-	gfc_warning ("BOZ literal at %L is bitwise transferred "
-		     "non-integer symbol '%s'", &code->loc,
+	gfc_warning (OPT_Wsurprising,
+		     "BOZ literal at %L is bitwise transferred "
+		     "non-integer symbol %qs", &code->loc,
 		     lhs->symtree->n.sym->name);
 
       if (!gfc_convert_boz (rhs, &lhs->ts))
@@ -10482,7 +10486,8 @@ resolve_charlen (gfc_charlen *cl)
   if (cl->length && !gfc_extract_int (cl->length, &i) && i < 0)
     {
       if (warn_surprising)
-	gfc_warning_now ("CHARACTER variable at %L has negative length %d,"
+	gfc_warning_now (OPT_Wsurprising,
+			 "CHARACTER variable at %L has negative length %d,"
 			 " the length has been set to zero",
 			 &cl->length->where, i);
       gfc_replace_expr (cl->length,
@@ -11499,7 +11504,8 @@ gfc_resolve_finalizers (gfc_symbol* derived, bool *finalizable)
       /* Warn if the procedure is non-scalar and not assumed shape.  */
       if (warn_surprising && arg->as && arg->as->rank != 0
 	  && arg->as->type != AS_ASSUMED_SHAPE)
-	gfc_warning ("Non-scalar FINAL procedure at %L should have assumed"
+	gfc_warning (OPT_Wsurprising,
+		     "Non-scalar FINAL procedure at %L should have assumed"
 		     " shape argument", &arg->declared_at);
 
       /* Check that it does not match in kind and rank with a FINAL procedure
@@ -11557,7 +11563,8 @@ error:
      were nodes in the list, must have been for arrays.  It is surely a good
      idea to have a scalar version there if there's something to finalize.  */
   if (warn_surprising && result && !seen_scalar)
-    gfc_warning ("Only array FINAL procedures declared for derived type '%s'"
+    gfc_warning (OPT_Wsurprising,
+		 "Only array FINAL procedures declared for derived type %qs"
 		 " defined at %L, suggest also scalar one",
 		 derived->name, &derived->declared_at);
 
diff --git a/gcc/fortran/scanner.c b/gcc/fortran/scanner.c
index 8222b7e3b80..0de09983c23 100644
--- a/gcc/fortran/scanner.c
+++ b/gcc/fortran/scanner.c
@@ -1155,7 +1155,8 @@ restart:
 	    {
 	      gfc_current_locus.nextc--;
 	      if (warn_ampersand && in_string == INSTRING_WARN)
-		gfc_warning ("Missing '&' in continued character "
+		gfc_warning (OPT_Wampersand, 
+			     "Missing %<&%> in continued character "
 			     "constant at %C");
 	    }
 	  /* Both !$omp and !$ -fopenmp continuation lines have & on the
diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index 7ccabc700fc..095de6b25a2 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -716,7 +716,8 @@ simplify_achar_char (gfc_expr *e, gfc_expr *k, const char *name, bool ascii)
     }
 
   if (ascii && warn_surprising && mpz_cmp_si (e->value.integer, 127) > 0)
-    gfc_warning ("Argument of %s function at %L outside of range [0,127]",
+    gfc_warning (OPT_Wsurprising,
+		 "Argument of %s function at %L outside of range [0,127]",
 		 name, &e->where);
 
   if (kind == 1 && mpz_cmp_si (e->value.integer, 255) > 0)
@@ -2505,7 +2506,8 @@ gfc_simplify_iachar (gfc_expr *e, gfc_expr *kind)
   index = e->value.character.string[0];
 
   if (warn_surprising && index > 127)
-    gfc_warning ("Argument of IACHAR function at %L outside of range 0..127",
+    gfc_warning (OPT_Wsurprising,
+		 "Argument of IACHAR function at %L outside of range 0..127",
 		 &e->where);
 
   k = get_kind (BT_INTEGER, kind, "IACHAR", gfc_default_integer_kind);
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index fa0ffe06818..92a15d06c86 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -3874,7 +3874,7 @@ verify_bind_c_derived_type (gfc_symbol *derived_sym)
   */
   if (curr_comp == NULL)
     {
-      gfc_warning ("Derived type '%s' with BIND(C) attribute at %L is empty, "
+      gfc_warning ("Derived type %qs with BIND(C) attribute at %L is empty, "
 		   "and may be inaccessible by the C companion processor",
 		   derived_sym->name, &(derived_sym->declared_at));
       derived_sym->ts.is_c_interop = 1;
@@ -3954,16 +3954,18 @@ verify_bind_c_derived_type (gfc_symbol *derived_sym)
 	      if (derived_sym->attr.is_bind_c == 1 && warn_c_binding_type)
 		/* If the derived type is bind(c), all fields must be
 		   interop.  */
-		gfc_warning ("Component '%s' in derived type '%s' at %L "
+		gfc_warning (OPT_Wc_binding_type,
+			     "Component %qs in derived type %qs at %L "
                              "may not be C interoperable, even though "
-                             "derived type '%s' is BIND(C)",
+                             "derived type %qs is BIND(C)",
                              curr_comp->name, derived_sym->name,
                              &(curr_comp->loc), derived_sym->name);
 	      else if (warn_c_binding_type)
 		/* If derived type is param to bind(c) routine, or to one
 		   of the iso_c_binding procs, it must be interoperable, so
 		   all fields must interop too.	 */
-		gfc_warning ("Component '%s' in derived type '%s' at %L "
+		gfc_warning (OPT_Wc_binding_type,
+			     "Component %qs in derived type %qs at %L "
                              "may not be C interoperable",
                              curr_comp->name, derived_sym->name,
                              &(curr_comp->loc));
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 47364da00d9..f02ff32247a 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -1042,7 +1042,8 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss,
   gcc_assert (ss->loop->dimen == ss->dimen);
 
   if (warn_array_temporaries && where)
-    gfc_warning ("Creating array temporary at %L", where);
+    gfc_warning (OPT_Warray_temporaries,
+		 "Creating array temporary at %L", where);
 
   /* Set the lower bound to zero.  */
   for (s = ss; s; s = s->parent)
@@ -5922,7 +5923,8 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc,
       stride = gfc_index_one_node;
 
       if (warn_array_temporaries)
-	gfc_warning ("Creating array temporary at %L", &loc);
+	gfc_warning (OPT_Warray_temporaries,
+		     "Creating array temporary at %L", &loc);
     }
 
   /* This is for the case where the array data is used directly without
@@ -7205,10 +7207,12 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, bool g77,
       if (warn_array_temporaries)
 	{
 	  if (fsym)
-	    gfc_warning ("Creating array temporary at %L for argument '%s'",
+	    gfc_warning (OPT_Warray_temporaries,
+			 "Creating array temporary at %L for argument %qs",
 			 &expr->where, fsym->name);
 	  else
-	    gfc_warning ("Creating array temporary at %L", &expr->where);
+	    gfc_warning (OPT_Warray_temporaries,
+			 "Creating array temporary at %L", &expr->where);
 	}
 
       ptr = build_call_expr_loc (input_location,
diff --git a/gcc/fortran/trans-common.c b/gcc/fortran/trans-common.c
index 0b4f5e67d1b..f5d831f31b1 100644
--- a/gcc/fortran/trans-common.c
+++ b/gcc/fortran/trans-common.c
@@ -397,7 +397,7 @@ build_common_decl (gfc_common_head *com, tree union_type, bool is_init)
 	 blank common blocks may be of different sizes.  */
       if (!tree_int_cst_equal (DECL_SIZE_UNIT (decl), size)
 	  && strcmp (com->name, BLANK_COMMON_NAME))
-	gfc_warning ("Named COMMON block '%s' at %L shall be of the "
+	gfc_warning ("Named COMMON block %qs at %L shall be of the "
 		     "same size as elsewhere (%lu vs %lu bytes)", com->name,
 		     &com->where,
 		     (unsigned long) TREE_INT_CST_LOW (size),
@@ -1136,12 +1136,12 @@ translate_common (gfc_common_head *common, gfc_symbol *var_list)
 	      if (warn_align_commons)
 		{
 		  if (strcmp (common->name, BLANK_COMMON_NAME))
-		    gfc_warning ("Padding of %d bytes required before '%s' in "
-				 "COMMON '%s' at %L; reorder elements or use "
+		    gfc_warning ("Padding of %d bytes required before %qs in "
+				 "COMMON %qs at %L; reorder elements or use "
 				 "-fno-align-commons", (int)offset,
 				 s->sym->name, common->name, &common->where);
 		  else
-		    gfc_warning ("Padding of %d bytes required before '%s' in "
+		    gfc_warning ("Padding of %d bytes required before %qs in "
 				 "COMMON at %L; reorder elements or use "
 				 "-fno-align-commons", (int)offset,
 				 s->sym->name, &common->where);
@@ -1170,12 +1170,14 @@ translate_common (gfc_common_head *common, gfc_symbol *var_list)
   if (common_segment->offset != 0 && warn_align_commons)
     {
       if (strcmp (common->name, BLANK_COMMON_NAME))
-	gfc_warning ("COMMON '%s' at %L requires %d bytes of padding; "
-		     "reorder elements or use -fno-align-commons",
+	gfc_warning (OPT_Walign_commons,
+		     "COMMON %qs at %L requires %d bytes of padding; "
+		     "reorder elements or use %<-fno-align-commons%>",
 		     common->name, &common->where, (int)common_segment->offset);
       else
-	gfc_warning ("COMMON at %L requires %d bytes of padding; "
-		     "reorder elements or use -fno-align-commons",
+	gfc_warning (OPT_Walign_commons,
+		     "COMMON at %L requires %d bytes of padding; "
+		     "reorder elements or use %<-fno-align-commons%>",
 		     &common->where, (int)common_segment->offset);
     }
 
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 713f96959d6..780d350e31d 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -3795,7 +3795,8 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
 	    }
 	  /* TODO: move to the appropriate place in resolve.c.  */
 	  if (warn_return_type && el == NULL)
-	    gfc_warning ("Return value of function '%s' at %L not set",
+	    gfc_warning (OPT_Wreturn_type,
+			 "Return value of function %qs at %L not set",
 			 proc_sym->name, &proc_sym->declared_at);
 	}
       else if (proc_sym->as)
@@ -4430,7 +4431,8 @@ gfc_create_module_variable (gfc_symbol * sym)
 
   if (warn_unused_variable && !sym->attr.referenced
       && sym->attr.access == ACCESS_PRIVATE)
-    gfc_warning ("Unused PRIVATE module variable '%s' declared at %L",
+    gfc_warning (OPT_Wunused_value,
+		 "Unused PRIVATE module variable %qs declared at %L",
 		 sym->name, &sym->declared_at);
 
   /* We always want module variables to be created.  */
@@ -4992,12 +4994,14 @@ generate_local_decl (gfc_symbol * sym)
 	  if (warn_unused_dummy_argument && sym->attr.intent == INTENT_OUT)
 	    {
 	      if (sym->ts.type != BT_DERIVED)
-		gfc_warning ("Dummy argument '%s' at %L was declared "
+		gfc_warning (OPT_Wunused_dummy_argument,
+			     "Dummy argument %qs at %L was declared "
 			     "INTENT(OUT) but was not set",  sym->name,
 			     &sym->declared_at);
 	      else if (!gfc_has_default_initializer (sym->ts.u.derived)
 		       && !sym->ts.u.derived->attr.zero_comp)
-		gfc_warning ("Derived-type dummy argument '%s' at %L was "
+		gfc_warning (OPT_Wunused_dummy_argument,
+			     "Derived-type dummy argument %qs at %L was "
 			     "declared INTENT(OUT) but was not set and "
 			     "does not have a default initializer",
 			     sym->name, &sym->declared_at);
@@ -5006,8 +5010,9 @@ generate_local_decl (gfc_symbol * sym)
 	    }
 	  else if (warn_unused_dummy_argument)
 	    {
-	      gfc_warning ("Unused dummy argument '%s' at %L", sym->name,
-			 &sym->declared_at);
+	      gfc_warning (OPT_Wunused_dummy_argument,
+			   "Unused dummy argument %qs at %L", sym->name,
+			   &sym->declared_at);
 	      if (sym->backend_decl != NULL_TREE)
 		TREE_NO_WARNING(sym->backend_decl) = 1;
 	    }
@@ -5020,7 +5025,8 @@ generate_local_decl (gfc_symbol * sym)
 	{
 	  if (sym->attr.use_only)
 	    {
-	      gfc_warning ("Unused module variable '%s' which has been "
+	      gfc_warning (OPT_Wunused_variable,
+			   "Unused module variable %qs which has been "
 			   "explicitly imported at %L", sym->name,
 			   &sym->declared_at);
 	      if (sym->backend_decl != NULL_TREE)
@@ -5028,7 +5034,8 @@ generate_local_decl (gfc_symbol * sym)
 	    }
 	  else if (!sym->attr.use_assoc)
 	    {
-	      gfc_warning ("Unused variable '%s' declared at %L",
+	      gfc_warning (OPT_Wunused_variable,
+			   "Unused variable %qs declared at %L",
 			   sym->name, &sym->declared_at);
 	      if (sym->backend_decl != NULL_TREE)
 		TREE_NO_WARNING(sym->backend_decl) = 1;
@@ -5076,10 +5083,12 @@ generate_local_decl (gfc_symbol * sym)
            && !sym->attr.referenced)
 	{
            if (!sym->attr.use_assoc)
-	     gfc_warning ("Unused parameter '%s' declared at %L", sym->name,
+	     gfc_warning (OPT_Wunused_parameter,
+			  "Unused parameter %qs declared at %L", sym->name,
 			  &sym->declared_at);
 	   else if (sym->attr.use_only)
-	     gfc_warning ("Unused parameter '%s' which has been explicitly "
+	     gfc_warning (OPT_Wunused_parameter,
+			  "Unused parameter %qs which has been explicitly "
 			  "imported at %L", sym->name, &sym->declared_at);
 	}
     }
@@ -5094,7 +5103,8 @@ generate_local_decl (gfc_symbol * sym)
 	  && !sym->attr.use_assoc
 	  && sym->attr.if_source != IFSRC_IFBODY)
 	{
-	  gfc_warning ("Return value '%s' of function '%s' declared at "
+	  gfc_warning (OPT_Wreturn_type,
+		       "Return value %qs of function %qs declared at "
 		       "%L not set", sym->result->name, sym->name,
 		        &sym->result->declared_at);
 
@@ -5121,7 +5131,8 @@ generate_local_decl (gfc_symbol * sym)
 	  if (!sym->attr.referenced)
 	    {
 	      if (warn_unused_dummy_argument)
-		gfc_warning ("Unused dummy argument '%s' at %L", sym->name,
+		gfc_warning (OPT_Wunused_dummy_argument,
+			     "Unused dummy argument %qs at %L", sym->name,
 			     &sym->declared_at);
 	    }
 
@@ -5801,7 +5812,8 @@ gfc_generate_function_code (gfc_namespace * ns)
 	{
 	  /* TODO: move to the appropriate place in resolve.c.  */
 	  if (warn_return_type && sym == sym->result)
-	    gfc_warning ("Return value of function '%s' at %L not set",
+	    gfc_warning (OPT_Wreturn_type,
+			 "Return value of function %qs at %L not set",
 			 sym->name, &sym->declared_at);
 	  if (warn_return_type)
 	    TREE_NO_WARNING(sym->backend_decl) = 1;
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index f8e4df8a74e..7bdcc724935 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -1112,10 +1112,12 @@ static void
 realloc_lhs_warning (bt type, bool array, locus *where)
 {
   if (array && type != BT_CLASS && type != BT_DERIVED && warn_realloc_lhs)
-    gfc_warning ("Code for reallocating the allocatable array at %L will "
+    gfc_warning (OPT_Wrealloc_lhs,
+		 "Code for reallocating the allocatable array at %L will "
 		 "be added", where);
   else if (warn_realloc_lhs_all)
-    gfc_warning ("Code for reallocating the allocatable variable at %L "
+    gfc_warning (OPT_Wrealloc_lhs_all,
+		 "Code for reallocating the allocatable variable at %L "
 		 "will be added", where);
 }
 
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index d5972077940..4ebe492d536 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -6147,7 +6147,8 @@ gfc_conv_intrinsic_transfer (gfc_se * se, gfc_expr * expr)
 	  tmp = gfc_build_addr_expr (NULL_TREE, argse.expr);
 
 	  if (warn_array_temporaries)
-	    gfc_warning ("Creating array temporary at %L", &expr->where);
+	    gfc_warning (OPT_Warray_temporaries,
+			 "Creating array temporary at %L", &expr->where);
 
 	  source = build_call_expr_loc (input_location,
 				    gfor_fndecl_in_pack, 1, tmp);
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index d17b0758d2c..d28d67bc82c 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -540,7 +540,7 @@ gfc_trans_return (gfc_code * code)
       if (!result)
 	{
 	  gfc_warning ("An alternate return at %L without a * dummy argument",
-			&code->expr1->where);
+		       &code->expr1->where);
 	  return gfc_generate_return ();
 	}
 
diff --git a/gcc/pretty-print.c b/gcc/pretty-print.c
index b0c61829560..92912ca3efd 100644
--- a/gcc/pretty-print.c
+++ b/gcc/pretty-print.c
@@ -40,7 +40,8 @@ output_buffer::output_buffer ()
     cur_chunk_array (),
     stream (stderr),
     line_length (),
-    digit_buffer ()
+    digit_buffer (),
+    flush_p (true)
 {
   obstack_init (&formatted_obstack);
   obstack_init (&chunk_obstack);
@@ -679,12 +680,25 @@ pp_format_verbatim (pretty_printer *pp, text_info *text)
   pp_wrapping_mode (pp) = oldmode;
 }
 
-/* Flush the content of BUFFER onto the attached stream.  */
+/* Flush the content of BUFFER onto the attached stream.  This
+   function does nothing unless pp->output_buffer->flush_p.  */
 void
 pp_flush (pretty_printer *pp)
 {
+  pp_clear_state (pp);
+  if (!pp->buffer->flush_p)
+    return;
   pp_write_text_to_stream (pp);
+  fflush (pp_buffer (pp)->stream);
+}
+
+/* Flush the content of BUFFER onto the attached stream independently
+   of the value of pp->output_buffer->flush_p.  */
+void
+pp_really_flush (pretty_printer *pp)
+{
   pp_clear_state (pp);
+  pp_write_text_to_stream (pp);
   fflush (pp_buffer (pp)->stream);
 }
 
diff --git a/gcc/pretty-print.h b/gcc/pretty-print.h
index e315c41642e..d9e49be9928 100644
--- a/gcc/pretty-print.h
+++ b/gcc/pretty-print.h
@@ -100,6 +100,11 @@ struct output_buffer
   /* This must be large enough to hold any printed integer or
      floating-point value.  */
   char digit_buffer[128];
+
+  /* Nonzero means that text should be flushed when
+     appropriate. Otherwise, text is buffered until either
+     pp_really_flush or pp_clear_output_area are called.  */
+  bool flush_p;
 };
 
 /* The type of pretty-printer flags passed to clients.  */
@@ -314,6 +319,7 @@ extern void pp_printf (pretty_printer *, const char *, ...)
 extern void pp_verbatim (pretty_printer *, const char *, ...)
      ATTRIBUTE_GCC_PPDIAG(2,3);
 extern void pp_flush (pretty_printer *);
+extern void pp_really_flush (pretty_printer *);
 extern void pp_format (pretty_printer *, text_info *);
 extern void pp_output_formatted_text (pretty_printer *);
 extern void pp_format_verbatim (pretty_printer *, text_info *);
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index a11ed3a2cc0..f39ea80ed4a 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2014-12-03  Manuel López-Ibáñez  <manu@gcc.gnu.org>
+
+	PR fortran/44054
+	* gfortran.dg/warnings_are_errors_1.f90: Update warnings to errors.
+	* gfortran.dg/warnings_are_errors_1.f: Likewise.
+
 2014-12-03  David Edelsohn  <dje.gcc@gmail.com>
 
 	* g++.dg/ext/visibility/anon[12].C: Require visibility support.
diff --git a/gcc/testsuite/gfortran.dg/warnings_are_errors_1.f b/gcc/testsuite/gfortran.dg/warnings_are_errors_1.f
index 49bf1129f4e..510f93e5550 100644
--- a/gcc/testsuite/gfortran.dg/warnings_are_errors_1.f
+++ b/gcc/testsuite/gfortran.dg/warnings_are_errors_1.f
@@ -18,7 +18,7 @@
        end do
        call foo j bar
 ! gfc_warning:
-       r2(4) = 0 ! { dg-warning "is out of bounds" }
+       r2(4) = 0 ! { dg-error "is out of bounds" }
        
        goto 3 45
        end
diff --git a/gcc/testsuite/gfortran.dg/warnings_are_errors_1.f90 b/gcc/testsuite/gfortran.dg/warnings_are_errors_1.f90
index 8ce4699ad38..efb450854bf 100644
--- a/gcc/testsuite/gfortran.dg/warnings_are_errors_1.f90
+++ b/gcc/testsuite/gfortran.dg/warnings_are_errors_1.f90
@@ -17,7 +17,7 @@
 
        implicit none
 ! gfc_warning:
-1234  complex :: cplx ! { dg-warning "defined but cannot be used" }
+1234  complex :: cplx ! { dg-error "defined but cannot be used" }
       cplx = 20.
 
 ! gfc_warning_now: