gcc/ChangeLog:

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

	PR fortran/44054
	* diagnostic.c (diagnostic_action_after_output): Make it extern.
	Take diagnostic_t argument instead of diagnostic_info. Count also
	DK_WERROR towards max_errors.
	(diagnostic_report_diagnostic): Update call according to the above.
	(error_recursion): Likewise.
	* diagnostic.h (diagnostic_action_after_output): Declare.
	* pretty-print.c (pp_formatted_text_data): Delete.
	(pp_append_r): Call output_buffer_append_r.
	(pp_formatted_text): Call output_buffer_formatted_text.
	(pp_last_position_in_text): Call output_buffer_last_position_in_text.
	* pretty-print.h (output_buffer_formatted_text): New.
	(output_buffer_append_r): New.
	(output_buffer_last_position_in_text): New.

gcc/testsuite/ChangeLog:

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

        * gfortran.dg/do_iterator.f90: Remove bogus dg-warning.

gcc/fortran/ChangeLog:

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

	PR fortran/44054
	* error.c (pp_error_buffer): New static variable.
	(pp_warning_buffer): Make it a pointer.
	(gfc_output_buffer_empty_p): New.
	(gfc_error_init_1): Call gfc_buffer_error.
	(gfc_buffer_error): Do not use pp_warning_buffer.flush_p as the
	buffered_p flag.
	(gfc_clear_warning): Likewise.
	(gfc_warning_check): Call gfc_clear_warning. Only check the new
	pp_warning_buffer if the old warning_buffer was empty. Call
	diagnostic_action_after_output.
	(gfc_error_1): Renamed from gfc_error.
	(gfc_error): New.
	(gfc_clear_error): Clear also pp_error_buffer.
	(gfc_error_flag_test): Check also pp_error_buffer.
	(gfc_error_check): Likewise. Only check the new pp_error_buffer
	if the old error_buffer was empty.
	(gfc_move_output_buffer_from_to): New.
	(gfc_push_error): Use it here. Take also an output_buffer as argument.
	(gfc_pop_error): Likewise.
	(gfc_free_error): Likewise.
	(gfc_diagnostics_init): Use XNEW and placement-new to init
	pp_error_buffer and pp_warning_buffer. Set flush_p to false for
	both pp_warning_buffer and pp_error_buffer.

	* Update gfc_push_error, gfc_pop_error and gfc_free_error calls
	according to the above changes.
	* Use gfc_error_1 for all gfc_error calls that use multiple
	locations.
	* Use %qs instead of '%s' for many gfc_error calls.




git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@218627 138bc75d-0d04-0410-961f-82ee72b054a4

20 files changed, 665 insertions, 519 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 8534a453ab1..554474c3fc4 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,36 @@
+2014-12-11  Manuel López-Ibáñez  <manu@gcc.gnu.org>
+
+	PR fortran/44054
+	* error.c (pp_error_buffer): New static variable.
+	(pp_warning_buffer): Make it a pointer.
+	(gfc_output_buffer_empty_p): New.
+	(gfc_error_init_1): Call gfc_buffer_error.
+	(gfc_buffer_error): Do not use pp_warning_buffer.flush_p as the
+	buffered_p flag.
+	(gfc_clear_warning): Likewise.
+	(gfc_warning_check): Call gfc_clear_warning. Only check the new
+	pp_warning_buffer if the old warning_buffer was empty. Call
+	diagnostic_action_after_output.
+	(gfc_error_1): Renamed from gfc_error.
+	(gfc_error): New.
+	(gfc_clear_error): Clear also pp_error_buffer.
+	(gfc_error_flag_test): Check also pp_error_buffer.
+	(gfc_error_check): Likewise. Only check the new pp_error_buffer
+	if the old error_buffer was empty.
+	(gfc_move_output_buffer_from_to): New.
+	(gfc_push_error): Use it here. Take also an output_buffer as argument.
+	(gfc_pop_error): Likewise.
+	(gfc_free_error): Likewise.
+	(gfc_diagnostics_init): Use XNEW and placement-new to init
+	pp_error_buffer and pp_warning_buffer. Set flush_p to false for
+	both pp_warning_buffer and pp_error_buffer.
+
+	* Update gfc_push_error, gfc_pop_error and gfc_free_error calls
+	according to the above changes.
+	* Use gfc_error_1 for all gfc_error calls that use multiple
+	locations.
+	* Use %qs instead of '%s' for many gfc_error calls.
+
 2014-12-11  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 c692e623349..63945477188 100644
--- a/gcc/fortran/arith.c
+++ b/gcc/fortran/arith.c
@@ -1915,17 +1915,17 @@ arith_error (arith rc, gfc_typespec *from, gfc_typespec *to, locus *where)
       break;
     case ARITH_OVERFLOW:
       gfc_error ("Arithmetic overflow converting %s to %s at %L. This check "
-		 "can be disabled with the option -fno-range-check",
+		 "can be disabled with the option %<-fno-range-check%>",
 		 gfc_typename (from), gfc_typename (to), where);
       break;
     case ARITH_UNDERFLOW:
       gfc_error ("Arithmetic underflow converting %s to %s at %L. This check "
-		 "can be disabled with the option -fno-range-check",
+		 "can be disabled with the option %<-fno-range-check%>",
 		 gfc_typename (from), gfc_typename (to), where);
       break;
     case ARITH_NAN:
       gfc_error ("Arithmetic NaN converting %s to %s at %L. This check "
-		 "can be disabled with the option -fno-range-check",
+		 "can be disabled with the option %<-fno-range-check%>",
 		 gfc_typename (from), gfc_typename (to), where);
       break;
     case ARITH_DIV0:
diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c
index 159e6263c34..e27ca014059 100644
--- a/gcc/fortran/array.c
+++ b/gcc/fortran/array.c
@@ -100,7 +100,7 @@ match_subscript (gfc_array_ref *ar, int init, bool match_star)
 
   if (star)
     {
-      gfc_error ("Unexpected '*' in coarray subscript at %C");
+      gfc_error ("Unexpected %<*%> in coarray subscript at %C");
       return MATCH_ERROR;
     }
 
@@ -246,7 +246,7 @@ coarray:
       if (gfc_match_char (',') != MATCH_YES)
 	{
 	  if (gfc_match_char ('*') == MATCH_YES)
-	    gfc_error ("Unexpected '*' for codimension %d of %d at %C",
+	    gfc_error ("Unexpected %<*%> for codimension %d of %d at %C",
 		       ar->codimen + 1, corank);
 	  else
 	    gfc_error ("Invalid form of coarray reference at %C");
@@ -254,7 +254,7 @@ coarray:
 	}
       else if (ar->dimen_type[ar->codimen + ar->dimen] == DIMEN_STAR)
 	{
-	  gfc_error ("Unexpected '*' for codimension %d of %d at %C",
+	  gfc_error ("Unexpected %<*%> for codimension %d of %d at %C",
 		     ar->codimen + 1, corank);
 	  return MATCH_ERROR;
 	}
@@ -313,7 +313,7 @@ resolve_array_bound (gfc_expr *e, int check_constant)
   if (check_constant && !gfc_is_constant_expr (e))
     {
       if (e->expr_type == EXPR_VARIABLE)
-	gfc_error ("Variable '%s' at %L in this context must be constant",
+	gfc_error ("Variable %qs at %L in this context must be constant",
 		   e->symtree->n.sym->name, &e->where);
       else
 	gfc_error ("Expression at %L in this context must be constant",
@@ -752,7 +752,7 @@ gfc_set_array_spec (gfc_symbol *sym, gfc_array_spec *as, locus *error_loc)
   if ((sym->as->type == AS_ASSUMED_RANK && as->corank)
       || (as->type == AS_ASSUMED_RANK && sym->as->corank))
     {
-      gfc_error ("The assumed-rank array '%s' at %L shall not have a "
+      gfc_error ("The assumed-rank array %qs at %L shall not have a "
 		 "codimension", sym->name, error_loc);
       return false;
     }
@@ -912,7 +912,7 @@ check_duplicate_iterator (gfc_constructor_base base, gfc_symbol *master)
 
       if (c->iterator->var->symtree->n.sym == master)
 	{
-	  gfc_error ("DO-iterator '%s' at %L is inside iterator of the "
+	  gfc_error ("DO-iterator %qs at %L is inside iterator of the "
 		     "same name", master->name, &c->where);
 
 	  return 1;
@@ -1662,7 +1662,7 @@ gfc_expand_constructor (gfc_expr *e, bool fatal)
 	{
 	  gfc_error ("The number of elements in the array constructor "
 		     "at %L requires an increase of the allowed %d "
-		     "upper limit.   See -fmax-array-constructor "
+		     "upper limit.   See %<-fmax-array-constructor%> "
 		     "option", &e->where,
 		     gfc_option.flag_max_array_constructor);
 	  return false;
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index c3f78e1c248..ef40e669f17 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -43,7 +43,7 @@ scalar_check (gfc_expr *e, int n)
   if (e->rank == 0)
     return true;
 
-  gfc_error ("'%s' argument of '%s' intrinsic at %L must be a scalar",
+  gfc_error ("%qs argument of %qs intrinsic at %L must be a scalar",
 	     gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic,
 	     &e->where);
 
@@ -59,7 +59,7 @@ type_check (gfc_expr *e, int n, bt type)
   if (e->ts.type == type)
     return true;
 
-  gfc_error ("'%s' argument of '%s' intrinsic at %L must be %s",
+  gfc_error ("%qs argument of %qs intrinsic at %L must be %s",
 	     gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic,
 	     &e->where, gfc_basic_typename (type));
 
@@ -86,7 +86,7 @@ numeric_check (gfc_expr *e, int n)
       return true;
     }
 
-  gfc_error ("'%s' argument of '%s' intrinsic at %L must be a numeric type",
+  gfc_error ("%qs argument of %qs intrinsic at %L must be a numeric type",
 	     gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic,
 	     &e->where);
 
@@ -101,7 +101,7 @@ int_or_real_check (gfc_expr *e, int n)
 {
   if (e->ts.type != BT_INTEGER && e->ts.type != BT_REAL)
     {
-      gfc_error ("'%s' argument of '%s' intrinsic at %L must be INTEGER "
+      gfc_error ("%qs argument of %qs intrinsic at %L must be INTEGER "
 		 "or REAL", gfc_current_intrinsic_arg[n]->name,
 		 gfc_current_intrinsic, &e->where);
       return false;
@@ -118,7 +118,7 @@ real_or_complex_check (gfc_expr *e, int n)
 {
   if (e->ts.type != BT_REAL && e->ts.type != BT_COMPLEX)
     {
-      gfc_error ("'%s' argument of '%s' intrinsic at %L must be REAL "
+      gfc_error ("%qs argument of %qs intrinsic at %L must be REAL "
 		 "or COMPLEX", gfc_current_intrinsic_arg[n]->name,
 		 gfc_current_intrinsic, &e->where);
       return false;
@@ -135,7 +135,7 @@ int_or_proc_check (gfc_expr *e, int n)
 {
   if (e->ts.type != BT_INTEGER && e->ts.type != BT_PROCEDURE)
     {
-      gfc_error ("'%s' argument of '%s' intrinsic at %L must be INTEGER "
+      gfc_error ("%qs argument of %qs intrinsic at %L must be INTEGER "
 		 "or PROCEDURE", gfc_current_intrinsic_arg[n]->name,
 		 gfc_current_intrinsic, &e->where);
       return false;
@@ -164,7 +164,7 @@ kind_check (gfc_expr *k, int n, bt type)
 
   if (!gfc_check_init_expr (k))
     {
-      gfc_error ("'%s' argument of '%s' intrinsic at %L must be a constant",
+      gfc_error ("%qs argument of %qs intrinsic at %L must be a constant",
 		 gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic,
 		 &k->where);
       return false;
@@ -192,7 +192,7 @@ double_check (gfc_expr *d, int n)
 
   if (d->ts.kind != gfc_default_double_kind)
     {
-      gfc_error ("'%s' argument of '%s' intrinsic at %L must be double "
+      gfc_error ("%qs argument of %qs intrinsic at %L must be double "
 		 "precision", gfc_current_intrinsic_arg[n]->name,
 		 gfc_current_intrinsic, &d->where);
       return false;
@@ -215,7 +215,7 @@ coarray_check (gfc_expr *e, int n)
 
   if (!gfc_is_coarray (e))
     {
-      gfc_error ("Expected coarray variable as '%s' argument to the %s "
+      gfc_error ("Expected coarray variable as %qs argument to the %s "
                  "intrinsic at %L", gfc_current_intrinsic_arg[n]->name,
 		 gfc_current_intrinsic, &e->where);
       return false;
@@ -232,7 +232,7 @@ logical_array_check (gfc_expr *array, int n)
 {
   if (array->ts.type != BT_LOGICAL || array->rank == 0)
     {
-      gfc_error ("'%s' argument of '%s' intrinsic at %L must be a logical "
+      gfc_error ("%qs argument of %qs intrinsic at %L must be a logical "
 		 "array", gfc_current_intrinsic_arg[n]->name,
 		 gfc_current_intrinsic, &array->where);
       return false;
@@ -258,7 +258,7 @@ array_check (gfc_expr *e, int n)
   if (e->rank != 0 && e->ts.type != BT_PROCEDURE)
     return true;
 
-  gfc_error ("'%s' argument of '%s' intrinsic at %L must be an array",
+  gfc_error ("%qs argument of %qs intrinsic at %L must be an array",
 	     gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic,
 	     &e->where);
 
@@ -279,7 +279,7 @@ nonnegative_check (const char *arg, gfc_expr *expr)
       gfc_extract_int (expr, &i);
       if (i < 0)
 	{
-	  gfc_error ("'%s' at %L must be nonnegative", arg, &expr->where);
+	  gfc_error ("%qs at %L must be nonnegative", arg, &expr->where);
 	  return false;
 	}
     }
@@ -311,7 +311,7 @@ less_than_bitsize1 (const char *arg1, gfc_expr *expr1, const char *arg2,
 	  if (i2 > gfc_integer_kinds[i3].bit_size)
 	    {
 	      gfc_error ("The absolute value of SHIFT at %L must be less "
-			 "than or equal to BIT_SIZE('%s')",
+			 "than or equal to BIT_SIZE(%qs)",
 			 &expr2->where, arg1);
 	      return false;
 	    }
@@ -321,8 +321,8 @@ less_than_bitsize1 (const char *arg1, gfc_expr *expr1, const char *arg2,
 	{
 	  if (i2 > gfc_integer_kinds[i3].bit_size)
 	    {
-	      gfc_error ("'%s' at %L must be less than "
-			 "or equal to BIT_SIZE('%s')",
+	      gfc_error ("%qs at %L must be less than "
+			 "or equal to BIT_SIZE(%qs)",
 			 arg2, &expr2->where, arg1);
 	      return false;
 	    }
@@ -331,7 +331,7 @@ less_than_bitsize1 (const char *arg1, gfc_expr *expr1, const char *arg2,
 	{
 	  if (i2 >= gfc_integer_kinds[i3].bit_size)
 	    {
-	      gfc_error ("'%s' at %L must be less than BIT_SIZE('%s')",
+	      gfc_error ("%qs at %L must be less than BIT_SIZE(%qs)",
 			 arg2, &expr2->where, arg1);
 	      return false;
 	    }
@@ -358,7 +358,7 @@ less_than_bitsizekind (const char *arg, gfc_expr *expr, int k)
 
   if (val > gfc_integer_kinds[i].bit_size)
     {
-      gfc_error ("'%s' at %L must be less than or equal to the BIT_SIZE of "
+      gfc_error ("%qs at %L must be less than or equal to the BIT_SIZE of "
 		 "INTEGER(KIND=%d)", arg, &expr->where, k);
       return false;
     }
@@ -385,7 +385,7 @@ less_than_bitsize2 (const char *arg1, gfc_expr *expr1, const char *arg2,
       if (i2 > gfc_integer_kinds[i3].bit_size)
 	{
 	  gfc_error ("'%s + %s' at %L must be less than or equal "
-		     "to BIT_SIZE('%s')",
+		     "to BIT_SIZE(%qs)",
 		     arg2, arg3, &expr2->where, arg1);
 	  return false;
 	}
@@ -402,8 +402,8 @@ same_type_check (gfc_expr *e, int n, gfc_expr *f, int m)
   if (gfc_compare_types (&e->ts, &f->ts))
     return true;
 
-  gfc_error ("'%s' argument of '%s' intrinsic at %L must be the same type "
-	     "and kind as '%s'", gfc_current_intrinsic_arg[m]->name,
+  gfc_error ("%qs argument of %qs intrinsic at %L must be the same type "
+	     "and kind as %qs", gfc_current_intrinsic_arg[m]->name,
 	     gfc_current_intrinsic, &f->where,
 	     gfc_current_intrinsic_arg[n]->name);
 
@@ -419,7 +419,7 @@ rank_check (gfc_expr *e, int n, int rank)
   if (e->rank == rank)
     return true;
 
-  gfc_error ("'%s' argument of '%s' intrinsic at %L must be of rank %d",
+  gfc_error ("%qs argument of %qs intrinsic at %L must be of rank %d",
 	     gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic,
 	     &e->where, rank);
 
@@ -434,7 +434,7 @@ nonoptional_check (gfc_expr *e, int n)
 {
   if (e->expr_type == EXPR_VARIABLE && e->symtree->n.sym->attr.optional)
     {
-      gfc_error ("'%s' argument of '%s' intrinsic at %L must not be OPTIONAL",
+      gfc_error ("%qs argument of %qs intrinsic at %L must not be OPTIONAL",
 		 gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic,
 		 &e->where);
     }
@@ -455,7 +455,7 @@ allocatable_check (gfc_expr *e, int n)
   attr = gfc_variable_attr (e, NULL);
   if (!attr.allocatable || attr.associate_var)
     {
-      gfc_error ("'%s' argument of '%s' intrinsic at %L must be ALLOCATABLE",
+      gfc_error ("%qs argument of %qs intrinsic at %L must be ALLOCATABLE",
 		 gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic,
 		 &e->where);
       return false;
@@ -473,7 +473,7 @@ kind_value_check (gfc_expr *e, int n, int k)
   if (e->ts.kind == k)
     return true;
 
-  gfc_error ("'%s' argument of '%s' intrinsic at %L must be of kind %d",
+  gfc_error ("%qs argument of %qs intrinsic at %L must be of kind %d",
 	     gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic,
 	     &e->where, k);
 
@@ -511,7 +511,7 @@ variable_check (gfc_expr *e, int n, bool allow_proc)
 
       if (!ref)
 	{
-	  gfc_error ("'%s' argument of '%s' intrinsic at %L cannot be "
+	  gfc_error ("%qs argument of %qs intrinsic at %L cannot be "
 		     "INTENT(IN)", gfc_current_intrinsic_arg[n]->name,
 		     gfc_current_intrinsic, &e->where);
 	  return false;
@@ -532,7 +532,7 @@ variable_check (gfc_expr *e, int n, bool allow_proc)
 	  return true;
     }
 
-  gfc_error ("'%s' argument of '%s' intrinsic at %L must be a variable",
+  gfc_error ("%qs argument of %qs intrinsic at %L must be a variable",
 	     gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic, &e->where);
 
   return false;
@@ -581,7 +581,7 @@ dim_corank_check (gfc_expr *dim, gfc_expr *array)
   if (mpz_cmp_ui (dim->value.integer, 1) < 0
       || mpz_cmp_ui (dim->value.integer, corank) > 0)
     {
-      gfc_error ("'dim' argument of '%s' intrinsic at %L is not a valid "
+      gfc_error ("'dim' argument of %qs intrinsic at %L is not a valid "
 		 "codimension index", gfc_current_intrinsic, &dim->where);
 
       return false;
@@ -631,7 +631,7 @@ dim_rank_check (gfc_expr *dim, gfc_expr *array, int allow_assumed)
   if (mpz_cmp_ui (dim->value.integer, 1) < 0
       || mpz_cmp_ui (dim->value.integer, rank) > 0)
     {
-      gfc_error ("'dim' argument of '%s' intrinsic at %L is not a valid "
+      gfc_error ("'dim' argument of %qs intrinsic at %L is not a valid "
 		 "dimension index", gfc_current_intrinsic, &dim->where);
 
       return false;
@@ -856,7 +856,7 @@ gfc_check_a_p (gfc_expr *a, gfc_expr *p)
 
   if (a->ts.type != p->ts.type)
     {
-      gfc_error ("'%s' and '%s' arguments of '%s' intrinsic at %L must "
+      gfc_error ("%qs and %qs arguments of %qs intrinsic at %L must "
 		 "have the same type", gfc_current_intrinsic_arg[0]->name,
 		 gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic,
 		 &p->where);
@@ -901,7 +901,7 @@ gfc_check_associated (gfc_expr *pointer, gfc_expr *target)
 
   if (!attr1.pointer && !attr1.proc_pointer)
     {
-      gfc_error ("'%s' argument of '%s' intrinsic at %L must be a POINTER",
+      gfc_error ("%qs argument of %qs intrinsic at %L must be a POINTER",
 		 gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic,
 		 &pointer->where);
       return false;
@@ -910,7 +910,7 @@ gfc_check_associated (gfc_expr *pointer, gfc_expr *target)
   /* F2008, C1242.  */
   if (attr1.pointer && gfc_is_coindexed (pointer))
     {
-      gfc_error ("'%s' argument of '%s' intrinsic at %L shall not be "
+      gfc_error ("%qs argument of %qs intrinsic at %L shall not be "
 		 "coindexed", gfc_current_intrinsic_arg[0]->name,
 		 gfc_current_intrinsic, &pointer->where);
       return false;
@@ -928,7 +928,7 @@ gfc_check_associated (gfc_expr *pointer, gfc_expr *target)
     attr2 = gfc_expr_attr (target);
   else
     {
-      gfc_error ("'%s' argument of '%s' intrinsic at %L must be a pointer "
+      gfc_error ("%qs argument of %qs intrinsic at %L must be a pointer "
 		 "or target VARIABLE or FUNCTION",
 		 gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic,
 		 &target->where);
@@ -937,7 +937,7 @@ gfc_check_associated (gfc_expr *pointer, gfc_expr *target)
 
   if (attr1.pointer && !attr2.pointer && !attr2.target)
     {
-      gfc_error ("'%s' argument of '%s' intrinsic at %L must be a POINTER "
+      gfc_error ("%qs argument of %qs intrinsic at %L must be a POINTER "
 		 "or a TARGET", gfc_current_intrinsic_arg[1]->name,
 		 gfc_current_intrinsic, &target->where);
       return false;
@@ -946,7 +946,7 @@ gfc_check_associated (gfc_expr *pointer, gfc_expr *target)
   /* F2008, C1242.  */
   if (attr1.pointer && gfc_is_coindexed (target))
     {
-      gfc_error ("'%s' argument of '%s' intrinsic at %L shall not be "
+      gfc_error ("%qs argument of %qs intrinsic at %L shall not be "
 		 "coindexed", gfc_current_intrinsic_arg[1]->name,
 		 gfc_current_intrinsic, &target->where);
       return false;
@@ -974,7 +974,7 @@ gfc_check_associated (gfc_expr *pointer, gfc_expr *target)
 null_arg:
 
   gfc_error ("NULL pointer at %L is not permitted as actual argument "
-	     "of '%s' intrinsic function", where, gfc_current_intrinsic);
+	     "of %qs intrinsic function", where, gfc_current_intrinsic);
   return false;
 
 }
@@ -1031,7 +1031,7 @@ gfc_check_atomic (gfc_expr *atom, int atom_no, gfc_expr *value, int val_no,
 
   if (atom->ts.type != value->ts.type)
     {
-      gfc_error ("'%s' argument of '%s' intrinsic at %L shall have the same "
+      gfc_error_1 ("'%s' argument of '%s' intrinsic at %L shall have the same "
 		 "type as '%s' at %L", gfc_current_intrinsic_arg[val_no]->name,
 		 gfc_current_intrinsic, &value->where,
 		 gfc_current_intrinsic_arg[atom_no]->name, &atom->where);
@@ -1377,7 +1377,7 @@ gfc_check_cmplx (gfc_expr *x, gfc_expr *y, gfc_expr *kind)
 
       if (x->ts.type == BT_COMPLEX)
 	{
-	  gfc_error ("'%s' argument of '%s' intrinsic at %L must not be "
+	  gfc_error ("%qs argument of %qs intrinsic at %L must not be "
 		     "present if 'x' is COMPLEX",
 		     gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic,
 		     &y->where);
@@ -1386,7 +1386,7 @@ gfc_check_cmplx (gfc_expr *x, gfc_expr *y, gfc_expr *kind)
 
       if (y->ts.type == BT_COMPLEX)
 	{
-	  gfc_error ("'%s' argument of '%s' intrinsic at %L must have a type "
+	  gfc_error ("%qs argument of %qs intrinsic at %L must have a type "
 		     "of either REAL or INTEGER",
 		     gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic,
 		     &y->where);
@@ -1575,7 +1575,7 @@ gfc_check_co_reduce (gfc_expr *a, gfc_expr *op, gfc_expr *result_image,
 
   if (!gfc_compare_types (&a->ts, &sym->result->ts))
     {
-      gfc_error ("A argument at %L has type %s but the function passed as "
+      gfc_error_1 ("A argument at %L has type %s but the function passed as "
 		 "OPERATOR at %L returns %s",
 		 &a->where, gfc_typename (&a->ts), &op->where,
 		 gfc_typename (&sym->result->ts));
@@ -1655,16 +1655,16 @@ gfc_check_co_reduce (gfc_expr *a, gfc_expr *op, gfc_expr *result_image,
 	  && ((formal_size1 && actual_size != formal_size1)
 	       || (formal_size2 && actual_size != formal_size2)))
 	{
-	  gfc_error ("The character length of the A argument at %L and of the "
-		     "arguments of the OPERATOR at %L shall be the same",
+	  gfc_error_1 ("The character length of the A argument at %L and of the "
+		       "arguments of the OPERATOR at %L shall be the same",
 		     &a->where, &op->where);
 	  return false;
 	}
       if (actual_size && result_size && actual_size != result_size)
 	{
-	  gfc_error ("The character length of the A argument at %L and of the "
-		     "function result of the OPERATOR at %L shall be the same",
-		     &a->where, &op->where);
+	  gfc_error_1 ("The character length of the A argument at %L and of the "
+		       "function result of the OPERATOR at %L shall be the same",
+		       &a->where, &op->where);
 	  return false;
 	}
     }
@@ -1680,10 +1680,10 @@ gfc_check_co_minmax (gfc_expr *a, gfc_expr *result_image, gfc_expr *stat,
   if (a->ts.type != BT_INTEGER && a->ts.type != BT_REAL
       && a->ts.type != BT_CHARACTER)
     {
-       gfc_error ("'%s' argument of '%s' intrinsic at %L shall be of type "
-		  "integer, real or character",
-		  gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic,
-		  &a->where);
+       gfc_error_1 ("'%s' argument of '%s' intrinsic at %L shall be of type "
+		    "integer, real or character",
+		    gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic,
+		    &a->where);
        return false;
     }
   return check_co_collective (a, result_image, stat, errmsg, false);
@@ -1775,7 +1775,7 @@ gfc_check_cshift (gfc_expr *array, gfc_expr *shift, gfc_expr *dim)
 	      {
 		if (!identical_dimen_shape (array, i, shift, j))
 		  {
-		    gfc_error ("'%s' argument of '%s' intrinsic at %L has "
+		    gfc_error ("%qs argument of %qs intrinsic at %L has "
 			       "invalid shape in dimension %d (%ld/%ld)",
 			       gfc_current_intrinsic_arg[1]->name,
 			       gfc_current_intrinsic, &shift->where, i + 1,
@@ -1790,7 +1790,7 @@ gfc_check_cshift (gfc_expr *array, gfc_expr *shift, gfc_expr *dim)
     }
   else
     {
-      gfc_error ("'%s' argument of intrinsic '%s' at %L of must have rank "
+      gfc_error ("%qs argument of intrinsic %qs at %L of must have rank "
 		 "%d or be a scalar", gfc_current_intrinsic_arg[1]->name,
 		 gfc_current_intrinsic, &shift->where, array->rank - 1);
       return false;
@@ -1834,7 +1834,7 @@ gfc_check_dcmplx (gfc_expr *x, gfc_expr *y)
 
       if (x->ts.type == BT_COMPLEX)
 	{
-	  gfc_error ("'%s' argument of '%s' intrinsic at %L must not be "
+	  gfc_error ("%qs argument of %qs intrinsic at %L must not be "
 		     "present if 'x' is COMPLEX",
 		     gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic,
 		     &y->where);
@@ -1843,7 +1843,7 @@ gfc_check_dcmplx (gfc_expr *x, gfc_expr *y)
 
       if (y->ts.type == BT_COMPLEX)
 	{
-	  gfc_error ("'%s' argument of '%s' intrinsic at %L must have a type "
+	  gfc_error ("%qs argument of %qs intrinsic at %L must have a type "
 		     "of either REAL or INTEGER",
 		     gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic,
 		     &y->where);
@@ -1893,7 +1893,7 @@ gfc_check_dot_product (gfc_expr *vector_a, gfc_expr *vector_b)
       break;
 
     default:
-      gfc_error ("'%s' argument of '%s' intrinsic at %L must be numeric "
+      gfc_error ("%qs argument of %qs intrinsic at %L must be numeric "
 		 "or LOGICAL", gfc_current_intrinsic_arg[0]->name,
 		 gfc_current_intrinsic, &vector_a->where);
       return false;
@@ -1907,7 +1907,7 @@ gfc_check_dot_product (gfc_expr *vector_a, gfc_expr *vector_b)
 
   if (! identical_dimen_shape (vector_a, 0, vector_b, 0))
     {
-      gfc_error ("Different shape for arguments '%s' and '%s' at %L for "
+      gfc_error ("Different shape for arguments %qs and %qs at %L for "
 		 "intrinsic 'dot_product'", gfc_current_intrinsic_arg[0]->name,
 		 gfc_current_intrinsic_arg[1]->name, &vector_a->where);
       return false;
@@ -1926,7 +1926,7 @@ gfc_check_dprod (gfc_expr *x, gfc_expr *y)
 
   if (x->ts.kind != gfc_default_real_kind)
     {
-      gfc_error ("'%s' argument of '%s' intrinsic at %L must be default "
+      gfc_error ("%qs argument of %qs intrinsic at %L must be default "
 		 "real", gfc_current_intrinsic_arg[0]->name,
 		 gfc_current_intrinsic, &x->where);
       return false;
@@ -1934,7 +1934,7 @@ gfc_check_dprod (gfc_expr *x, gfc_expr *y)
 
   if (y->ts.kind != gfc_default_real_kind)
     {
-      gfc_error ("'%s' argument of '%s' intrinsic at %L must be default "
+      gfc_error ("%qs argument of %qs intrinsic at %L must be default "
 		 "real", gfc_current_intrinsic_arg[1]->name,
 		 gfc_current_intrinsic, &y->where);
       return false;
@@ -1955,8 +1955,8 @@ gfc_check_dshift (gfc_expr *i, gfc_expr *j, gfc_expr *shift)
 
   if (i->is_boz && j->is_boz)
     {
-      gfc_error ("'I' at %L and 'J' at %L cannot both be BOZ literal "
-		 "constants", &i->where, &j->where);
+      gfc_error_1 ("'I' at %L and 'J' at %L cannot both be BOZ literal "
+		   "constants", &i->where, &j->where);
       return false;
     }
 
@@ -2025,7 +2025,7 @@ gfc_check_eoshift (gfc_expr *array, gfc_expr *shift, gfc_expr *boundary,
 	      {
 		if (!identical_dimen_shape (array, i, shift, j))
 		  {
-		    gfc_error ("'%s' argument of '%s' intrinsic at %L has "
+		    gfc_error ("%qs argument of %qs intrinsic at %L has "
 			       "invalid shape in dimension %d (%ld/%ld)",
 			       gfc_current_intrinsic_arg[1]->name,
 			       gfc_current_intrinsic, &shift->where, i + 1,
@@ -2040,7 +2040,7 @@ gfc_check_eoshift (gfc_expr *array, gfc_expr *shift, gfc_expr *boundary,
     }
   else
     {
-      gfc_error ("'%s' argument of intrinsic '%s' at %L of must have rank "
+      gfc_error ("%qs argument of intrinsic %qs at %L of must have rank "
 		 "%d or be a scalar", gfc_current_intrinsic_arg[1]->name,
 		 gfc_current_intrinsic, &shift->where, array->rank - 1);
       return false;
@@ -2068,7 +2068,7 @@ gfc_check_eoshift (gfc_expr *array, gfc_expr *shift, gfc_expr *boundary,
 	}
       else
 	{
-	  gfc_error ("'%s' argument of intrinsic '%s' at %L of must have "
+	  gfc_error ("%qs argument of intrinsic %qs at %L of must have "
 		     "rank %d or be a scalar",
 		     gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic,
 		     &shift->where, array->rank - 1);
@@ -2369,8 +2369,8 @@ gfc_check_index (gfc_expr *string, gfc_expr *substring, gfc_expr *back,
 
   if (string->ts.kind != substring->ts.kind)
     {
-      gfc_error ("'%s' argument of '%s' intrinsic at %L must be the same "
-		 "kind as '%s'", gfc_current_intrinsic_arg[1]->name,
+      gfc_error ("%qs argument of %qs intrinsic at %L must be the same "
+		 "kind as %qs", gfc_current_intrinsic_arg[1]->name,
 		 gfc_current_intrinsic, &substring->where,
 		 gfc_current_intrinsic_arg[0]->name);
       return false;
@@ -2471,9 +2471,9 @@ gfc_check_ishftc (gfc_expr *i, gfc_expr *shift, gfc_expr *size)
 
 	      if (i2 > i3)
 		{
-		  gfc_error ("The absolute value of SHIFT at %L must be less "
-			     "than or equal to SIZE at %L", &shift->where,
-			     &size->where);
+		  gfc_error_1 ("The absolute value of SHIFT at %L must be less "
+			       "than or equal to SIZE at %L", &shift->where,
+			       &size->where);
 		  return false;
 		}
 	     }
@@ -2532,7 +2532,7 @@ gfc_check_kind (gfc_expr *x)
 {
   if (x->ts.type == BT_DERIVED)
     {
-      gfc_error ("'%s' argument of '%s' intrinsic at %L must be a "
+      gfc_error ("%qs argument of %qs intrinsic at %L must be a "
 		 "non-derived type", gfc_current_intrinsic_arg[0]->name,
 		 gfc_current_intrinsic, &x->where);
       return false;
@@ -2743,7 +2743,7 @@ min_max_args (gfc_actual_arglist *args)
 
   if (args == NULL || args->next == NULL)
     {
-      gfc_error ("Intrinsic '%s' at %L must have at least two arguments",
+      gfc_error ("Intrinsic %qs at %L must have at least two arguments",
 		 gfc_current_intrinsic, gfc_current_intrinsic_where);
       return false;
     }
@@ -2791,7 +2791,7 @@ min_max_args (gfc_actual_arglist *args)
 
   if (!a1 || !a2)
     {
-      gfc_error ("Missing '%s' argument to the %s intrinsic at %L",
+      gfc_error ("Missing %qs argument to the %s intrinsic at %L",
 	         !a1 ? "a1" : "a2", gfc_current_intrinsic,
 		 gfc_current_intrinsic_where);
       return false;
@@ -2806,12 +2806,12 @@ min_max_args (gfc_actual_arglist *args)
   return true;
 
 duplicate:
-  gfc_error ("Duplicate argument '%s' at %L to intrinsic %s", arg->name,
+  gfc_error ("Duplicate argument %qs at %L to intrinsic %s", arg->name,
 	     &arg->expr->where, gfc_current_intrinsic);
   return false;
 
 unknown:
-  gfc_error ("Unknown argument '%s' at %L to intrinsic %s", arg->name,
+  gfc_error ("Unknown argument %qs at %L to intrinsic %s", arg->name,
 	     &arg->expr->where, gfc_current_intrinsic);
   return false;
 }
@@ -2840,7 +2840,7 @@ check_rest (bt type, int kind, gfc_actual_arglist *arglist)
 	    }
 	  else
 	    {
-	      gfc_error ("'a%d' argument of '%s' intrinsic at %L must be "
+	      gfc_error ("'a%d' argument of %qs intrinsic at %L must be "
 			 "%s(%d)", n, gfc_current_intrinsic, &x->where,
 			 gfc_basic_typename (type), kind);
 	      return false;
@@ -2878,7 +2878,7 @@ gfc_check_min_max (gfc_actual_arglist *arg)
     }
   else if (x->ts.type != BT_INTEGER && x->ts.type != BT_REAL)
     {
-      gfc_error ("'a1' argument of '%s' intrinsic at %L must be INTEGER, "
+      gfc_error ("'a1' argument of %qs intrinsic at %L must be INTEGER, "
 		 "REAL or CHARACTER", gfc_current_intrinsic, &x->where);
       return false;
     }
@@ -2928,7 +2928,7 @@ gfc_check_matmul (gfc_expr *matrix_a, gfc_expr *matrix_b)
 {
   if ((matrix_a->ts.type != BT_LOGICAL) && !gfc_numeric_ts (&matrix_a->ts))
     {
-      gfc_error ("'%s' argument of '%s' intrinsic at %L must be numeric "
+      gfc_error ("%qs argument of %qs intrinsic at %L must be numeric "
 		 "or LOGICAL", gfc_current_intrinsic_arg[0]->name,
 		 gfc_current_intrinsic, &matrix_a->where);
       return false;
@@ -2936,7 +2936,7 @@ gfc_check_matmul (gfc_expr *matrix_a, gfc_expr *matrix_b)
 
   if ((matrix_b->ts.type != BT_LOGICAL) && !gfc_numeric_ts (&matrix_b->ts))
     {
-      gfc_error ("'%s' argument of '%s' intrinsic at %L must be numeric "
+      gfc_error ("%qs argument of %qs intrinsic at %L must be numeric "
 		 "or LOGICAL", gfc_current_intrinsic_arg[1]->name,
 		 gfc_current_intrinsic, &matrix_b->where);
       return false;
@@ -2945,7 +2945,7 @@ gfc_check_matmul (gfc_expr *matrix_a, gfc_expr *matrix_b)
   if ((matrix_a->ts.type == BT_LOGICAL && gfc_numeric_ts (&matrix_b->ts))
       || (gfc_numeric_ts (&matrix_a->ts) && matrix_b->ts.type == BT_LOGICAL))
     {
-      gfc_error ("Argument types of '%s' intrinsic at %L must match (%s/%s)",
+      gfc_error ("Argument types of %qs intrinsic at %L must match (%s/%s)",
 		 gfc_current_intrinsic, &matrix_a->where,
 		 gfc_typename(&matrix_a->ts), gfc_typename(&matrix_b->ts));
        return false;
@@ -2959,8 +2959,8 @@ gfc_check_matmul (gfc_expr *matrix_a, gfc_expr *matrix_b)
       /* Check for case matrix_a has shape(m), matrix_b has shape (m, k).  */
       if (!identical_dimen_shape (matrix_a, 0, matrix_b, 0))
 	{
-	  gfc_error ("Different shape on dimension 1 for arguments '%s' "
-		     "and '%s' at %L for intrinsic matmul",
+	  gfc_error ("Different shape on dimension 1 for arguments %qs "
+		     "and %qs at %L for intrinsic matmul",
 		     gfc_current_intrinsic_arg[0]->name,
 		     gfc_current_intrinsic_arg[1]->name, &matrix_a->where);
 	  return false;
@@ -2978,8 +2978,8 @@ gfc_check_matmul (gfc_expr *matrix_a, gfc_expr *matrix_b)
 	 - matrix_a has shape (n,m) and matrix_b has shape (m).  */
       if (!identical_dimen_shape (matrix_a, 1, matrix_b, 0))
 	{
-	  gfc_error ("Different shape on dimension 2 for argument '%s' and "
-		     "dimension 1 for argument '%s' at %L for intrinsic "
+	  gfc_error ("Different shape on dimension 2 for argument %qs and "
+		     "dimension 1 for argument %qs at %L for intrinsic "
 		     "matmul", gfc_current_intrinsic_arg[0]->name,
 		     gfc_current_intrinsic_arg[1]->name, &matrix_a->where);
 	  return false;
@@ -2987,7 +2987,7 @@ gfc_check_matmul (gfc_expr *matrix_a, gfc_expr *matrix_b)
       break;
 
     default:
-      gfc_error ("'%s' argument of '%s' intrinsic at %L must be of rank "
+      gfc_error ("%qs argument of %qs intrinsic at %L must be of rank "
 		 "1 or 2", gfc_current_intrinsic_arg[0]->name,
 		 gfc_current_intrinsic, &matrix_a->where);
       return false;
@@ -3162,7 +3162,7 @@ gfc_check_transf_bit_intrins (gfc_actual_arglist *ap)
 {
   if (ap->expr->ts.type != BT_INTEGER)
     {
-      gfc_error ("'%s' argument of '%s' intrinsic at %L must be INTEGER",
+      gfc_error ("%qs argument of %qs intrinsic at %L must be INTEGER",
                  gfc_current_intrinsic_arg[0]->name,
                  gfc_current_intrinsic, &ap->expr->where);
       return false;
@@ -3337,7 +3337,7 @@ gfc_check_null (gfc_expr *mold)
 
   if (!attr.pointer && !attr.proc_pointer && !attr.allocatable)
     {
-      gfc_error ("'%s' argument of '%s' intrinsic at %L must be a POINTER, "
+      gfc_error ("%qs argument of %qs intrinsic at %L must be a POINTER, "
 		 "ALLOCATABLE or procedure pointer",
 		 gfc_current_intrinsic_arg[0]->name,
 		 gfc_current_intrinsic, &mold->where);
@@ -3352,7 +3352,7 @@ gfc_check_null (gfc_expr *mold)
   /* F2008, C1242.  */
   if (gfc_is_coindexed (mold))
     {
-      gfc_error ("'%s' argument of '%s' intrinsic at %L shall not be "
+      gfc_error ("%qs argument of %qs intrinsic at %L shall not be "
 		 "coindexed", gfc_current_intrinsic_arg[0]->name,
 		 gfc_current_intrinsic, &mold->where);
       return false;
@@ -3424,9 +3424,9 @@ gfc_check_pack (gfc_expr *array, gfc_expr *mask, gfc_expr *vector)
 
 	  if (mpz_get_si (vector_size) < mask_true_values)
 	    {
-	      gfc_error ("'%s' argument of '%s' intrinsic at %L must "
+	      gfc_error ("%qs argument of %qs intrinsic at %L must "
 			 "provide at least as many elements as there "
-			 "are .TRUE. values in '%s' (%ld/%d)",
+			 "are .TRUE. values in %qs (%ld/%d)",
 			 gfc_current_intrinsic_arg[2]->name,
 			 gfc_current_intrinsic, &vector->where,
 			 gfc_current_intrinsic_arg[1]->name,
@@ -3482,7 +3482,7 @@ gfc_check_present (gfc_expr *a)
   sym = a->symtree->n.sym;
   if (!sym->attr.dummy)
     {
-      gfc_error ("'%s' argument of '%s' intrinsic at %L must be of a "
+      gfc_error ("%qs argument of %qs intrinsic at %L must be of a "
 		 "dummy variable", gfc_current_intrinsic_arg[0]->name,
 		 gfc_current_intrinsic, &a->where);
       return false;
@@ -3490,7 +3490,7 @@ gfc_check_present (gfc_expr *a)
 
   if (!sym->attr.optional)
     {
-      gfc_error ("'%s' argument of '%s' intrinsic at %L must be of "
+      gfc_error ("%qs argument of %qs intrinsic at %L must be of "
 		 "an OPTIONAL dummy variable",
 		 gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic,
 		 &a->where);
@@ -3509,8 +3509,8 @@ gfc_check_present (gfc_expr *a)
 	       || (a->ref->u.ar.type == AR_ELEMENT
 		   && a->ref->u.ar.as->rank == 0))))
     {
-      gfc_error ("'%s' argument of '%s' intrinsic at %L must not be a "
-		 "subobject of '%s'", gfc_current_intrinsic_arg[0]->name,
+      gfc_error ("%qs argument of %qs intrinsic at %L must not be a "
+		 "subobject of %qs", gfc_current_intrinsic_arg[0]->name,
 		 gfc_current_intrinsic, &a->where, sym->name);
       return false;
     }
@@ -3671,7 +3671,7 @@ gfc_check_reshape (gfc_expr *source, gfc_expr *shape,
 
   if (shape_size <= 0)
     {
-      gfc_error ("'%s' argument of '%s' intrinsic at %L is empty",
+      gfc_error ("%qs argument of %qs intrinsic at %L is empty",
 		 gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic,
 		 &shape->where);
       return false;
@@ -3695,7 +3695,7 @@ gfc_check_reshape (gfc_expr *source, gfc_expr *shape,
 	  gfc_extract_int (e, &extent);
 	  if (extent < 0)
 	    {
-	      gfc_error ("'%s' argument of '%s' intrinsic at %L has "
+	      gfc_error ("%qs argument of %qs intrinsic at %L has "
 			 "negative element (%d)",
 			 gfc_current_intrinsic_arg[1]->name,
 			 gfc_current_intrinsic, &e->where, extent);
@@ -3735,7 +3735,7 @@ gfc_check_reshape (gfc_expr *source, gfc_expr *shape,
 
 	  if (order_size != shape_size)
 	    {
-	      gfc_error ("'%s' argument of '%s' intrinsic at %L "
+	      gfc_error ("%qs argument of %qs intrinsic at %L "
 			 "has wrong number of elements (%d/%d)",
 			 gfc_current_intrinsic_arg[3]->name,
 			 gfc_current_intrinsic, &order->where,
@@ -3753,7 +3753,7 @@ gfc_check_reshape (gfc_expr *source, gfc_expr *shape,
 
 	      if (dim < 1 || dim > order_size)
 		{
-		  gfc_error ("'%s' argument of '%s' intrinsic at %L "
+		  gfc_error ("%qs argument of %qs intrinsic at %L "
 			     "has out-of-range dimension (%d)",
 			     gfc_current_intrinsic_arg[3]->name,
 			     gfc_current_intrinsic, &e->where, dim);
@@ -3762,7 +3762,7 @@ gfc_check_reshape (gfc_expr *source, gfc_expr *shape,
 
 	      if (perm[dim-1] != 0)
 		{
-		  gfc_error ("'%s' argument of '%s' intrinsic at %L has "
+		  gfc_error ("%qs argument of %qs intrinsic at %L has "
 			     "invalid permutation of dimensions (dimension "
 			     "'%d' duplicated)",
 			     gfc_current_intrinsic_arg[3]->name,
@@ -3815,7 +3815,7 @@ gfc_check_same_type_as (gfc_expr *a, gfc_expr *b)
 {
   if (a->ts.type != BT_DERIVED && a->ts.type != BT_CLASS)
     {
-        gfc_error ("'%s' argument of '%s' intrinsic at %L "
+        gfc_error ("%qs argument of %qs intrinsic at %L "
 		   "cannot be of type %s",
 		   gfc_current_intrinsic_arg[0]->name,
 		   gfc_current_intrinsic,
@@ -3825,7 +3825,7 @@ gfc_check_same_type_as (gfc_expr *a, gfc_expr *b)
 
   if (!(gfc_type_is_extensible (a->ts.u.derived) || UNLIMITED_POLY (a)))
     {
-      gfc_error ("'%s' argument of '%s' intrinsic at %L "
+      gfc_error ("%qs argument of %qs intrinsic at %L "
 		 "must be of an extensible type",
 		 gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic,
 		 &a->where);
@@ -3834,7 +3834,7 @@ gfc_check_same_type_as (gfc_expr *a, gfc_expr *b)
 
   if (b->ts.type != BT_DERIVED && b->ts.type != BT_CLASS)
     {
-        gfc_error ("'%s' argument of '%s' intrinsic at %L "
+        gfc_error ("%qs argument of %qs intrinsic at %L "
 		   "cannot be of type %s",
 		   gfc_current_intrinsic_arg[0]->name,
 		   gfc_current_intrinsic,
@@ -3844,7 +3844,7 @@ gfc_check_same_type_as (gfc_expr *a, gfc_expr *b)
 
   if (!(gfc_type_is_extensible (b->ts.u.derived) || UNLIMITED_POLY (b)))
     {
-      gfc_error ("'%s' argument of '%s' intrinsic at %L "
+      gfc_error ("%qs argument of %qs intrinsic at %L "
 		 "must be of an extensible type",
 		 gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic,
 		 &b->where);
@@ -4086,7 +4086,7 @@ gfc_check_sizeof (gfc_expr *arg)
 {
   if (arg->ts.type == BT_PROCEDURE)
     {
-      gfc_error ("'%s' argument of '%s' intrinsic at %L shall not be a procedure",
+      gfc_error ("%qs argument of %qs intrinsic at %L shall not be a procedure",
 		 gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic,
 		 &arg->where);
       return false;
@@ -4099,7 +4099,7 @@ gfc_check_sizeof (gfc_expr *arg)
 	      && arg->symtree->n.sym->as->type != AS_DEFERRED
 	      && arg->symtree->n.sym->as->type != AS_ASSUMED_RANK)))
     {
-      gfc_error ("'%s' argument of '%s' intrinsic at %L shall not be TYPE(*)",
+      gfc_error ("%qs argument of %qs intrinsic at %L shall not be TYPE(*)",
 		 gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic,
 		 &arg->where);
       return false;
@@ -4110,7 +4110,7 @@ gfc_check_sizeof (gfc_expr *arg)
       && arg->symtree->n.sym->as->type == AS_ASSUMED_SIZE && arg->ref
       && arg->ref->type == REF_ARRAY && arg->ref->u.ar.type == AR_FULL)
     {
-      gfc_error ("'%s' argument of '%s' intrinsic at %L shall not be an "
+      gfc_error ("%qs argument of %qs intrinsic at %L shall not be an "
 		 "assumed-size array", gfc_current_intrinsic_arg[0]->name,
 		 gfc_current_intrinsic, &arg->where);
       return false;
@@ -4229,7 +4229,7 @@ gfc_check_c_sizeof (gfc_expr *arg)
 
   if (!is_c_interoperable (arg, &msg, false, false))
     {
-      gfc_error ("'%s' argument of '%s' intrinsic at %L must be an "
+      gfc_error ("%qs argument of %qs intrinsic at %L must be an "
 		 "interoperable data entity: %s",
 		 gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic,
 		 &arg->where, msg);
@@ -4238,7 +4238,7 @@ gfc_check_c_sizeof (gfc_expr *arg)
 
   if (arg->ts.type == BT_ASSUMED)
     {
-      gfc_error ("'%s' argument of '%s' intrinsic at %L shall not be "
+      gfc_error ("%qs argument of %qs intrinsic at %L shall not be "
 		 "TYPE(*)",
 		 gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic,
 		 &arg->where);
@@ -4250,7 +4250,7 @@ gfc_check_c_sizeof (gfc_expr *arg)
       && arg->symtree->n.sym->as->type == AS_ASSUMED_SIZE && arg->ref
       && arg->ref->type == REF_ARRAY && arg->ref->u.ar.type == AR_FULL)
     {
-      gfc_error ("'%s' argument of '%s' intrinsic at %L shall not be an "
+      gfc_error ("%qs argument of %qs intrinsic at %L shall not be an "
 		 "assumed-size array", gfc_current_intrinsic_arg[0]->name,
 		 gfc_current_intrinsic, &arg->where);
       return false;
@@ -4449,7 +4449,7 @@ gfc_check_c_funloc (gfc_expr *x)
       for (ns = gfc_current_ns; ns; ns = ns->parent)
 	if (x->symtree->n.sym == ns->proc_name)
 	  {
-	    gfc_error ("Function result '%s' at %L is invalid as X argument "
+	    gfc_error ("Function result %qs at %L is invalid as X argument "
 		       "to C_FUNLOC", x->symtree->n.sym->name, &x->where);
 	    return false;
 	  }
@@ -4575,7 +4575,7 @@ gfc_check_spread (gfc_expr *source, gfc_expr *dim, gfc_expr *ncopies)
 {
   if (source->rank >= GFC_MAX_DIMENSIONS)
     {
-      gfc_error ("'%s' argument of '%s' intrinsic at %L must be less "
+      gfc_error ("%qs argument of %qs intrinsic at %L must be less "
 		 "than rank %d", gfc_current_intrinsic_arg[0]->name,
 		 gfc_current_intrinsic, &source->where, GFC_MAX_DIMENSIONS);
 
@@ -4594,7 +4594,7 @@ gfc_check_spread (gfc_expr *source, gfc_expr *dim, gfc_expr *ncopies)
       && (mpz_cmp_ui (dim->value.integer, 1) < 0
 	  || mpz_cmp_ui (dim->value.integer, source->rank + 1) > 0))
     {
-      gfc_error ("'%s' argument of '%s' intrinsic at %L is not a valid "
+      gfc_error ("%qs argument of %qs intrinsic at %L is not a valid "
 		 "dimension index", gfc_current_intrinsic_arg[1]->name,
 		 gfc_current_intrinsic, &dim->where);
       return false;
@@ -5189,9 +5189,9 @@ gfc_check_unpack (gfc_expr *vector, gfc_expr *mask, gfc_expr *field)
 
       if (mpz_get_si (vector_size) < mask_true_count)
 	{
-	  gfc_error ("'%s' argument of '%s' intrinsic at %L must "
+	  gfc_error ("%qs argument of %qs intrinsic at %L must "
 		     "provide at least as many elements as there "
-		     "are .TRUE. values in '%s' (%ld/%d)",
+		     "are .TRUE. values in %qs (%ld/%d)",
 		     gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic,
 		     &vector->where, gfc_current_intrinsic_arg[1]->name,
 		     mpz_get_si (vector_size), mask_true_count);
@@ -5203,8 +5203,8 @@ gfc_check_unpack (gfc_expr *vector, gfc_expr *mask, gfc_expr *field)
 
   if (mask->rank != field->rank && field->rank != 0)
     {
-      gfc_error ("'%s' argument of '%s' intrinsic at %L must have "
-		 "the same rank as '%s' or be a scalar",
+      gfc_error ("%qs argument of %qs intrinsic at %L must have "
+		 "the same rank as %qs or be a scalar",
 		 gfc_current_intrinsic_arg[2]->name, gfc_current_intrinsic,
 		 &field->where, gfc_current_intrinsic_arg[1]->name);
       return false;
@@ -5216,7 +5216,7 @@ gfc_check_unpack (gfc_expr *vector, gfc_expr *mask, gfc_expr *field)
       for (i = 0; i < field->rank; i++)
 	if (! identical_dimen_shape (mask, i, field, i))
 	{
-	  gfc_error ("'%s' and '%s' arguments of '%s' intrinsic at %L "
+	  gfc_error ("%qs and %qs arguments of %qs intrinsic at %L "
 		     "must have identical shape.",
 		     gfc_current_intrinsic_arg[2]->name,
 		     gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic,
@@ -5474,7 +5474,7 @@ gfc_check_random_seed (gfc_expr *size, gfc_expr *put, gfc_expr *get)
 
       if (gfc_array_size (put, &put_size)
 	  && mpz_get_ui (put_size) < kiss_size)
-	gfc_error ("Size of '%s' argument of '%s' intrinsic at %L "
+	gfc_error ("Size of %qs argument of %qs intrinsic at %L "
 		   "too small (%i/%i)",
 		   gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic,
 		   where, (int) mpz_get_ui (put_size), kiss_size);
@@ -5506,7 +5506,7 @@ gfc_check_random_seed (gfc_expr *size, gfc_expr *put, gfc_expr *get)
 
        if (gfc_array_size (get, &get_size)
  	  && mpz_get_ui (get_size) < kiss_size)
-	gfc_error ("Size of '%s' argument of '%s' intrinsic at %L "
+	gfc_error ("Size of %qs argument of %qs intrinsic at %L "
 		   "too small (%i/%i)",
 		   gfc_current_intrinsic_arg[2]->name, gfc_current_intrinsic,
 		   where, (int) mpz_get_ui (get_size), kiss_size);
@@ -5817,7 +5817,7 @@ gfc_check_getarg (gfc_expr *pos, gfc_expr *value)
 
   if (pos->ts.kind > gfc_default_integer_kind)
     {
-      gfc_error ("'%s' argument of '%s' intrinsic at %L must be of a kind "
+      gfc_error ("%qs argument of %qs intrinsic at %L must be of a kind "
 		 "not wider than the default kind (%d)",
 		 gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic,
 		 &pos->where, gfc_default_integer_kind);
@@ -6169,7 +6169,7 @@ gfc_check_and (gfc_expr *i, gfc_expr *j)
 {
   if (i->ts.type != BT_INTEGER && i->ts.type != BT_LOGICAL)
     {
-      gfc_error ("'%s' argument of '%s' intrinsic at %L must be INTEGER "
+      gfc_error ("%qs argument of %qs intrinsic at %L must be INTEGER "
 		 "or LOGICAL", gfc_current_intrinsic_arg[0]->name,
 		 gfc_current_intrinsic, &i->where);
       return false;
@@ -6177,7 +6177,7 @@ gfc_check_and (gfc_expr *i, gfc_expr *j)
 
   if (j->ts.type != BT_INTEGER && j->ts.type != BT_LOGICAL)
     {
-      gfc_error ("'%s' argument of '%s' intrinsic at %L must be INTEGER "
+      gfc_error ("%qs argument of %qs intrinsic at %L must be INTEGER "
 		 "or LOGICAL", gfc_current_intrinsic_arg[1]->name,
 		 gfc_current_intrinsic, &j->where);
       return false;
@@ -6185,7 +6185,7 @@ gfc_check_and (gfc_expr *i, gfc_expr *j)
 
   if (i->ts.type != j->ts.type)
     {
-      gfc_error ("'%s' and '%s' arguments of '%s' intrinsic at %L must "
+      gfc_error ("%qs and %qs arguments of %qs intrinsic at %L must "
 		 "have the same type", gfc_current_intrinsic_arg[0]->name,
 		 gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic,
 		 &j->where);
@@ -6207,7 +6207,7 @@ gfc_check_storage_size (gfc_expr *a, gfc_expr *kind)
 {
   if (a->ts.type == BT_ASSUMED)
     {
-      gfc_error ("'%s' argument of '%s' intrinsic at %L shall not be TYPE(*)",
+      gfc_error ("%qs argument of %qs intrinsic at %L shall not be TYPE(*)",
 		 gfc_current_intrinsic_arg[0]->name, gfc_current_intrinsic,
 		 &a->where);
       return false;
@@ -6215,7 +6215,7 @@ gfc_check_storage_size (gfc_expr *a, gfc_expr *kind)
 
   if (a->ts.type == BT_PROCEDURE)
     {
-      gfc_error ("'%s' argument of '%s' intrinsic at %L shall not be a "
+      gfc_error ("%qs argument of %qs intrinsic at %L shall not be a "
 		 "procedure", gfc_current_intrinsic_arg[0]->name,
 		 gfc_current_intrinsic, &a->where);
       return false;
@@ -6232,7 +6232,7 @@ gfc_check_storage_size (gfc_expr *a, gfc_expr *kind)
 
   if (kind->expr_type != EXPR_CONSTANT)
     {
-      gfc_error ("'%s' argument of '%s' intrinsic at %L must be a constant",
+      gfc_error ("%qs argument of %qs intrinsic at %L must be a constant",
 		 gfc_current_intrinsic_arg[1]->name, gfc_current_intrinsic,
 		 &kind->where);
       return false;
diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c
index 0286c9e391b..513002221ce 100644
--- a/gcc/fortran/class.c
+++ b/gcc/fortran/class.c
@@ -666,7 +666,7 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr,
 	 up to 255 extension levels.  */
       if (ts->u.derived->attr.extension == 255)
 	{
-	  gfc_error ("Maximum extension level reached with type '%s' at %L",
+	  gfc_error ("Maximum extension level reached with type %qs at %L",
 		     ts->u.derived->name, &ts->u.derived->declared_at);
 	return false;
 	}
@@ -2686,7 +2686,7 @@ find_typebound_proc_uop (gfc_symbol* derived, bool* t,
 	  && res->n.tb->access == ACCESS_PRIVATE)
 	{
 	  if (where)
-	    gfc_error ("'%s' of '%s' is PRIVATE at %L",
+	    gfc_error ("%qs of %qs is PRIVATE at %L",
 		       name, derived->name, where);
 	  if (t)
 	    *t = false;
@@ -2760,7 +2760,7 @@ gfc_find_typebound_intrinsic_op (gfc_symbol* derived, bool* t,
 	  && res->access == ACCESS_PRIVATE)
 	{
 	  if (where)
-	    gfc_error ("'%s' of '%s' is PRIVATE at %L",
+	    gfc_error ("%qs of %qs is PRIVATE at %L",
 		       gfc_op2string (op), derived->name, where);
 	  if (t)
 	    *t = false;
diff --git a/gcc/fortran/data.c b/gcc/fortran/data.c
index 8b270ac30ce..5d0651ee581 100644
--- a/gcc/fortran/data.c
+++ b/gcc/fortran/data.c
@@ -253,9 +253,9 @@ gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index,
 
 	  if (init && expr->expr_type != EXPR_ARRAY)
 	    {
-	      gfc_error ("'%s' at %L already is initialized at %L",
-			 lvalue->symtree->n.sym->name, &lvalue->where,
-			 &init->where);
+	      gfc_error_1 ("'%s' at %L already is initialized at %L",
+			   lvalue->symtree->n.sym->name, &lvalue->where,
+			   &init->where);
 	      goto abort;
 	    }
 
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 6e55bbf0a93..c6b46b9488c 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -261,7 +261,7 @@ var_element (gfc_data_variable *new_var)
   if (!sym->attr.function && gfc_current_ns->parent
       && gfc_current_ns->parent == sym->ns)
     {
-      gfc_error ("Host associated variable '%s' may not be in the DATA "
+      gfc_error ("Host associated variable %qs may not be in the DATA "
 		 "statement at %C", sym->name);
       return MATCH_ERROR;
     }
@@ -379,7 +379,7 @@ match_data_constant (gfc_expr **result)
       || (sym->attr.flavor != FL_PARAMETER
 	  && (!dt_sym || dt_sym->attr.flavor != FL_DERIVED)))
     {
-      gfc_error ("Symbol '%s' must be a PARAMETER in DATA statement at %C",
+      gfc_error ("Symbol %qs must be a PARAMETER in DATA statement at %C",
 		 name);
       return MATCH_ERROR;
     }
@@ -1017,15 +1017,15 @@ gfc_verify_c_interop_param (gfc_symbol *sym)
 	    {
 	      /* Make personalized messages to give better feedback.  */
 	      if (sym->ts.type == BT_DERIVED)
-		gfc_error ("Variable '%s' at %L is a dummy argument to the "
-			   "BIND(C) procedure '%s' but is not C interoperable "
-			   "because derived type '%s' is not C interoperable",
+		gfc_error ("Variable %qs at %L is a dummy argument to the "
+			   "BIND(C) procedure %qs but is not C interoperable "
+			   "because derived type %qs is not C interoperable",
 			   sym->name, &(sym->declared_at),
 			   sym->ns->proc_name->name,
 			   sym->ts.u.derived->name);
 	      else if (sym->ts.type == BT_CLASS)
-		gfc_error ("Variable '%s' at %L is a dummy argument to the "
-			   "BIND(C) procedure '%s' but is not C interoperable "
+		gfc_error ("Variable %qs at %L is a dummy argument to the "
+			   "BIND(C) procedure %qs but is not C interoperable "
 			   "because it is polymorphic",
 			   sym->name, &(sym->declared_at),
 			   sym->ns->proc_name->name);
@@ -1046,9 +1046,9 @@ gfc_verify_c_interop_param (gfc_symbol *sym)
 	      if (!cl || !cl->length || cl->length->expr_type != EXPR_CONSTANT
                   || mpz_cmp_si (cl->length->value.integer, 1) != 0)
 		{
-		  gfc_error ("Character argument '%s' at %L "
+		  gfc_error ("Character argument %qs at %L "
 			     "must be length 1 because "
-                             "procedure '%s' is BIND(C)",
+                             "procedure %qs is BIND(C)",
 			     sym->name, &sym->declared_at,
                              sym->ns->proc_name->name);
 		  retval = false;
@@ -1076,8 +1076,8 @@ gfc_verify_c_interop_param (gfc_symbol *sym)
 
 	  if ((sym->attr.allocatable || sym->attr.pointer) && !sym->as)
 	    {
-	      gfc_error ("Scalar variable '%s' at %L with POINTER or "
-			 "ALLOCATABLE in procedure '%s' with BIND(C) is not yet"
+	      gfc_error ("Scalar variable %qs at %L with POINTER or "
+			 "ALLOCATABLE in procedure %qs with BIND(C) is not yet"
 			 " supported", sym->name, &(sym->declared_at),
 			 sym->ns->proc_name->name);
 	      retval = false;
@@ -1085,8 +1085,8 @@ gfc_verify_c_interop_param (gfc_symbol *sym)
 
 	  if (sym->attr.optional == 1 && sym->attr.value)
 	    {
-	      gfc_error ("Variable '%s' at %L cannot have both the OPTIONAL "
-			 "and the VALUE attribute because procedure '%s' "
+	      gfc_error ("Variable %qs at %L cannot have both the OPTIONAL "
+			 "and the VALUE attribute because procedure %qs "
 			 "is BIND(C)", sym->name, &(sym->declared_at),
 			 sym->ns->proc_name->name);
 	      retval = false;
@@ -1323,7 +1323,7 @@ add_init_expr_to_sym (const char *name, gfc_expr **initp, locus *var_locus)
       && sym->value != NULL
       && *initp != NULL)
     {
-      gfc_error ("Initializer not allowed for PARAMETER '%s' at %C",
+      gfc_error ("Initializer not allowed for PARAMETER %qs at %C",
 		 sym->name);
       return false;
     }
@@ -1343,7 +1343,7 @@ add_init_expr_to_sym (const char *name, gfc_expr **initp, locus *var_locus)
 	 initializer.  */
       if (sym->attr.data)
 	{
-	  gfc_error ("Variable '%s' at %C with an initializer already "
+	  gfc_error ("Variable %qs at %C with an initializer already "
 		     "appears in a DATA statement", sym->name);
 	  return false;
 	}
@@ -1783,7 +1783,7 @@ check_function_name (char *name)
 	  && strcmp (block->result->name, "ppr@") != 0
 	  && strcmp (block->name, name) == 0)
 	{
-	  gfc_error ("Function name '%s' not allowed at %C", name);
+	  gfc_error ("Function name %qs not allowed at %C", name);
 	  return false;
 	}
     }
@@ -1850,7 +1850,7 @@ variable_decl (int elem)
       if (as->type == AS_IMPLIED_SHAPE && current_attr.flavor != FL_PARAMETER)
 	{
 	  m = MATCH_ERROR;
-	  gfc_error ("Non-PARAMETER symbol '%s' at %L can't be implied-shape",
+	  gfc_error ("Non-PARAMETER symbol %qs at %L can't be implied-shape",
 		     name, &var_locus);
 	  goto cleanup;
 	}
@@ -2819,7 +2819,7 @@ gfc_match_decl_type_spec (gfc_typespec *ts, int implicit_flag)
       gfc_get_ha_symbol (name, &sym);
       if (sym->generic && gfc_find_symbol (dt_name, NULL, 0, &dt_sym))
 	{
-	  gfc_error ("Type name '%s' at %C is ambiguous", name);
+	  gfc_error ("Type name %qs at %C is ambiguous", name);
 	  return MATCH_ERROR;
 	}
       if (sym->generic && !dt_sym)
@@ -2832,7 +2832,7 @@ gfc_match_decl_type_spec (gfc_typespec *ts, int implicit_flag)
       gfc_find_symbol (name, NULL, iface, &sym);
       if (sym && sym->generic && gfc_find_symbol (dt_name, NULL, 1, &dt_sym))
 	{
-	  gfc_error ("Type name '%s' at %C is ambiguous", name);
+	  gfc_error ("Type name %qs at %C is ambiguous", name);
 	  return MATCH_ERROR;
 	}
       if (sym && sym->generic && !dt_sym)
@@ -2847,9 +2847,9 @@ gfc_match_decl_type_spec (gfc_typespec *ts, int implicit_flag)
        && !(sym->attr.flavor == FL_PROCEDURE && sym->attr.generic))
       || sym->attr.subroutine)
     {
-      gfc_error ("Type name '%s' at %C conflicts with previously declared "
-	         "entity at %L, which has the same name", name,
-		 &sym->declared_at);
+      gfc_error_1 ("Type name '%s' at %C conflicts with previously declared "
+		   "entity at %L, which has the same name", name,
+		   &sym->declared_at);
       return MATCH_ERROR;
     }
 
@@ -3274,7 +3274,7 @@ gfc_match_import (void)
 	  if (gfc_current_ns->parent !=  NULL
 	      && gfc_find_symbol (name, gfc_current_ns->parent, 1, &sym))
 	    {
-	       gfc_error ("Type name '%s' at %C is ambiguous", name);
+	       gfc_error ("Type name %qs at %C is ambiguous", name);
 	       return MATCH_ERROR;
 	    }
 	  else if (!sym && gfc_current_ns->proc_name->ns->parent !=  NULL
@@ -3282,13 +3282,13 @@ gfc_match_import (void)
 				       gfc_current_ns->proc_name->ns->parent,
 				       1, &sym))
 	    {
-	       gfc_error ("Type name '%s' at %C is ambiguous", name);
+	       gfc_error ("Type name %qs at %C is ambiguous", name);
 	       return MATCH_ERROR;
 	    }
 
 	  if (sym == NULL)
 	    {
-	      gfc_error ("Cannot IMPORT '%s' from host scoping unit "
+	      gfc_error ("Cannot IMPORT %qs from host scoping unit "
 			 "at %C - does not exist.", name);
 	      return MATCH_ERROR;
 	    }
@@ -4064,13 +4064,13 @@ verify_bind_c_sym (gfc_symbol *tmp_sym, gfc_typespec *ts,
 	  else
 	    {
               if (tmp_sym->ts.type == BT_DERIVED || ts->type == BT_DERIVED)
-                gfc_error ("Type declaration '%s' at %L is not C "
+                gfc_error ("Type declaration %qs at %L is not C "
                            "interoperable but it is BIND(C)",
                            tmp_sym->name, &(tmp_sym->declared_at));
               else if (warn_c_binding_type)
                 gfc_warning (OPT_Wc_binding_type, "Variable %qs at %L "
                              "may not be a C interoperable "
-                             "kind but it is bind(c)",
+                             "kind but it is BIND(C)",
                              tmp_sym->name, &(tmp_sym->declared_at));
 	    }
 	}
@@ -4080,7 +4080,7 @@ verify_bind_c_sym (gfc_symbol *tmp_sym, gfc_typespec *ts,
 	 semantically no reason for the attribute.  */
       if (is_in_common == 1 && tmp_sym->attr.is_bind_c == 1)
 	{
-	  gfc_error ("Variable '%s' in common block '%s' at "
+	  gfc_error ("Variable %qs in common block %qs at "
 		     "%L cannot be declared with BIND(C) "
 		     "since it is not a global",
 		     tmp_sym->name, com_block->name,
@@ -4094,7 +4094,7 @@ verify_bind_c_sym (gfc_symbol *tmp_sym, gfc_typespec *ts,
 	{
 	  if (tmp_sym->attr.pointer == 1)
 	    {
-	      gfc_error ("Variable '%s' at %L cannot have both the "
+	      gfc_error ("Variable %qs at %L cannot have both the "
 			 "POINTER and BIND(C) attributes",
 			 tmp_sym->name, &(tmp_sym->declared_at));
 	      retval = false;
@@ -4102,7 +4102,7 @@ verify_bind_c_sym (gfc_symbol *tmp_sym, gfc_typespec *ts,
 
 	  if (tmp_sym->attr.allocatable == 1)
 	    {
-	      gfc_error ("Variable '%s' at %L cannot have both the "
+	      gfc_error ("Variable %qs at %L cannot have both the "
 			 "ALLOCATABLE and BIND(C) attributes",
 			 tmp_sym->name, &(tmp_sym->declared_at));
 	      retval = false;
@@ -4114,7 +4114,7 @@ verify_bind_c_sym (gfc_symbol *tmp_sym, gfc_typespec *ts,
 	 scalar value.  The previous tests in this function made sure
 	 the type is interoperable.  */
       if (bind_c_function && tmp_sym->as != NULL)
-	gfc_error ("Return type of BIND(C) function '%s' at %L cannot "
+	gfc_error ("Return type of BIND(C) function %qs at %L cannot "
 		   "be an array", tmp_sym->name, &(tmp_sym->declared_at));
 
       /* BIND(C) functions can not return a character string.  */
@@ -4122,7 +4122,7 @@ verify_bind_c_sym (gfc_symbol *tmp_sym, gfc_typespec *ts,
 	if (tmp_sym->ts.u.cl == NULL || tmp_sym->ts.u.cl->length == NULL
 	    || tmp_sym->ts.u.cl->length->expr_type != EXPR_CONSTANT
 	    || mpz_cmp_si (tmp_sym->ts.u.cl->length->value.integer, 1) != 0)
-	  gfc_error ("Return type of BIND(C) function '%s' at %L cannot "
+	  gfc_error ("Return type of BIND(C) function %qs at %L cannot "
 			 "be a character string", tmp_sym->name,
 			 &(tmp_sym->declared_at));
     }
@@ -4597,7 +4597,7 @@ gfc_match_formal_arglist (gfc_symbol *progname, int st_flag, int null_flag)
       if (gfc_new_block != NULL && sym != NULL
 	  && strcmp (sym->name, gfc_new_block->name) == 0)
 	{
-	  gfc_error ("Name '%s' at %C is the name of the procedure",
+	  gfc_error ("Name %qs at %C is the name of the procedure",
 		     sym->name);
 	  m = MATCH_ERROR;
 	  goto cleanup;
@@ -4626,7 +4626,7 @@ ok:
 	  for (q = p->next; q; q = q->next)
 	    if (p->sym == q->sym)
 	      {
-		gfc_error ("Duplicate symbol '%s' in formal argument list "
+		gfc_error ("Duplicate symbol %qs in formal argument list "
 			   "at %C", p->sym->name);
 
 		m = MATCH_ERROR;
@@ -5001,7 +5001,7 @@ match_procedure_decl (void)
 	{
           if (sym->ts.type != BT_UNKNOWN)
 	    {
-	      gfc_error ("Procedure '%s' at %L already has basic type of %s",
+	      gfc_error ("Procedure %qs at %L already has basic type of %s",
 			 sym->name, &gfc_current_locus,
 			 gfc_basic_typename (sym->ts.type));
 	      return MATCH_ERROR;
@@ -6277,7 +6277,7 @@ gfc_match_end (gfc_statement *st)
       if (!block_name)
 	return MATCH_YES;
 
-      gfc_error ("Expected block name of '%s' in %s statement at %L",
+      gfc_error ("Expected block name of %qs in %s statement at %L",
 		 block_name, gfc_ascii_statement (*st), &old_loc);
 
       return MATCH_ERROR;
@@ -6303,7 +6303,7 @@ gfc_match_end (gfc_statement *st)
 
   if (strcmp (name, block_name) != 0 && strcmp (block_name, "ppr@") != 0)
     {
-      gfc_error ("Expected label '%s' for %s statement at %C", block_name,
+      gfc_error ("Expected label %qs for %s statement at %C", block_name,
 		 gfc_ascii_statement (*st));
       goto cleanup;
     }
@@ -6311,7 +6311,7 @@ gfc_match_end (gfc_statement *st)
   else if (strcmp (block_name, "ppr@") == 0
 	   && strcmp (name, gfc_current_block ()->ns->proc_name->name) != 0)
     {
-      gfc_error ("Expected label '%s' for %s statement at %C",
+      gfc_error ("Expected label %qs for %s statement at %C",
 		 gfc_current_block ()->ns->proc_name->name,
 		 gfc_ascii_statement (*st));
       goto cleanup;
@@ -7315,7 +7315,7 @@ gfc_match_volatile (void)
 	     for variable in a BLOCK which is defined outside of the BLOCK.  */
 	  if (sym->ns != gfc_current_ns && sym->attr.codimension)
 	    {
-	      gfc_error ("Specifying VOLATILE for coarray variable '%s' at "
+	      gfc_error ("Specifying VOLATILE for coarray variable %qs at "
 			 "%C, which is use-/host-associated", sym->name);
 	      return MATCH_ERROR;
 	    }
@@ -7531,27 +7531,27 @@ check_extended_derived_type (char *name)
   /* F08:C428.  */
   if (!extended)
     {
-      gfc_error ("Symbol '%s' at %C has not been previously defined", name);
+      gfc_error ("Symbol %qs at %C has not been previously defined", name);
       return NULL;
     }
 
   if (extended->attr.flavor != FL_DERIVED)
     {
-      gfc_error ("'%s' in EXTENDS expression at %C is not a "
+      gfc_error ("%qs in EXTENDS expression at %C is not a "
 		 "derived type", name);
       return NULL;
     }
 
   if (extended->attr.is_bind_c)
     {
-      gfc_error ("'%s' cannot be extended at %C because it "
+      gfc_error ("%qs cannot be extended at %C because it "
 		 "is BIND(C)", extended->name);
       return NULL;
     }
 
   if (extended->attr.sequence)
     {
-      gfc_error ("'%s' cannot be extended at %C because it "
+      gfc_error ("%qs cannot be extended at %C because it "
 		 "is a SEQUENCE type", extended->name);
       return NULL;
     }
@@ -7682,7 +7682,7 @@ gfc_match_derived_decl (void)
   /* Make sure the name is not the name of an intrinsic type.  */
   if (gfc_is_intrinsic_typename (name))
     {
-      gfc_error ("Type name '%s' at %C cannot be the same as an intrinsic "
+      gfc_error ("Type name %qs at %C cannot be the same as an intrinsic "
 		 "type", name);
       return MATCH_ERROR;
     }
@@ -7692,7 +7692,7 @@ gfc_match_derived_decl (void)
 
   if (!gensym->attr.generic && gensym->ts.type != BT_UNKNOWN)
     {
-      gfc_error ("Derived type name '%s' at %C already has a basic type "
+      gfc_error ("Derived type name %qs at %C already has a basic type "
 		 "of %s", gensym->name, gfc_typename (&gensym->ts));
       return MATCH_ERROR;
     }
@@ -7709,7 +7709,7 @@ gfc_match_derived_decl (void)
 
   if (sym && (sym->components != NULL || sym->attr.zero_comp))
     {
-      gfc_error ("Derived type definition of '%s' at %C has already been "
+      gfc_error ("Derived type definition of %qs at %C has already been "
                  "defined", sym->name);
       return MATCH_ERROR;
     }
@@ -7780,7 +7780,7 @@ gfc_match_derived_decl (void)
 	{
 	  /* Since the extension field is 8 bit wide, we can only have
 	     up to 255 extension levels.  */
-	  gfc_error ("Maximum extension level reached with type '%s' at %L",
+	  gfc_error ("Maximum extension level reached with type %qs at %L",
 		     extended->name, &extended->declared_at);
 	  return MATCH_ERROR;
 	}
@@ -8375,7 +8375,7 @@ match_procedure_in_type (void)
       /* If the binding is DEFERRED, check that the containing type is ABSTRACT.  */
       if (tb.deferred && !block->attr.abstract)
 	{
-	  gfc_error ("Type '%s' containing DEFERRED binding at %C "
+	  gfc_error ("Type %qs containing DEFERRED binding at %C "
 		     "is not ABSTRACT", block->name);
 	  return MATCH_ERROR;
 	}
@@ -8386,8 +8386,8 @@ match_procedure_in_type (void)
       stree = gfc_find_symtree (ns->tb_sym_root, name);
       if (stree && stree->n.tb)
 	{
-	  gfc_error ("There is already a procedure with binding name '%s' for "
-		     "the derived type '%s' at %C", name, block->name);
+	  gfc_error ("There is already a procedure with binding name %qs for "
+		     "the derived type %qs at %C", name, block->name);
 	  return MATCH_ERROR;
 	}
 
@@ -8536,7 +8536,7 @@ gfc_match_generic (void)
 	{
 	  gcc_assert (op_type == INTERFACE_GENERIC);
 	  gfc_error ("There's already a non-generic procedure with binding name"
-		     " '%s' for the derived type '%s' at %C",
+		     " %qs for the derived type %qs at %C",
 		     bind_name, block->name);
 	  goto error;
 	}
@@ -8544,7 +8544,7 @@ gfc_match_generic (void)
       if (tb->access != tbattr.access)
 	{
 	  gfc_error ("Binding at %C must have the same access as already"
-		     " defined binding '%s'", bind_name);
+		     " defined binding %qs", bind_name);
 	  goto error;
 	}
     }
@@ -8602,8 +8602,8 @@ gfc_match_generic (void)
       for (target = tb->u.generic; target; target = target->next)
 	if (target_st == target->specific_st)
 	  {
-	    gfc_error ("'%s' already defined as specific binding for the"
-		       " generic '%s' at %C", name, bind_name);
+	    gfc_error ("%qs already defined as specific binding for the"
+		       " generic %qs at %C", name, bind_name);
 	    goto error;
 	  }
 
@@ -8711,7 +8711,7 @@ gfc_match_final_decl (void)
 
       if (gfc_get_symbol (name, module_ns, &sym))
 	{
-	  gfc_error ("Unknown procedure name \"%s\" at %C", name);
+	  gfc_error ("Unknown procedure name %qs at %C", name);
 	  return MATCH_ERROR;
 	}
 
@@ -8724,7 +8724,7 @@ gfc_match_final_decl (void)
       for (f = block->f2k_derived->finalizers; f; f = f->next)
 	if (f->proc_sym == sym)
 	  {
-	    gfc_error ("'%s' at %C is already defined as FINAL procedure!",
+	    gfc_error ("%qs at %C is already defined as FINAL procedure!",
 		       name);
 	    return MATCH_ERROR;
 	  }
diff --git a/gcc/fortran/error.c b/gcc/fortran/error.c
index 851ba90ab10..f7a6a6b243c 100644
--- a/gcc/fortran/error.c
+++ b/gcc/fortran/error.c
@@ -34,6 +34,8 @@ along with GCC; see the file COPYING3.  If not see
 #include "diagnostic-color.h"
 #include "tree-diagnostic.h" /* tree_diagnostics_defaults */
 
+#include <new> /* For placement-new */
+
 static int suppress_errors = 0;
 
 static bool warnings_not_errors = false;
@@ -44,13 +46,18 @@ static gfc_error_buf error_buffer, warning_buffer, *cur_error_buffer;
 
 /* True if the error/warnings should be buffered.  */
 static bool buffered_p;
-
 /* These are always buffered buffers (.flush_p == false) to be used by
    the pretty-printer.  */
-static output_buffer pp_warning_buffer;
+static output_buffer *pp_error_buffer, *pp_warning_buffer;
 static int warningcount_buffered, werrorcount_buffered;
 
-#include <new> /* For placement-new */
+/* Return true if there output_buffer is empty.  */
+
+static bool
+gfc_output_buffer_empty_p (const output_buffer * buf)
+{
+  return output_buffer_last_position_in_text (buf) == NULL;
+}
 
 /* Go one level deeper suppressing errors.  */
 
@@ -99,7 +106,6 @@ void
 gfc_buffer_error (bool flag)
 {
   buffered_p = flag;
-  pp_warning_buffer.flush_p = !flag;
 }
 
 
@@ -843,11 +849,11 @@ gfc_warning (int opt, const char *gmsgid, va_list ap)
   pretty_printer *pp = global_dc->printer;
   output_buffer *tmp_buffer = pp->buffer;
 
-  gfc_clear_pp_buffer (&pp_warning_buffer);
+  gfc_clear_pp_buffer (pp_warning_buffer);
 
   if (buffered_p)
     {
-      pp->buffer = &pp_warning_buffer;
+      pp->buffer = pp_warning_buffer;
       global_dc->fatal_errors = false;
       /* To prevent -fmax-errors= triggering.  */
       --werrorcount;
@@ -1248,10 +1254,9 @@ gfc_clear_warning (void)
 {
   warning_buffer.flag = 0;
 
-  gfc_clear_pp_buffer (&pp_warning_buffer);
+  gfc_clear_pp_buffer (pp_warning_buffer);
   warningcount_buffered = 0;
   werrorcount_buffered = 0;
-  pp_warning_buffer.flush_p = false;
 }
 
 
@@ -1266,29 +1271,32 @@ gfc_warning_check (void)
       warnings++;
       if (warning_buffer.message != NULL)
 	fputs (warning_buffer.message, stderr);
-      warning_buffer.flag = 0;
+      gfc_clear_warning ();
     }
-
   /* 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)
+  else if (! gfc_output_buffer_empty_p (pp_warning_buffer))
     {
+      pretty_printer *pp = global_dc->printer;
+      output_buffer *tmp_buffer = pp->buffer;
+      pp->buffer = pp_warning_buffer;
       pp_really_flush (pp);
-      pp_warning_buffer.flush_p = true;
       warningcount += warningcount_buffered;
       werrorcount += werrorcount_buffered;
+      gcc_assert (warningcount_buffered + werrorcount_buffered == 1);
+      diagnostic_action_after_output (global_dc, 
+				      warningcount_buffered 
+				      ? DK_WARNING : DK_ERROR);
+      pp->buffer = tmp_buffer;
     }
-
-  pp->buffer = tmp_buffer;
 }
 
 
 /* Issue an error.  */
+/* Use gfc_error instead, unless two locations are used in the same
+   warning or for scanner.c, if the location is not properly set up.  */
 
 void
-gfc_error (const char *gmsgid, ...)
+gfc_error_1 (const char *gmsgid, ...)
 {
   va_list argp;
 
@@ -1336,6 +1344,59 @@ warning:
   }
 }
 
+/* Issue an error.  */
+/* This function uses the common diagnostics, but does not support
+   two locations; when being used in scanner.c, ensure that the location
+   is properly setup. Otherwise, use gfc_error_1.   */
+
+void
+gfc_error (const char *gmsgid, ...)
+{
+  va_list argp;
+  va_start (argp, gmsgid);
+
+  if (warnings_not_errors)
+    {
+      gfc_warning (/*opt=*/0, gmsgid, argp);
+      va_end (argp);
+      return;
+    }
+
+  if (suppress_errors)
+    {
+      va_end (argp);
+      return;
+    }
+
+  diagnostic_info diagnostic;
+  bool fatal_errors = global_dc->fatal_errors;
+  pretty_printer *pp = global_dc->printer;
+  output_buffer *tmp_buffer = pp->buffer;
+
+  gfc_clear_pp_buffer (pp_error_buffer);
+
+  if (buffered_p)
+    {
+      pp->buffer = pp_error_buffer;
+      global_dc->fatal_errors = false;
+      /* To prevent -fmax-errors= triggering, we decrease it before
+	 report_diagnostic increases it.  */
+      --errorcount; 
+    }
+
+  diagnostic_set_info (&diagnostic, gmsgid, &argp, UNKNOWN_LOCATION, DK_ERROR);
+  report_diagnostic (&diagnostic);
+
+  if (buffered_p)
+    {
+      pp->buffer = tmp_buffer;
+      global_dc->fatal_errors = fatal_errors;
+    }
+  
+  va_end (argp);
+}
+
+
 
 /* Immediate error.  */
 /* Use gfc_error_now instead, unless two locations are used in the same
@@ -1393,6 +1454,7 @@ gfc_clear_error (void)
 {
   error_buffer.flag = 0;
   warnings_not_errors = false;
+  gfc_clear_pp_buffer (pp_error_buffer);
 }
 
 
@@ -1401,7 +1463,8 @@ gfc_clear_error (void)
 bool
 gfc_error_flag_test (void)
 {
-  return error_buffer.flag;
+  return error_buffer.flag 
+    || !gfc_output_buffer_empty_p (pp_error_buffer);
 }
 
 
@@ -1418,34 +1481,69 @@ gfc_error_check (void)
       if (error_buffer.message != NULL)
 	fputs (error_buffer.message, stderr);
       error_buffer.flag = 0;
+      gfc_clear_pp_buffer (pp_error_buffer);
 
       gfc_increment_error_count();
 
       if (flag_fatal_errors)
 	exit (FATAL_EXIT_CODE);
     }
+  /* This is for the new diagnostics machinery.  */
+  else if (! gfc_output_buffer_empty_p (pp_error_buffer))
+    {
+      error_raised = true;
+      pretty_printer *pp = global_dc->printer;
+      output_buffer *tmp_buffer = pp->buffer;
+      pp->buffer = pp_error_buffer;
+      pp_really_flush (pp);
+      ++errorcount;
+      gcc_assert (gfc_output_buffer_empty_p (pp_error_buffer));
+      diagnostic_action_after_output (global_dc, DK_ERROR);
+      pp->buffer = tmp_buffer;
+    }
 
   return error_raised;
 }
 
+/* Move the text buffered from FROM to TO, then clear
+   FROM. Independently if there was text in FROM, TO is also
+   cleared. */
+
+static void
+gfc_move_output_buffer_from_to (output_buffer *from, output_buffer *to)
+{
+  gfc_clear_pp_buffer (to);
+  /* We make sure this is always buffered.  */
+  to->flush_p = false;
+
+  if (! gfc_output_buffer_empty_p (from))
+    {
+      const char *str = output_buffer_formatted_text (from);
+      output_buffer_append_r (to, str, strlen (str));
+      gfc_clear_pp_buffer (from);
+    }
+}
 
 /* Save the existing error state.  */
 
 void
-gfc_push_error (gfc_error_buf *err)
+gfc_push_error (output_buffer *buffer_err, gfc_error_buf *err)
 {
   err->flag = error_buffer.flag;
   if (error_buffer.flag)
     err->message = xstrdup (error_buffer.message);
 
   error_buffer.flag = 0;
+
+  /* This part uses the common diagnostics.  */
+  gfc_move_output_buffer_from_to (pp_error_buffer, buffer_err);
 }
 
 
 /* Restore a previous pushed error state.  */
 
 void
-gfc_pop_error (gfc_error_buf *err)
+gfc_pop_error (output_buffer *buffer_err, gfc_error_buf *err)
 {
   error_buffer.flag = err->flag;
   if (error_buffer.flag)
@@ -1455,16 +1553,20 @@ gfc_pop_error (gfc_error_buf *err)
       memcpy (error_buffer.message, err->message, len);
       free (err->message);
     }
+  /* This part uses the common diagnostics.  */
+  gfc_move_output_buffer_from_to (buffer_err, pp_error_buffer);
 }
 
 
 /* Free a pushed error state, but keep the current error state.  */
 
 void
-gfc_free_error (gfc_error_buf *err)
+gfc_free_error (output_buffer *buffer_err, gfc_error_buf *err)
 {
   if (err->flag)
     free (err->message);
+
+  gfc_clear_pp_buffer (buffer_err);
 }
 
 
@@ -1495,7 +1597,10 @@ 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 ();
+  pp_warning_buffer = new (XNEW (output_buffer)) output_buffer ();
+  pp_warning_buffer->flush_p = false;
+  pp_error_buffer = new (XNEW (output_buffer)) output_buffer ();
+  pp_error_buffer->flush_p = false;
 }
 
 void
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index edf83363ba6..bfe83560a07 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -2204,9 +2204,9 @@ check_alloc_comp_init (gfc_expr *e)
       if (comp->attr.allocatable
           && ctor->expr->expr_type != EXPR_NULL)
         {
-	  gfc_error("Invalid initialization expression for ALLOCATABLE "
-	            "component '%s' in structure constructor at %L",
-	            comp->name, &ctor->expr->where);
+	  gfc_error ("Invalid initialization expression for ALLOCATABLE "
+		     "component %qs in structure constructor at %L",
+		     comp->name, &ctor->expr->where);
 	  return false;
 	}
     }
@@ -2315,7 +2315,7 @@ check_inquiry (gfc_expr *e, int not_restricted)
 	    && (ap->expr->symtree->n.sym->ts.u.cl->length == NULL
 		|| ap->expr->symtree->n.sym->ts.deferred))
 	  {
-	    gfc_error ("Assumed or deferred character length variable '%s' "
+	    gfc_error ("Assumed or deferred character length variable %qs "
 			" in constant expression at %L",
 			ap->expr->symtree->n.sym->name,
 			&ap->expr->where);
@@ -2381,8 +2381,8 @@ check_transformational (gfc_expr *e)
 
   if (functions[i] == NULL)
     {
-      gfc_error("transformational intrinsic '%s' at %L is not permitted "
-		"in an initialization expression", name, &e->where);
+      gfc_error ("transformational intrinsic %qs at %L is not permitted "
+		 "in an initialization expression", name, &e->where);
       return MATCH_ERROR;
     }
 
@@ -2481,7 +2481,7 @@ gfc_check_init_expr (gfc_expr *e)
 	if (!gfc_is_intrinsic (sym, 0, e->where)
 	    || (m = gfc_intrinsic_func_interface (e, 0)) != MATCH_YES)
 	  {
-	    gfc_error ("Function '%s' in initialization expression at %L "
+	    gfc_error ("Function %qs in initialization expression at %L "
 		       "must be an intrinsic function",
 		       e->symtree->n.sym->name, &e->where);
 	    break;
@@ -2493,7 +2493,7 @@ gfc_check_init_expr (gfc_expr *e)
 	    && (m = check_transformational (e)) == MATCH_NO
 	    && (m = check_elemental (e)) == MATCH_NO)
 	  {
-	    gfc_error ("Intrinsic function '%s' at %L is not permitted "
+	    gfc_error ("Intrinsic function %qs at %L is not permitted "
 		       "in an initialization expression",
 		       e->symtree->n.sym->name, &e->where);
 	    m = MATCH_ERROR;
@@ -2528,8 +2528,8 @@ gfc_check_init_expr (gfc_expr *e)
 	     is invalid.  */
 	  if (!e->symtree->n.sym->value)
 	    {
-	      gfc_error("PARAMETER '%s' is used at %L before its definition "
-			"is complete", e->symtree->n.sym->name, &e->where);
+	      gfc_error ("PARAMETER %qs is used at %L before its definition "
+			 "is complete", e->symtree->n.sym->name, &e->where);
 	      t = false;
 	    }
 	  else
@@ -2548,25 +2548,25 @@ gfc_check_init_expr (gfc_expr *e)
 	  switch (e->symtree->n.sym->as->type)
 	    {
 	      case AS_ASSUMED_SIZE:
-		gfc_error ("Assumed size array '%s' at %L is not permitted "
+		gfc_error ("Assumed size array %qs at %L is not permitted "
 			   "in an initialization expression",
 			   e->symtree->n.sym->name, &e->where);
 		break;
 
 	      case AS_ASSUMED_SHAPE:
-		gfc_error ("Assumed shape array '%s' at %L is not permitted "
+		gfc_error ("Assumed shape array %qs at %L is not permitted "
 			   "in an initialization expression",
 			   e->symtree->n.sym->name, &e->where);
 		break;
 
 	      case AS_DEFERRED:
-		gfc_error ("Deferred array '%s' at %L is not permitted "
+		gfc_error ("Deferred array %qs at %L is not permitted "
 			   "in an initialization expression",
 			   e->symtree->n.sym->name, &e->where);
 		break;
 
 	      case AS_EXPLICIT:
-		gfc_error ("Array '%s' at %L is a variable, which does "
+		gfc_error ("Array %qs at %L is a variable, which does "
 			   "not reduce to a constant expression",
 			   e->symtree->n.sym->name, &e->where);
 		break;
@@ -2576,7 +2576,7 @@ gfc_check_init_expr (gfc_expr *e)
 	  }
 	}
       else
-	gfc_error ("Parameter '%s' at %L has not been declared or is "
+	gfc_error ("Parameter %qs at %L has not been declared or is "
 		   "a variable, which does not reduce to a constant "
 		   "expression", e->symtree->n.sym->name, &e->where);
 
@@ -2729,28 +2729,28 @@ external_spec_function (gfc_expr *e)
 
   if (f->attr.proc == PROC_ST_FUNCTION)
     {
-      gfc_error ("Specification function '%s' at %L cannot be a statement "
+      gfc_error ("Specification function %qs at %L cannot be a statement "
 		 "function", f->name, &e->where);
       return false;
     }
 
   if (f->attr.proc == PROC_INTERNAL)
     {
-      gfc_error ("Specification function '%s' at %L cannot be an internal "
+      gfc_error ("Specification function %qs at %L cannot be an internal "
 		 "function", f->name, &e->where);
       return false;
     }
 
   if (!f->attr.pure && !f->attr.elemental)
     {
-      gfc_error ("Specification function '%s' at %L must be PURE", f->name,
+      gfc_error ("Specification function %qs at %L must be PURE", f->name,
 		 &e->where);
       return false;
     }
 
   if (f->attr.recursive)
     {
-      gfc_error ("Specification function '%s' at %L cannot be RECURSIVE",
+      gfc_error ("Specification function %qs at %L cannot be RECURSIVE",
 		 f->name, &e->where);
       return false;
     }
@@ -2884,21 +2884,21 @@ check_restricted (gfc_expr *e)
       if (sym->attr.dummy && sym->ns == gfc_current_ns
 	  && sym->ns->proc_name && sym->ns->proc_name->attr.elemental)
 	{
-	  gfc_error ("Dummy argument '%s' not allowed in expression at %L",
+	  gfc_error ("Dummy argument %qs not allowed in expression at %L",
 		     sym->name, &e->where);
 	  break;
 	}
 
       if (sym->attr.optional)
 	{
-	  gfc_error ("Dummy argument '%s' at %L cannot be OPTIONAL",
+	  gfc_error ("Dummy argument %qs at %L cannot be OPTIONAL",
 		     sym->name, &e->where);
 	  break;
 	}
 
       if (sym->attr.intent == INTENT_OUT)
 	{
-	  gfc_error ("Dummy argument '%s' at %L cannot be INTENT(OUT)",
+	  gfc_error ("Dummy argument %qs at %L cannot be INTENT(OUT)",
 		     sym->name, &e->where);
 	  break;
 	}
@@ -2929,7 +2929,7 @@ check_restricted (gfc_expr *e)
 	  break;
 	}
 
-      gfc_error ("Variable '%s' cannot appear in the expression at %L",
+      gfc_error ("Variable %qs cannot appear in the expression at %L",
 		 sym->name, &e->where);
       /* Prevent a repetition of the error.  */
       e->error = 1;
@@ -2992,7 +2992,7 @@ gfc_specification_expr (gfc_expr *e)
       && !gfc_pure (e->symtree->n.sym)
       && (!comp || !comp->attr.pure))
     {
-      gfc_error ("Function '%s' at %L must be PURE",
+      gfc_error ("Function %qs at %L must be PURE",
 		 e->symtree->n.sym->name, &e->where);
       /* Prevent repeat error messages.  */
       e->symtree->n.sym->attr.pure = 1;
@@ -3138,7 +3138,7 @@ gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform)
 
       if (bad_proc)
 	{
-	  gfc_error ("'%s' at %L is not a VALUE", sym->name, &lvalue->where);
+	  gfc_error ("%qs at %L is not a VALUE", sym->name, &lvalue->where);
 	  return false;
 	}
     }
@@ -3331,7 +3331,7 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue)
   if (lhs_attr.flavor == FL_PROCEDURE && lhs_attr.use_assoc
       && !lhs_attr.proc_pointer)
     {
-      gfc_error ("'%s' in the pointer assignment at %L cannot be an "
+      gfc_error ("%qs in the pointer assignment at %L cannot be an "
 		 "l-value since it is a procedure",
 		 lvalue->symtree->n.sym->name, &lvalue->where);
       return false;
@@ -3354,7 +3354,7 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue)
 
 	  if (ref->u.ar.type != AR_SECTION)
 	    {
-	      gfc_error ("Expected bounds specification for '%s' at %L",
+	      gfc_error ("Expected bounds specification for %qs at %L",
 			 lvalue->symtree->n.sym->name, &lvalue->where);
 	      return false;
 	    }
@@ -3461,7 +3461,7 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue)
 	      for (ns = gfc_current_ns; ns; ns = ns->parent)
 		if (sym == ns->proc_name)
 		  {
-		    gfc_error ("Function result '%s' is invalid as proc-target "
+		    gfc_error ("Function result %qs is invalid as proc-target "
 			       "in procedure pointer assignment at %L",
 			       sym->name, &rvalue->where);
 		    return false;
@@ -3470,7 +3470,7 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue)
 	}
       if (attr.abstract)
 	{
-	  gfc_error ("Abstract interface '%s' is invalid "
+	  gfc_error ("Abstract interface %qs is invalid "
 		     "in procedure pointer assignment at %L",
 		     rvalue->symtree->name, &rvalue->where);
 	  return false;
@@ -3480,7 +3480,7 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue)
 	{
 	  if (attr.proc == PROC_ST_FUNCTION)
 	    {
-	      gfc_error ("Statement function '%s' is invalid "
+	      gfc_error ("Statement function %qs is invalid "
 			 "in procedure pointer assignment at %L",
 			 rvalue->symtree->name, &rvalue->where);
 	      return false;
@@ -3493,7 +3493,7 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue)
 	  if (attr.intrinsic && gfc_intrinsic_actual_ok (rvalue->symtree->name,
 							 attr.subroutine) == 0)
 	    {
-	      gfc_error ("Intrinsic '%s' at %L is invalid in procedure pointer "
+	      gfc_error ("Intrinsic %qs at %L is invalid in procedure pointer "
 			 "assignment", rvalue->symtree->name, &rvalue->where);
 	      return false;
 	    }
@@ -3501,7 +3501,7 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue)
       /* Check for F08:C730.  */
       if (attr.elemental && !attr.intrinsic)
 	{
-	  gfc_error ("Nonintrinsic elemental procedure '%s' is invalid "
+	  gfc_error ("Nonintrinsic elemental procedure %qs is invalid "
 		     "in procedure pointer assignment at %L",
 		     rvalue->symtree->name, &rvalue->where);
 	  return false;
@@ -3580,14 +3580,14 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue)
       if (s1->attr.if_source == IFSRC_UNKNOWN
 	  && gfc_explicit_interface_required (s2, err, sizeof(err)))
 	{
-	  gfc_error ("Explicit interface required for '%s' at %L: %s",
+	  gfc_error ("Explicit interface required for %qs at %L: %s",
 		     s1->name, &lvalue->where, err);
 	  return false;
 	}
       if (s2->attr.if_source == IFSRC_UNKNOWN
 	  && gfc_explicit_interface_required (s1, err, sizeof(err)))
 	{
-	  gfc_error ("Explicit interface required for '%s' at %L: %s",
+	  gfc_error ("Explicit interface required for %qs at %L: %s",
 		     s2->name, &rvalue->where, err);
 	  return false;
 	}
@@ -3604,7 +3604,7 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue)
       if (!s2->attr.intrinsic && s2->attr.if_source == IFSRC_UNKNOWN
 	  && !s2->attr.external && !s2->attr.subroutine && !s2->attr.function)
 	{
-	  gfc_error ("Procedure pointer target '%s' at %L must be either an "
+	  gfc_error ("Procedure pointer target %qs at %L must be either an "
 		     "intrinsic, host or use associated, referenced or have "
 		     "the EXTERNAL attribute", s2->name, &rvalue->where);
 	  return false;
@@ -4758,7 +4758,7 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj,
   if (!pointer && sym->attr.flavor == FL_PARAMETER)
     {
       if (context)
-	gfc_error ("Named constant '%s' in variable definition context (%s)"
+	gfc_error ("Named constant %qs in variable definition context (%s)"
 		   " at %L", sym->name, context, &e->where);
       return false;
     }
@@ -4767,7 +4767,7 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj,
       && !(sym->attr.flavor == FL_PROCEDURE && sym->attr.proc_pointer))
     {
       if (context)
-	gfc_error ("'%s' in variable definition context (%s) at %L is not"
+	gfc_error ("%qs in variable definition context (%s) at %L is not"
 		   " a variable", sym->name, context, &e->where);
       return false;
     }
@@ -4820,7 +4820,7 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj,
       if (pointer && is_pointer)
 	{
 	  if (context)
-	    gfc_error ("Dummy argument '%s' with INTENT(IN) in pointer"
+	    gfc_error ("Dummy argument %qs with INTENT(IN) in pointer"
 		       " association context (%s) at %L",
 		       sym->name, context, &e->where);
 	  return false;
@@ -4828,7 +4828,7 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj,
       if (!pointer && !is_pointer && !sym->attr.pointer)
 	{
 	  if (context)
-	    gfc_error ("Dummy argument '%s' with INTENT(IN) in variable"
+	    gfc_error ("Dummy argument %qs with INTENT(IN) in variable"
 		       " definition context (%s) at %L",
 		       sym->name, context, &e->where);
 	  return false;
@@ -4841,7 +4841,7 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj,
       if (pointer && is_pointer)
 	{
 	  if (context)
-	    gfc_error ("Variable '%s' is PROTECTED and can not appear in a"
+	    gfc_error ("Variable %qs is PROTECTED and can not appear in a"
 		       " pointer association context (%s) at %L",
 		       sym->name, context, &e->where);
 	  return false;
@@ -4849,7 +4849,7 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj,
       if (!pointer && !is_pointer)
 	{
 	  if (context)
-	    gfc_error ("Variable '%s' is PROTECTED and can not appear in a"
+	    gfc_error ("Variable %qs is PROTECTED and can not appear in a"
 		       " variable definition context (%s) at %L",
 		       sym->name, context, &e->where);
 	  return false;
@@ -4861,7 +4861,7 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj,
   if (!pointer && !own_scope && gfc_pure (NULL) && gfc_impure_variable (sym))
     {
       if (context)
-	gfc_error ("Variable '%s' can not appear in a variable definition"
+	gfc_error ("Variable %qs can not appear in a variable definition"
 		   " context (%s) at %L in PURE procedure",
 		   sym->name, context, &e->where);
       return false;
@@ -4920,11 +4920,11 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj,
 	  if (context)
 	    {
 	      if (assoc->target->expr_type == EXPR_VARIABLE)
-		gfc_error ("'%s' at %L associated to vector-indexed target can"
+		gfc_error ("%qs at %L associated to vector-indexed target can"
 			   " not be used in a variable definition context (%s)",
 			   name, &e->where, context);
 	      else
-		gfc_error ("'%s' at %L associated to expression can"
+		gfc_error ("%qs at %L associated to expression can"
 			   " not be used in a variable definition context (%s)",
 			   name, &e->where, context);
 	    }
@@ -4935,7 +4935,7 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj,
       if (!gfc_check_vardef_context (assoc->target, pointer, false, false, NULL))
 	{
 	  if (context)
-	    gfc_error ("Associate-name '%s' can not appear in a variable"
+	    gfc_error_1 ("Associate-name '%s' can not appear in a variable"
 		       " definition context (%s) at %L because its target"
 		       " at %L can not, either",
 		       name, context, &e->where,
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 0ed42d0845e..9d96b85fbd3 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2682,6 +2682,7 @@ bool gfc_warning_now (int opt, const char *, ...) ATTRIBUTE_GCC_GFC(2,3);
 void gfc_clear_warning (void);
 void gfc_warning_check (void);
 
+void gfc_error_1 (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
 void gfc_error (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
 void gfc_error_now_1 (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
 void gfc_error_now (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
@@ -2698,9 +2699,10 @@ bool gfc_notify_std (int, const char *, ...) ATTRIBUTE_GCC_GFC(2,3);
 #define gfc_syntax_error(ST)	\
   gfc_error ("Syntax error in %s statement at %C", gfc_ascii_statement (ST));
 
-void gfc_push_error (gfc_error_buf *);
-void gfc_pop_error (gfc_error_buf *);
-void gfc_free_error (gfc_error_buf *);
+#include "pretty-print.h" /* For output_buffer.  */
+void gfc_push_error (output_buffer *, gfc_error_buf *);
+void gfc_pop_error (output_buffer *, gfc_error_buf *);
+void gfc_free_error (output_buffer *, gfc_error_buf *);
 
 void gfc_get_errors (int *, int *);
 void gfc_errors_to_warnings (bool);
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index b390dff6397..5f6ed834c05 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -219,7 +219,7 @@ gfc_match_interface (void)
 
       if (sym->attr.dummy)
 	{
-	  gfc_error ("Dummy procedure '%s' at %C cannot have a "
+	  gfc_error ("Dummy procedure %qs at %C cannot have a "
 		     "generic interface", sym->name);
 	  return MATCH_ERROR;
 	}
@@ -1561,10 +1561,10 @@ check_interface0 (gfc_interface *p, const char *interface_name)
 	  && p->sym->attr.flavor != FL_DERIVED)
 	{
 	  if (p->sym->attr.external)
-	    gfc_error ("Procedure '%s' in %s at %L has no explicit interface",
+	    gfc_error ("Procedure %qs in %s at %L has no explicit interface",
 		       p->sym->name, interface_name, &p->sym->declared_at);
 	  else
-	    gfc_error ("Procedure '%s' in %s at %L is neither function nor "
+	    gfc_error ("Procedure %qs in %s at %L is neither function nor "
 		       "subroutine", p->sym->name, interface_name,
 		      &p->sym->declared_at);
 	  return 1;
@@ -1645,7 +1645,7 @@ check_interface1 (gfc_interface *p, gfc_interface *q0,
 				       generic_flag, 0, NULL, 0, NULL, NULL))
 	  {
 	    if (referenced)
-	      gfc_error ("Ambiguous interfaces '%s' and '%s' in %s at %L",
+	      gfc_error ("Ambiguous interfaces %qs and %qs in %s at %L",
 			 p->sym->name, q->sym->name, interface_name,
 			 &p->where);
 	    else if (!p->sym->attr.use_assoc && q->sym->attr.use_assoc)
@@ -1687,7 +1687,7 @@ check_sym_interfaces (gfc_symbol *sym)
 	      && (p->sym->attr.if_source != IFSRC_DECL
 		  || p->sym->attr.procedure))
 	    {
-	      gfc_error ("'%s' at %L is not a module procedure",
+	      gfc_error ("%qs at %L is not a module procedure",
 			 p->sym->name, &p->where);
 	      return;
 	    }
@@ -1892,21 +1892,21 @@ argument_rank_mismatch (const char *name, locus *where,
   if (rank2 == -1)
     {
       gfc_error ("The assumed-rank array at %L requires that the dummy argument"
-		 " '%s' has assumed-rank", where, name);
+		 " %qs has assumed-rank", where, name);
     }
   else if (rank1 == 0)
     {
-      gfc_error ("Rank mismatch in argument '%s' at %L "
+      gfc_error ("Rank mismatch in argument %qs at %L "
 		 "(scalar and rank-%d)", name, where, rank2);
     }
   else if (rank2 == 0)
     {
-      gfc_error ("Rank mismatch in argument '%s' at %L "
+      gfc_error ("Rank mismatch in argument %qs at %L "
 		 "(rank-%d and scalar)", name, where, rank1);
     }
   else
     {
-      gfc_error ("Rank mismatch in argument '%s' at %L "
+      gfc_error ("Rank mismatch in argument %qs at %L "
 		 "(rank-%d and rank-%d)", name, where, rank1, rank2);
     }
 }
@@ -1956,7 +1956,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
 				   sizeof(err), NULL, NULL))
 	{
 	  if (where)
-	    gfc_error ("Interface mismatch in dummy procedure '%s' at %L: %s",
+	    gfc_error ("Interface mismatch in dummy procedure %qs at %L: %s",
 		       formal->name, &actual->where, err);
 	  return 0;
 	}
@@ -1981,7 +1981,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
       && !gfc_is_simply_contiguous (actual, true))
     {
       if (where)
-	gfc_error ("Actual argument to contiguous pointer dummy '%s' at %L "
+	gfc_error ("Actual argument to contiguous pointer dummy %qs at %L "
 		   "must be simply contiguous", formal->name, &actual->where);
       return 0;
     }
@@ -1996,7 +1996,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
 					 CLASS_DATA (actual)->ts.u.derived)))
     {
       if (where)
-	gfc_error ("Type mismatch in argument '%s' at %L; passed %s to %s",
+	gfc_error ("Type mismatch in argument %qs at %L; passed %s to %s",
 		   formal->name, &actual->where, gfc_typename (&actual->ts),
 		   gfc_typename (&formal->ts));
       return 0;
@@ -2006,7 +2006,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
     {
       if (where)
 	gfc_error ("Assumed-type actual argument at %L requires that dummy "
-		   "argument '%s' is of assumed type", &actual->where,
+		   "argument %qs is of assumed type", &actual->where,
 		   formal->name);
       return 0;
     }
@@ -2021,7 +2021,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
       if (actual->ts.type != BT_CLASS)
 	{
 	  if (where)
-	    gfc_error ("Actual argument to '%s' at %L must be polymorphic",
+	    gfc_error ("Actual argument to %qs at %L must be polymorphic",
 			formal->name, &actual->where);
 	  return 0;
 	}
@@ -2034,7 +2034,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
 					 CLASS_DATA (formal)->ts.u.derived))
 	{
 	  if (where)
-	    gfc_error ("Actual argument to '%s' at %L must have the same "
+	    gfc_error ("Actual argument to %qs at %L must have the same "
 		       "declared type", formal->name, &actual->where);
 	  return 0;
 	}
@@ -2049,7 +2049,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
 	  ||CLASS_DATA (formal)->attr.class_pointer))
     {
       if (where)
-	gfc_error ("Actual argument to '%s' at %L must be unlimited "
+	gfc_error ("Actual argument to %qs at %L must be unlimited "
 		   "polymorphic since the formal argument is a "
 		   "pointer or allocatable unlimited polymorphic "
 		   "entity [F2008: 12.5.2.5]", formal->name,
@@ -2060,7 +2060,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
   if (formal->attr.codimension && !gfc_is_coarray (actual))
     {
       if (where)
-	gfc_error ("Actual argument to '%s' at %L must be a coarray",
+	gfc_error ("Actual argument to %qs at %L must be a coarray",
 		       formal->name, &actual->where);
       return 0;
     }
@@ -2079,7 +2079,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
 	      && actual->symtree->n.sym->as->corank != formal->as->corank))
 	{
 	  if (where)
-	    gfc_error ("Corank mismatch in argument '%s' at %L (%d and %d)",
+	    gfc_error ("Corank mismatch in argument %qs at %L (%d and %d)",
 		   formal->name, &actual->where, formal->as->corank,
 		   last ? last->u.c.component->as->corank
 			: actual->symtree->n.sym->as->corank);
@@ -2096,7 +2096,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
 	  && !gfc_is_simply_contiguous (actual, true))
 	{
 	  if (where)
-	    gfc_error ("Actual argument to '%s' at %L must be simply "
+	    gfc_error ("Actual argument to %qs at %L must be simply "
 		       "contiguous", formal->name, &actual->where);
 	  return 0;
 	}
@@ -2110,7 +2110,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
 
     	{
 	  if (where)
-	    gfc_error ("Actual argument to non-INTENT(INOUT) dummy '%s' at %L, "
+	    gfc_error ("Actual argument to non-INTENT(INOUT) dummy %qs at %L, "
 		       "which is LOCK_TYPE or has a LOCK_TYPE component",
 		       formal->name, &actual->where);
 	  return 0;
@@ -2128,7 +2128,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
 	  || formal->attr.contiguous))
     {
       if (where)
-	gfc_error ("Dummy argument '%s' has to be a pointer, assumed-shape or "
+	gfc_error ("Dummy argument %qs has to be a pointer, assumed-shape or "
 		   "assumed-rank array without CONTIGUOUS attribute - as actual"
 		   " argument at %L is not simply contiguous and both are "
 		   "ASYNCHRONOUS or VOLATILE", formal->name, &actual->where);
@@ -2142,7 +2142,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
 	{
 	  if (where)
 	    gfc_error ("Passing coarray at %L to allocatable, noncoarray, "
-		       "INTENT(OUT) dummy argument '%s'", &actual->where,
+		       "INTENT(OUT) dummy argument %qs", &actual->where,
 		       formal->name);
 	    return 0;
 	}
@@ -2211,7 +2211,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
   if (actual->ts.type == BT_CLASS && actual->expr_type != EXPR_NULL)
     {
       if (where)
-	gfc_error ("Polymorphic scalar passed to array dummy argument '%s' "
+	gfc_error ("Polymorphic scalar passed to array dummy argument %qs "
 		   "at %L", formal->name, &actual->where);
       return 0;
     }
@@ -2221,7 +2221,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
     {
       if (where)
 	gfc_error ("Element of assumed-shaped or pointer "
-		   "array passed to array dummy argument '%s' at %L",
+		   "array passed to array dummy argument %qs at %L",
 		   formal->name, &actual->where);
       return 0;
     }
@@ -2234,14 +2234,14 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
 	  if (where)
 	    gfc_error ("Extension: Scalar non-default-kind, non-C_CHAR-kind "
 		       "CHARACTER actual argument with array dummy argument "
-		       "'%s' at %L", formal->name, &actual->where);
+		       "%qs at %L", formal->name, &actual->where);
 	  return 0;
 	}
 
       if (where && (gfc_option.allow_std & GFC_STD_F2003) == 0)
 	{
 	  gfc_error ("Fortran 2003: Scalar CHARACTER actual argument with "
-		     "array dummy argument '%s' at %L",
+		     "array dummy argument %qs at %L",
 		     formal->name, &actual->where);
 	  return 0;
 	}
@@ -2555,7 +2555,7 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
 	  if (f == NULL)
 	    {
 	      if (where)
-		gfc_error ("Keyword argument '%s' at %L is not in "
+		gfc_error ("Keyword argument %qs at %L is not in "
 			   "the procedure", a->name, &a->expr->where);
 	      return 0;
 	    }
@@ -2563,7 +2563,7 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
 	  if (new_arg[i] != NULL)
 	    {
 	      if (where)
-		gfc_error ("Keyword argument '%s' at %L is already associated "
+		gfc_error ("Keyword argument %qs at %L is already associated "
 			   "with another actual argument", a->name,
 			   &a->expr->where);
 	      return 0;
@@ -2620,11 +2620,11 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
 		  || (f->sym->ts.type != BT_CLASS && f->sym->attr.allocatable)
 		  || (f->sym->ts.type == BT_CLASS
 			 && CLASS_DATA (f->sym)->attr.allocatable)))
-	    gfc_error ("Unexpected NULL() intrinsic at %L to dummy '%s'",
+	    gfc_error ("Unexpected NULL() intrinsic at %L to dummy %qs",
 		       where, f->sym->name);
 	  else if (where)
 	    gfc_error ("Fortran 2008: Null pointer at %L to non-pointer "
-		       "dummy '%s'", where, f->sym->name);
+		       "dummy %qs", where, f->sym->name);
 
 	  return 0;
 	}
@@ -2690,7 +2690,7 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
 	{
 	  if (where)
 	    gfc_error ("Actual argument at %L to allocatable or "
-		       "pointer dummy argument '%s' must have a deferred "
+		       "pointer dummy argument %qs must have a deferred "
 		       "length type parameter if and only if the dummy has one",
 		       &a->expr->where, f->sym->name);
 	  return 0;
@@ -2730,7 +2730,7 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
 	       || gfc_is_proc_ptr_comp (a->expr)))
 	{
 	  if (where)
-	    gfc_error ("Expected a procedure pointer for argument '%s' at %L",
+	    gfc_error ("Expected a procedure pointer for argument %qs at %L",
 		       f->sym->name, &a->expr->where);
 	  return 0;
 	}
@@ -2741,7 +2741,7 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
 	  && gfc_expr_attr (a->expr).flavor != FL_PROCEDURE)
 	{
 	  if (where)
-	    gfc_error ("Expected a procedure for argument '%s' at %L",
+	    gfc_error ("Expected a procedure for argument %qs at %L",
 		       f->sym->name, &a->expr->where);
 	  return 0;
 	}
@@ -2755,7 +2755,7 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
 		  && a->expr->ref->u.ar.type == AR_FULL)))
 	{
 	  if (where)
-	    gfc_error ("Actual argument for '%s' cannot be an assumed-size"
+	    gfc_error ("Actual argument for %qs cannot be an assumed-size"
 		       " array at %L", f->sym->name, where);
 	  return 0;
 	}
@@ -2764,7 +2764,7 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
 	  && compare_pointer (f->sym, a->expr) == 0)
 	{
 	  if (where)
-	    gfc_error ("Actual argument for '%s' must be a pointer at %L",
+	    gfc_error ("Actual argument for %qs must be a pointer at %L",
 		       f->sym->name, &a->expr->where);
 	  return 0;
 	}
@@ -2775,7 +2775,7 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
 	{
 	  if (where)
 	    gfc_error ("Fortran 2008: Non-pointer actual argument at %L to "
-		       "pointer dummy '%s'", &a->expr->where,f->sym->name);
+		       "pointer dummy %qs", &a->expr->where,f->sym->name);
 	  return 0;
 	}
 
@@ -2785,7 +2785,7 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
 	{
 	  if (where)
 	    gfc_error ("Coindexed actual argument at %L to pointer "
-		       "dummy '%s'",
+		       "dummy %qs",
 		       &a->expr->where, f->sym->name);
 	  return 0;
 	}
@@ -2798,7 +2798,7 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
 	{
 	  if (where)
 	    gfc_error ("Coindexed actual argument at %L to allocatable "
-		       "dummy '%s' requires INTENT(IN)",
+		       "dummy %qs requires INTENT(IN)",
 		       &a->expr->where, f->sym->name);
 	  return 0;
 	}
@@ -2812,7 +2812,7 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
 	{
 	  if (where)
 	    gfc_error ("Coindexed ASYNCHRONOUS or VOLATILE actual argument at "
-		       "%L requires that dummy '%s' has neither "
+		       "%L requires that dummy %qs has neither "
 		       "ASYNCHRONOUS nor VOLATILE", &a->expr->where,
 		       f->sym->name);
 	  return 0;
@@ -2826,7 +2826,7 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
 	{
 	  if (where)
 	    gfc_error ("Coindexed actual argument at %L with allocatable "
-		       "ultimate component to dummy '%s' requires either VALUE "
+		       "ultimate component to dummy %qs requires either VALUE "
 		       "or INTENT(IN)", &a->expr->where, f->sym->name);
 	  return 0;
 	}
@@ -2837,7 +2837,7 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
 	   && !full_array)
 	{
 	  if (where)
-	    gfc_error ("Actual CLASS array argument for '%s' must be a full "
+	    gfc_error ("Actual CLASS array argument for %qs must be a full "
 		       "array at %L", f->sym->name, &a->expr->where);
 	  return 0;
 	}
@@ -2847,7 +2847,7 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
 	  && compare_allocatable (f->sym, a->expr) == 0)
 	{
 	  if (where)
-	    gfc_error ("Actual argument for '%s' must be ALLOCATABLE at %L",
+	    gfc_error ("Actual argument for %qs must be ALLOCATABLE at %L",
 		       f->sym->name, &a->expr->where);
 	  return 0;
 	}
@@ -2879,7 +2879,7 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
 	    gfc_error ("Array-section actual argument with vector "
 		       "subscripts at %L is incompatible with INTENT(OUT), "
 		       "INTENT(INOUT), VOLATILE or ASYNCHRONOUS attribute "
-		       "of the dummy argument '%s'",
+		       "of the dummy argument %qs",
 		       &a->expr->where, f->sym->name);
 	  return 0;
 	}
@@ -2896,7 +2896,7 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
 	  if (where)
 	    gfc_error ("Assumed-shape actual argument at %L is "
 		       "incompatible with the non-assumed-shape "
-		       "dummy argument '%s' due to VOLATILE attribute",
+		       "dummy argument %qs due to VOLATILE attribute",
 		       &a->expr->where,f->sym->name);
 	  return 0;
 	}
@@ -2908,7 +2908,7 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
 	  if (where)
 	    gfc_error ("Array-section actual argument at %L is "
 		       "incompatible with the non-assumed-shape "
-		       "dummy argument '%s' due to VOLATILE attribute",
+		       "dummy argument %qs due to VOLATILE attribute",
 		       &a->expr->where,f->sym->name);
 	  return 0;
 	}
@@ -2927,7 +2927,7 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
 	  if (where)
 	    gfc_error ("Pointer-array actual argument at %L requires "
 		       "an assumed-shape or pointer-array dummy "
-		       "argument '%s' due to VOLATILE attribute",
+		       "argument %qs due to VOLATILE attribute",
 		       &a->expr->where,f->sym->name);
 	  return 0;
 	}
@@ -2955,7 +2955,7 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
       if (!f->sym->attr.optional)
 	{
 	  if (where)
-	    gfc_error ("Missing actual argument for argument '%s' at %L",
+	    gfc_error ("Missing actual argument for argument %qs at %L",
 		       f->sym->name, where);
 	  return 0;
 	}
@@ -3226,7 +3226,7 @@ check_intents (gfc_formal_arglist *f, gfc_actual_arglist *a)
 	   && gfc_is_coindexed (expr))
 	 {
 	   gfc_error ("Coindexed polymorphic actual argument at %L is passed "
-		      "polymorphic dummy argument '%s'",
+		      "polymorphic dummy argument %qs",
 			 &expr->where, f->sym->name);
 	   return false;
 	 }
@@ -3253,7 +3253,7 @@ gfc_procedure_use (gfc_symbol *sym, gfc_actual_arglist **ap, locus *where)
     {
       if (sym->ns->has_implicit_none_export && sym->attr.proc == PROC_UNKNOWN)
 	{
-	  gfc_error ("Procedure '%s' called at %L is not explicitly declared",
+	  gfc_error ("Procedure %qs called at %L is not explicitly declared",
 		     sym->name, where);
 	  return false;
 	}
@@ -3273,24 +3273,24 @@ gfc_procedure_use (gfc_symbol *sym, gfc_actual_arglist **ap, locus *where)
 
       if (sym->attr.pointer)
 	{
-	  gfc_error("The pointer object '%s' at %L must have an explicit "
-		    "function interface or be declared as array",
-		    sym->name, where);
+	  gfc_error ("The pointer object %qs at %L must have an explicit "
+		     "function interface or be declared as array",
+		     sym->name, where);
 	  return false;
 	}
 
       if (sym->attr.allocatable && !sym->attr.external)
 	{
-	  gfc_error("The allocatable object '%s' at %L must have an explicit "
-		    "function interface or be declared as array",
-		    sym->name, where);
+	  gfc_error ("The allocatable object %qs at %L must have an explicit "
+		     "function interface or be declared as array",
+		     sym->name, where);
 	  return false;
 	}
 
       if (sym->attr.allocatable)
 	{
-	  gfc_error("Allocatable function '%s' at %L must have an explicit "
-		    "function interface", sym->name, where);
+	  gfc_error ("Allocatable function %qs at %L must have an explicit "
+		     "function interface", sym->name, where);
 	  return false;
 	}
 
@@ -3299,8 +3299,8 @@ gfc_procedure_use (gfc_symbol *sym, gfc_actual_arglist **ap, locus *where)
 	  /* Skip g77 keyword extensions like %VAL, %REF, %LOC.  */
 	  if (a->name != NULL && a->name[0] != '%')
 	    {
-	      gfc_error("Keyword argument requires explicit interface "
-			"for procedure '%s' at %L", sym->name, &a->expr->where);
+	      gfc_error ("Keyword argument requires explicit interface "
+			 "for procedure %qs at %L", sym->name, &a->expr->where);
 	      break;
 	    }
 
@@ -3321,9 +3321,9 @@ gfc_procedure_use (gfc_symbol *sym, gfc_actual_arglist **ap, locus *where)
 		   && a->expr->ts.u.derived->intmod_sym_id == ISOFORTRAN_LOCK_TYPE)
 		  || gfc_expr_attr (a->expr).lock_comp))
 	    {
-	      gfc_error("Actual argument of LOCK_TYPE or with LOCK_TYPE "
-			"component at %L requires an explicit interface for "
-			"procedure '%s'", &a->expr->where, sym->name);
+	      gfc_error ("Actual argument of LOCK_TYPE or with LOCK_TYPE "
+			 "component at %L requires an explicit interface for "
+			 "procedure %qs", &a->expr->where, sym->name);
 	      break;
 	    }
 
@@ -3387,9 +3387,9 @@ gfc_ppc_use (gfc_component *comp, gfc_actual_arglist **ap, locus *where)
 	  /* Skip g77 keyword extensions like %VAL, %REF, %LOC.  */
 	  if (a->name != NULL && a->name[0] != '%')
 	    {
-	      gfc_error("Keyword argument requires explicit interface "
-			"for procedure pointer component '%s' at %L",
-			comp->name, &a->expr->where);
+	      gfc_error ("Keyword argument requires explicit interface "
+			 "for procedure pointer component %qs at %L",
+			 comp->name, &a->expr->where);
 	      break;
 	    }
 	}
@@ -3913,7 +3913,7 @@ gfc_check_new_interface (gfc_interface *base, gfc_symbol *new_sym, locus loc)
     {
       if (ip->sym == new_sym)
 	{
-	  gfc_error ("Entity '%s' at %L is already present in the interface",
+	  gfc_error ("Entity %qs at %L is already present in the interface",
 		     new_sym->name, &loc);
 	  return false;
 	}
@@ -4124,7 +4124,7 @@ gfc_check_typebound_override (gfc_symtree* proc, gfc_symtree* old)
   /* If the overwritten procedure is GENERIC, this is an error.  */
   if (old->n.tb->is_generic)
     {
-      gfc_error ("Can't overwrite GENERIC '%s' at %L",
+      gfc_error ("Can't overwrite GENERIC %qs at %L",
 		 old->name, &proc->n.tb->where);
       return false;
     }
@@ -4136,7 +4136,7 @@ gfc_check_typebound_override (gfc_symtree* proc, gfc_symtree* old)
   /* Check that overridden binding is not NON_OVERRIDABLE.  */
   if (old->n.tb->non_overridable)
     {
-      gfc_error ("'%s' at %L overrides a procedure binding declared"
+      gfc_error ("%qs at %L overrides a procedure binding declared"
 		 " NON_OVERRIDABLE", proc->name, &where);
       return false;
     }
@@ -4144,7 +4144,7 @@ gfc_check_typebound_override (gfc_symtree* proc, gfc_symtree* old)
   /* It's an error to override a non-DEFERRED procedure with a DEFERRED one.  */
   if (!old->n.tb->deferred && proc->n.tb->deferred)
     {
-      gfc_error ("'%s' at %L must not be DEFERRED as it overrides a"
+      gfc_error ("%qs at %L must not be DEFERRED as it overrides a"
 		 " non-DEFERRED binding", proc->name, &where);
       return false;
     }
@@ -4152,7 +4152,7 @@ gfc_check_typebound_override (gfc_symtree* proc, gfc_symtree* old)
   /* If the overridden binding is PURE, the overriding must be, too.  */
   if (old_target->attr.pure && !proc_target->attr.pure)
     {
-      gfc_error ("'%s' at %L overrides a PURE procedure and must also be PURE",
+      gfc_error ("%qs at %L overrides a PURE procedure and must also be PURE",
 		 proc->name, &where);
       return false;
     }
@@ -4161,13 +4161,13 @@ gfc_check_typebound_override (gfc_symtree* proc, gfc_symtree* old)
      is not, the overriding must not be either.  */
   if (old_target->attr.elemental && !proc_target->attr.elemental)
     {
-      gfc_error ("'%s' at %L overrides an ELEMENTAL procedure and must also be"
+      gfc_error ("%qs at %L overrides an ELEMENTAL procedure and must also be"
 		 " ELEMENTAL", proc->name, &where);
       return false;
     }
   if (!old_target->attr.elemental && proc_target->attr.elemental)
     {
-      gfc_error ("'%s' at %L overrides a non-ELEMENTAL procedure and must not"
+      gfc_error ("%qs at %L overrides a non-ELEMENTAL procedure and must not"
 		 " be ELEMENTAL, either", proc->name, &where);
       return false;
     }
@@ -4176,7 +4176,7 @@ gfc_check_typebound_override (gfc_symtree* proc, gfc_symtree* old)
      SUBROUTINE.  */
   if (old_target->attr.subroutine && !proc_target->attr.subroutine)
     {
-      gfc_error ("'%s' at %L overrides a SUBROUTINE and must also be a"
+      gfc_error ("%qs at %L overrides a SUBROUTINE and must also be a"
 		 " SUBROUTINE", proc->name, &where);
       return false;
     }
@@ -4187,7 +4187,7 @@ gfc_check_typebound_override (gfc_symtree* proc, gfc_symtree* old)
     {
       if (!proc_target->attr.function)
 	{
-	  gfc_error ("'%s' at %L overrides a FUNCTION and must also be a"
+	  gfc_error ("%qs at %L overrides a FUNCTION and must also be a"
 		     " FUNCTION", proc->name, &where);
 	  return false;
 	}
@@ -4196,7 +4196,7 @@ gfc_check_typebound_override (gfc_symtree* proc, gfc_symtree* old)
 					 sizeof(err)))
 	{
 	  gfc_error ("Result mismatch for the overriding procedure "
-		     "'%s' at %L: %s", proc->name, &where, err);
+		     "%qs at %L: %s", proc->name, &where, err);
 	  return false;
 	}
     }
@@ -4206,7 +4206,7 @@ gfc_check_typebound_override (gfc_symtree* proc, gfc_symtree* old)
   if (old->n.tb->access == ACCESS_PUBLIC
       && proc->n.tb->access == ACCESS_PRIVATE)
     {
-      gfc_error ("'%s' at %L overrides a PUBLIC procedure and must not be"
+      gfc_error ("%qs at %L overrides a PUBLIC procedure and must not be"
 		 " PRIVATE", proc->name, &where);
       return false;
     }
@@ -4236,7 +4236,7 @@ gfc_check_typebound_override (gfc_symtree* proc, gfc_symtree* old)
       /* Check that the names correspond.  */
       if (strcmp (proc_formal->sym->name, old_formal->sym->name))
 	{
-	  gfc_error ("Dummy argument '%s' of '%s' at %L should be named '%s' as"
+	  gfc_error ("Dummy argument %qs of %qs at %L should be named %qs as"
 		     " to match the corresponding argument of the overridden"
 		     " procedure", proc_formal->sym->name, proc->name, &where,
 		     old_formal->sym->name);
@@ -4248,7 +4248,7 @@ gfc_check_typebound_override (gfc_symtree* proc, gfc_symtree* old)
 					check_type, err, sizeof(err)))
 	{
 	  gfc_error ("Argument mismatch for the overriding procedure "
-		     "'%s' at %L: %s", proc->name, &where, err);
+		     "%qs at %L: %s", proc->name, &where, err);
 	  return false;
 	}
 
@@ -4256,7 +4256,7 @@ gfc_check_typebound_override (gfc_symtree* proc, gfc_symtree* old)
     }
   if (proc_formal || old_formal)
     {
-      gfc_error ("'%s' at %L must have the same number of formal arguments as"
+      gfc_error ("%qs at %L must have the same number of formal arguments as"
 		 " the overridden procedure", proc->name, &where);
       return false;
     }
@@ -4265,7 +4265,7 @@ gfc_check_typebound_override (gfc_symtree* proc, gfc_symtree* old)
      NOPASS.  */
   if (old->n.tb->nopass && !proc->n.tb->nopass)
     {
-      gfc_error ("'%s' at %L overrides a NOPASS binding and must also be"
+      gfc_error ("%qs at %L overrides a NOPASS binding and must also be"
 		 " NOPASS", proc->name, &where);
       return false;
     }
@@ -4276,14 +4276,14 @@ gfc_check_typebound_override (gfc_symtree* proc, gfc_symtree* old)
     {
       if (proc->n.tb->nopass)
 	{
-	  gfc_error ("'%s' at %L overrides a binding with PASS and must also be"
+	  gfc_error ("%qs at %L overrides a binding with PASS and must also be"
 		     " PASS", proc->name, &where);
 	  return false;
 	}
 
       if (proc_pass_arg != old_pass_arg)
 	{
-	  gfc_error ("Passed-object dummy argument of '%s' at %L must be at"
+	  gfc_error ("Passed-object dummy argument of %qs at %L must be at"
 		     " the same position as the passed-object dummy argument of"
 		     " the overridden procedure", proc->name, &where);
 	  return false;
diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index baaa05a43b1..5abd02d6b46 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -3815,7 +3815,7 @@ sort_actual (const char *name, gfc_actual_arglist **ap,
   if (a == NULL)
     goto do_sort;
 
-  gfc_error ("Too many arguments in call to '%s' at %L", name, where);
+  gfc_error ("Too many arguments in call to %qs at %L", name, where);
   return false;
 
 keywords:
@@ -3833,14 +3833,14 @@ keywords:
 	    gfc_error ("The argument list functions %%VAL, %%LOC or %%REF "
 		       "are not allowed in this context at %L", where);
 	  else
-	    gfc_error ("Can't find keyword named '%s' in call to '%s' at %L",
+	    gfc_error ("Can't find keyword named %qs in call to %qs at %L",
 		       a->name, name, where);
 	  return false;
 	}
 
       if (f->actual != NULL)
 	{
-	  gfc_error ("Argument '%s' appears twice in call to '%s' at %L",
+	  gfc_error ("Argument %qs appears twice in call to %qs at %L",
 		     f->name, name, where);
 	  return false;
 	}
@@ -3854,7 +3854,7 @@ optional:
     {
       if (f->actual == NULL && f->optional == 0)
 	{
-	  gfc_error ("Missing actual argument '%s' in call to '%s' at %L",
+	  gfc_error ("Missing actual argument %qs in call to %qs at %L",
 		     f->name, name, where);
 	  return false;
 	}
@@ -3926,7 +3926,7 @@ check_arglist (gfc_actual_arglist **ap, gfc_intrinsic_sym *sym,
       if (!gfc_compare_types (&ts, &actual->expr->ts))
 	{
 	  if (error_flag)
-	    gfc_error ("Type of argument '%s' in call to '%s' at %L should "
+	    gfc_error ("Type of argument %qs in call to %qs at %L should "
 		       "be %s, not %s", gfc_current_intrinsic_arg[i]->name,
 		       gfc_current_intrinsic, &actual->expr->where,
 		       gfc_typename (&formal->ts),
@@ -4534,14 +4534,14 @@ gfc_intrinsic_sub_interface (gfc_code *c, int error_flag)
 
   if (gfc_do_concurrent_flag && !isym->pure)
     {
-      gfc_error ("Subroutine call to intrinsic '%s' in DO CONCURRENT "
+      gfc_error ("Subroutine call to intrinsic %qs in DO CONCURRENT "
 		 "block at %L is not PURE", name, &c->loc);
       return MATCH_ERROR;
     }
 
   if (!isym->pure && gfc_pure (NULL))
     {
-      gfc_error ("Subroutine call to intrinsic '%s' at %L is not PURE", name,
+      gfc_error ("Subroutine call to intrinsic %qs at %L is not PURE", name,
 		 &c->loc);
       return MATCH_ERROR;
     }
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index 3b81a464e74..e3226083bb9 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -3548,7 +3548,7 @@ alloc_opt_list:
 	  /* The next 2 conditionals check C631.  */
 	  if (ts.type != BT_UNKNOWN)
 	    {
-	      gfc_error ("SOURCE tag at %L conflicts with the typespec at %L",
+	      gfc_error_1 ("SOURCE tag at %L conflicts with the typespec at %L",
 			 &tmp->where, &old_locus);
 	      goto cleanup;
 	    }
@@ -3585,7 +3585,7 @@ alloc_opt_list:
 	  /* Check F08:C637.  */
 	  if (ts.type != BT_UNKNOWN)
 	    {
-	      gfc_error ("MOLD tag at %L conflicts with the typespec at %L",
+	      gfc_error_1 ("MOLD tag at %L conflicts with the typespec at %L",
 			 &tmp->where, &old_locus);
 	      goto cleanup;
 	    }
@@ -3611,7 +3611,7 @@ alloc_opt_list:
   /* Check F08:C637.  */
   if (source && mold)
     {
-      gfc_error ("MOLD tag at %L conflicts with SOURCE tag at %L",
+      gfc_error_1 ("MOLD tag at %L conflicts with SOURCE tag at %L",
 		  &mold->where, &source->where);
       goto cleanup;
     }
@@ -4315,7 +4315,7 @@ gfc_match_common (void)
 
 	  if (sym->attr.in_common)
 	    {
-	      gfc_error ("Symbol '%s' at %C is already in a COMMON block",
+	      gfc_error ("Symbol %qs at %C is already in a COMMON block",
 			 sym->name);
 	      goto cleanup;
 	    }
@@ -4838,7 +4838,9 @@ recursive_stmt_fcn (gfc_expr *e, gfc_symbol *sym)
 match
 gfc_match_st_function (void)
 {
-  gfc_error_buf old_error;
+  gfc_error_buf old_error_1;
+  output_buffer old_error;
+
   gfc_symbol *sym;
   gfc_expr *expr;
   match m;
@@ -4847,7 +4849,7 @@ gfc_match_st_function (void)
   if (m != MATCH_YES)
     return m;
 
-  gfc_push_error (&old_error);
+  gfc_push_error (&old_error, &old_error_1);
 
   if (!gfc_add_procedure (&sym->attr, PROC_ST_FUNCTION, sym->name, NULL))
     goto undo_error;
@@ -4859,7 +4861,8 @@ gfc_match_st_function (void)
   if (m == MATCH_NO)
     goto undo_error;
 
-  gfc_free_error (&old_error);
+  gfc_free_error (&old_error, &old_error_1);
+
   if (m == MATCH_ERROR)
     return m;
 
@@ -4877,7 +4880,7 @@ gfc_match_st_function (void)
   return MATCH_YES;
 
 undo_error:
-  gfc_pop_error (&old_error);
+  gfc_pop_error (&old_error, &old_error_1);
   return MATCH_NO;
 }
 
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 3ee0f9252d8..b0309fc6bb2 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -2326,31 +2326,31 @@ resolve_omp_clauses (gfc_code *code, locus *where,
 	      {
 		bool bad = false;
 		if (n->sym->attr.threadprivate)
-		  gfc_error ("THREADPRIVATE object '%s' in %s clause at %L",
+		  gfc_error ("THREADPRIVATE object %qs in %s clause at %L",
 			     n->sym->name, name, where);
 		if (n->sym->attr.cray_pointee)
-		  gfc_error ("Cray pointee '%s' in %s clause at %L",
+		  gfc_error ("Cray pointee %qs in %s clause at %L",
 			    n->sym->name, name, where);
 		if (n->sym->attr.associate_var)
-		  gfc_error ("ASSOCIATE name '%s' in %s clause at %L",
+		  gfc_error ("ASSOCIATE name %qs in %s clause at %L",
 			     n->sym->name, name, where);
 		if (list != OMP_LIST_PRIVATE)
 		  {
 		    if (n->sym->attr.proc_pointer && list == OMP_LIST_REDUCTION)
-		      gfc_error ("Procedure pointer '%s' in %s clause at %L",
+		      gfc_error ("Procedure pointer %qs in %s clause at %L",
 				 n->sym->name, name, where);
 		    if (n->sym->attr.pointer && list == OMP_LIST_REDUCTION)
-		      gfc_error ("POINTER object '%s' in %s clause at %L",
+		      gfc_error ("POINTER object %qs in %s clause at %L",
 				 n->sym->name, name, where);
 		    if (n->sym->attr.cray_pointer && list == OMP_LIST_REDUCTION)
-		      gfc_error ("Cray pointer '%s' in %s clause at %L",
+		      gfc_error ("Cray pointer %qs in %s clause at %L",
 				 n->sym->name, name, where);
 		  }
 		if (n->sym->as && n->sym->as->type == AS_ASSUMED_SIZE)
-		  gfc_error ("Assumed size array '%s' in %s clause at %L",
+		  gfc_error ("Assumed size array %qs in %s clause at %L",
 			     n->sym->name, name, where);
 		if (n->sym->attr.in_namelist && list != OMP_LIST_REDUCTION)
-		  gfc_error ("Variable '%s' in %s clause is used in "
+		  gfc_error ("Variable %qs in %s clause is used in "
 			     "NAMELIST statement at %L",
 			     n->sym->name, name, where);
 		if (n->sym->attr.pointer && n->sym->attr.intent == INTENT_IN)
@@ -2360,7 +2360,7 @@ resolve_omp_clauses (gfc_code *code, locus *where,
 		    case OMP_LIST_LASTPRIVATE:
 		    case OMP_LIST_LINEAR:
 		    /* case OMP_LIST_REDUCTION: */
-		      gfc_error ("INTENT(IN) POINTER '%s' in %s clause at %L",
+		      gfc_error ("INTENT(IN) POINTER %qs in %s clause at %L",
 				 n->sym->name, name, where);
 		      break;
 		    default:
@@ -2475,10 +2475,10 @@ resolve_omp_clauses (gfc_code *code, locus *where,
 		    break;
 		  case OMP_LIST_LINEAR:
 		    if (n->sym->ts.type != BT_INTEGER)
-		      gfc_error ("LINEAR variable '%s' must be INTEGER "
+		      gfc_error ("LINEAR variable %qs must be INTEGER "
 				 "at %L", n->sym->name, where);
 		    else if (!code && !n->sym->attr.value)
-		      gfc_error ("LINEAR dummy argument '%s' must have VALUE "
+		      gfc_error ("LINEAR dummy argument %qs must have VALUE "
 				 "attribute at %L", n->sym->name, where);
 		    else if (n->expr)
 		      {
@@ -2486,11 +2486,11 @@ resolve_omp_clauses (gfc_code *code, locus *where,
 			if (!gfc_resolve_expr (expr)
 			    || expr->ts.type != BT_INTEGER
 			    || expr->rank != 0)
-			  gfc_error ("'%s' in LINEAR clause at %L requires "
+			  gfc_error ("%qs in LINEAR clause at %L requires "
 				     "a scalar integer linear-step expression",
 				     n->sym->name, where);
 			else if (!code && expr->expr_type != EXPR_CONSTANT)
-			  gfc_error ("'%s' in LINEAR clause at %L requires "
+			  gfc_error ("%qs in LINEAR clause at %L requires "
 				     "a constant integer linear-step expression",
 				     n->sym->name, where);
 		      }
@@ -2931,7 +2931,7 @@ resolve_omp_atomic (gfc_code *code)
 	  else if (expr_references_sym (arg->expr, var, NULL))
 	    {
 	      gfc_error ("!$OMP ATOMIC intrinsic arguments except one must "
-			 "not reference '%s' at %L",
+			 "not reference %qs at %L",
 			 var->name, &arg->expr->where);
 	      return;
 	    }
@@ -2946,7 +2946,7 @@ resolve_omp_atomic (gfc_code *code)
       if (var_arg == NULL)
 	{
 	  gfc_error ("First or last !$OMP ATOMIC intrinsic argument must "
-		     "be '%s' at %L", var->name, &expr2->where);
+		     "be %qs at %L", var->name, &expr2->where);
 	  return;
 	}
 
@@ -3414,7 +3414,7 @@ gfc_resolve_omp_declare_simd (gfc_namespace *ns)
     {
       if (ods->proc_name != ns->proc_name)
 	gfc_error ("!$OMP DECLARE SIMD should refer to containing procedure "
-		   "'%s' at %L", ns->proc_name->name, &ods->where);
+		   "%qs at %L", ns->proc_name->name, &ods->where);
       if (ods->clauses)
 	resolve_omp_clauses (NULL, &ods->where, ods->clauses, ns);
     }
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index e39a5508de2..970815ec8a0 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -107,13 +107,14 @@ match_word_omp_simd (const char *str, match (*subr) (void), locus *old_locus,
 static void
 use_modules (void)
 {
-  gfc_error_buf old_error;
+  gfc_error_buf old_error_1;
+  output_buffer old_error;
 
-  gfc_push_error (&old_error);
+  gfc_push_error (&old_error, &old_error_1);
   gfc_buffer_error (false);
   gfc_use_modules ();
   gfc_buffer_error (true);
-  gfc_pop_error (&old_error);
+  gfc_pop_error (&old_error, &old_error_1);
   gfc_commit_symbols ();
   gfc_warning_check ();
   gfc_current_ns->old_cl_list = gfc_current_ns->cl_list;
@@ -2202,7 +2203,7 @@ verify_st_order (st_state *p, gfc_statement st, bool silent)
 
 order:
   if (!silent)
-    gfc_error ("%s statement at %C cannot follow %s statement at %L",
+    gfc_error_1 ("%s statement at %C cannot follow %s statement at %L",
 	       gfc_ascii_statement (st),
 	       gfc_ascii_statement (p->last_statement), &p->where);
 
@@ -2579,7 +2580,7 @@ endType:
 		   "subcomponent exists)", c->name, &c->loc, sym->name);
 
       if (sym->attr.lock_comp && coarray && !lock_type)
-	gfc_error ("Noncoarray component %s at %L of type LOCK_TYPE or with "
+	gfc_error_1 ("Noncoarray component %s at %L of type LOCK_TYPE or with "
 		   "subcomponent of type LOCK_TYPE must have a codimension or "
 		   "be a subcomponent of a coarray. (Variables of type %s may "
 		   "not have a codimension as %s at %L has a codimension or a "
@@ -3281,7 +3282,7 @@ parse_if_block (void)
 	case ST_ELSEIF:
 	  if (seen_else)
 	    {
-	      gfc_error ("ELSE IF statement at %C cannot follow ELSE "
+	      gfc_error_1 ("ELSE IF statement at %C cannot follow ELSE "
 			 "statement at %L", &else_locus);
 
 	      reject_statement ();
@@ -4674,10 +4675,10 @@ gfc_global_used (gfc_gsymbol *sym, locus *where)
     }
 
   if (sym->binding_label)
-    gfc_error ("Global binding name '%s' at %L is already being used as a %s "
+    gfc_error_1 ("Global binding name '%s' at %L is already being used as a %s "
 	       "at %L", sym->binding_label, where, name, &sym->where);
   else
-    gfc_error ("Global name '%s' at %L is already being used as a %s at %L",
+    gfc_error_1 ("Global name '%s' at %L is already being used as a %s at %L",
 	       sym->name, where, name, &sym->where);
 }
 
diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c
index 10ea61af306..a9bf65840fe 100644
--- a/gcc/fortran/primary.c
+++ b/gcc/fortran/primary.c
@@ -1274,7 +1274,8 @@ static match
 match_complex_constant (gfc_expr **result)
 {
   gfc_expr *e, *real, *imag;
-  gfc_error_buf old_error;
+  gfc_error_buf old_error_1;
+  output_buffer old_error;
   gfc_typespec target;
   locus old_loc;
   int kind;
@@ -1287,18 +1288,18 @@ match_complex_constant (gfc_expr **result)
   if (m != MATCH_YES)
     return m;
 
-  gfc_push_error (&old_error);
+  gfc_push_error (&old_error, &old_error_1);
 
   m = match_complex_part (&real);
   if (m == MATCH_NO)
     {
-      gfc_free_error (&old_error);
+      gfc_free_error (&old_error, &old_error_1);
       goto cleanup;
     }
 
   if (gfc_match_char (',') == MATCH_NO)
     {
-      gfc_pop_error (&old_error);
+      gfc_pop_error (&old_error, &old_error_1);
       m = MATCH_NO;
       goto cleanup;
     }
@@ -1310,10 +1311,10 @@ match_complex_constant (gfc_expr **result)
 
   if (m == MATCH_ERROR)
     {
-      gfc_free_error (&old_error);
+      gfc_free_error (&old_error, &old_error_1);
       goto cleanup;
     }
-  gfc_pop_error (&old_error);
+  gfc_pop_error (&old_error, &old_error_1);
 
   m = match_complex_part (&imag);
   if (m == MATCH_NO)
@@ -2493,7 +2494,7 @@ gfc_convert_to_structure_constructor (gfc_expr *e, gfc_symbol *sym, gfc_expr **c
 	  gcc_assert (comp_iter);
 	  if (!strcmp (comp_iter->name, comp_tail->name))
 	    {
-	      gfc_error ("Component '%s' is initialized twice in the structure"
+	      gfc_error ("Component %qs is initialized twice in the structure"
 			 " constructor at %L!", comp_tail->name,
 			 comp_tail->val ? &comp_tail->where
 					: &gfc_current_locus);
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 6571578ecac..32709437a2e 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -469,7 +469,7 @@ resolve_formal_arglist (gfc_symbol *proc)
 	      || (sym->ts.type == BT_CLASS && CLASS_DATA (sym)
 		  && CLASS_DATA (sym)->attr.class_pointer))
 	    {
-	      gfc_error ("Argument '%s' of elemental procedure at %L cannot "
+	      gfc_error ("Argument %qs of elemental procedure at %L cannot "
 			 "have the POINTER attribute", sym->name,
 			 &sym->declared_at);
 	      continue;
@@ -477,8 +477,8 @@ resolve_formal_arglist (gfc_symbol *proc)
 
 	  if (sym->attr.flavor == FL_PROCEDURE)
 	    {
-	      gfc_error ("Dummy procedure '%s' not allowed in elemental "
-			 "procedure '%s' at %L", sym->name, proc->name,
+	      gfc_error ("Dummy procedure %qs not allowed in elemental "
+			 "procedure %qs at %L", sym->name, proc->name,
 			 &sym->declared_at);
 	      continue;
 	    }
@@ -486,7 +486,7 @@ resolve_formal_arglist (gfc_symbol *proc)
 	  /* Fortran 2008 Corrigendum 1, C1290a.  */
 	  if (sym->attr.intent == INTENT_UNKNOWN && !sym->attr.value)
 	    {
-	      gfc_error ("Argument '%s' of elemental procedure '%s' at %L must "
+	      gfc_error ("Argument %qs of elemental procedure %qs at %L must "
 			 "have its INTENT specified or have the VALUE "
 			 "attribute", sym->name, proc->name,
 			 &sym->declared_at);
@@ -499,7 +499,7 @@ resolve_formal_arglist (gfc_symbol *proc)
 	{
 	  if (sym->as != NULL)
 	    {
-	      gfc_error ("Argument '%s' of statement function at %L must "
+	      gfc_error ("Argument %qs of statement function at %L must "
 			 "be scalar", sym->name, &sym->declared_at);
 	      continue;
 	    }
@@ -509,7 +509,7 @@ resolve_formal_arglist (gfc_symbol *proc)
 	      gfc_charlen *cl = sym->ts.u.cl;
 	      if (!cl || !cl->length || cl->length->expr_type != EXPR_CONSTANT)
 		{
-		  gfc_error ("Character-valued argument '%s' of statement "
+		  gfc_error ("Character-valued argument %qs of statement "
 			     "function at %L must have constant length",
 			     sym->name, &sym->declared_at);
 		  continue;
@@ -567,10 +567,10 @@ resolve_contained_fntype (gfc_symbol *sym, gfc_namespace *ns)
       if (!t && !sym->result->attr.untyped)
 	{
 	  if (sym->result == sym)
-	    gfc_error ("Contained function '%s' at %L has no IMPLICIT type",
+	    gfc_error ("Contained function %qs at %L has no IMPLICIT type",
 		       sym->name, &sym->declared_at);
 	  else if (!sym->result->attr.proc_pointer)
-	    gfc_error ("Result '%s' of contained function '%s' at %L has "
+	    gfc_error ("Result %qs of contained function %qs at %L has "
 		       "no IMPLICIT type", sym->result->name, sym->name,
 		       &sym->result->declared_at);
 	  sym->result->attr.untyped = 1;
@@ -594,7 +594,7 @@ resolve_contained_fntype (gfc_symbol *sym, gfc_namespace *ns)
 	  gcc_assert (ns->parent && ns->parent->proc_name);
 	  module_proc = (ns->parent->proc_name->attr.flavor == FL_MODULE);
 
-	  gfc_error ("Character-valued %s '%s' at %L must not be"
+	  gfc_error ("Character-valued %s %qs at %L must not be"
 		     " assumed length",
 		     module_proc ? _("module procedure")
 				 : _("internal function"),
@@ -984,7 +984,7 @@ resolve_common_blocks (gfc_symtree *common_root)
 	      || (!common_root->n.common->binding_label
 		  && gsym->binding_label)))
 	{
-	  gfc_error ("In Fortran 2003 COMMON '%s' block at %L is a global "
+	  gfc_error_1 ("In Fortran 2003 COMMON '%s' block at %L is a global "
 		     "identifier and must thus have the same binding name "
 		     "as the same-named COMMON block at %L: %s vs %s",
 		     common_root->n.common->name, &common_root->n.common->where,
@@ -998,7 +998,7 @@ resolve_common_blocks (gfc_symtree *common_root)
       if (gsym && gsym->type != GSYM_COMMON
 	  && !common_root->n.common->binding_label)
 	{
-	  gfc_error ("COMMON block '%s' at %L uses the same global identifier "
+	  gfc_error_1 ("COMMON block '%s' at %L uses the same global identifier "
 		     "as entity at %L",
 		     common_root->n.common->name, &common_root->n.common->where,
 		     &gsym->where);
@@ -1006,7 +1006,7 @@ resolve_common_blocks (gfc_symtree *common_root)
 	}
       if (gsym && gsym->type != GSYM_COMMON)
 	{
-	  gfc_error ("Fortran 2008: COMMON block '%s' with binding label at "
+	  gfc_error_1 ("Fortran 2008: COMMON block '%s' with binding label at "
 		     "%L sharing the identifier with global non-COMMON-block "
 		     "entity at %L", common_root->n.common->name,
 		     &common_root->n.common->where, &gsym->where);
@@ -1028,7 +1028,7 @@ resolve_common_blocks (gfc_symtree *common_root)
 			       common_root->n.common->binding_label);
       if (gsym && gsym->type != GSYM_COMMON)
 	{
-	  gfc_error ("COMMON block at %L with binding label %s uses the same "
+	  gfc_error_1 ("COMMON block at %L with binding label %s uses the same "
 		     "global identifier as entity at %L",
 		     &common_root->n.common->where,
 		     common_root->n.common->binding_label, &gsym->where);
@@ -1049,15 +1049,15 @@ resolve_common_blocks (gfc_symtree *common_root)
     return;
 
   if (sym->attr.flavor == FL_PARAMETER)
-    gfc_error ("COMMON block '%s' at %L is used as PARAMETER at %L",
+    gfc_error_1 ("COMMON block '%s' at %L is used as PARAMETER at %L",
 	       sym->name, &common_root->n.common->where, &sym->declared_at);
 
   if (sym->attr.external)
-    gfc_error ("COMMON block '%s' at %L can not have the EXTERNAL attribute",
+    gfc_error ("COMMON block %qs at %L can not have the EXTERNAL attribute",
 	       sym->name, &common_root->n.common->where);
 
   if (sym->attr.intrinsic)
-    gfc_error ("COMMON block '%s' at %L is also an intrinsic procedure",
+    gfc_error ("COMMON block %qs at %L is also an intrinsic procedure",
 	       sym->name, &common_root->n.common->where);
   else if (sym->attr.result
 	   || gfc_is_function_return_value (sym, gfc_current_ns))
@@ -1171,7 +1171,7 @@ resolve_structure_cons (gfc_expr *expr, int init)
 	  else if (comp->attr.pointer && cons->expr->ts.type != BT_UNKNOWN)
 	    {
 	      gfc_error ("The element in the structure constructor at %L, "
-			 "for pointer component '%s', is %s but should be %s",
+			 "for pointer component %qs, is %s but should be %s",
 			 &cons->expr->where, comp->name,
 			 gfc_basic_typename (cons->expr->ts.type),
 			 gfc_basic_typename (comp->ts.type));
@@ -1256,7 +1256,7 @@ resolve_structure_cons (gfc_expr *expr, int init)
 	{
 	  t = false;
 	  gfc_error ("The NULL in the structure constructor at %L is "
-		     "being applied to component '%s', which is neither "
+		     "being applied to component %qs, which is neither "
 		     "a POINTER nor ALLOCATABLE", &cons->expr->where,
 		     comp->name);
 	}
@@ -1290,7 +1290,7 @@ resolve_structure_cons (gfc_expr *expr, int init)
 					     err, sizeof (err), NULL, NULL))
 	    {
 	      gfc_error ("Interface mismatch for procedure-pointer component "
-			 "'%s' in structure constructor at %L: %s",
+			 "%qs in structure constructor at %L: %s",
 			 comp->name, &cons->expr->where, err);
 	      return false;
 	    }
@@ -1306,7 +1306,7 @@ resolve_structure_cons (gfc_expr *expr, int init)
 	{
 	  t = false;
 	  gfc_error ("The element in the structure constructor at %L, "
-		     "for pointer component '%s' should be a POINTER or "
+		     "for pointer component %qs should be a POINTER or "
 		     "a TARGET", &cons->expr->where, comp->name);
 	}
 
@@ -1335,7 +1335,7 @@ resolve_structure_cons (gfc_expr *expr, int init)
 	{
 	  t = false;
 	  gfc_error ("Invalid expression in the structure constructor for "
-		     "pointer component '%s' at %L in PURE procedure",
+		     "pointer component %qs at %L in PURE procedure",
 		     comp->name, &cons->expr->where);
 	}
 
@@ -1461,7 +1461,7 @@ check_assumed_size_reference (gfc_symbol *sym, gfc_expr *e)
     {
       gfc_error ("The upper bound in the last dimension must "
 		 "appear in the reference to the assumed size "
-		 "array '%s' at %L", sym->name, &e->where);
+		 "array %qs at %L", sym->name, &e->where);
       return true;
     }
   return false;
@@ -1521,11 +1521,11 @@ count_specific_procs (gfc_expr *e)
       }
 
   if (n > 1)
-    gfc_error ("'%s' at %L is ambiguous", e->symtree->n.sym->name,
+    gfc_error ("%qs at %L is ambiguous", e->symtree->n.sym->name,
 	       &e->where);
 
   if (n == 0)
-    gfc_error ("GENERIC procedure '%s' is not allowed as an actual "
+    gfc_error ("GENERIC procedure %qs is not allowed as an actual "
 	       "argument at %L", sym->name, &e->where);
 
   return n;
@@ -1659,7 +1659,7 @@ gfc_resolve_intrinsic (gfc_symbol *sym, locus *loc)
     {
       if (sym->ts.type != BT_UNKNOWN && !sym->attr.implicit_type)
 	{
-	  gfc_error ("Intrinsic subroutine '%s' at %L shall not have a type"
+	  gfc_error ("Intrinsic subroutine %qs at %L shall not have a type"
 		      " specifier", sym->name, &sym->declared_at);
 	  return false;
 	}
@@ -1670,7 +1670,7 @@ gfc_resolve_intrinsic (gfc_symbol *sym, locus *loc)
     }
   else
     {
-      gfc_error ("'%s' declared INTRINSIC at %L does not exist", sym->name,
+      gfc_error ("%qs declared INTRINSIC at %L does not exist", sym->name,
 		 &sym->declared_at);
       return false;
     }
@@ -1683,7 +1683,7 @@ gfc_resolve_intrinsic (gfc_symbol *sym, locus *loc)
   /* Check it is actually available in the standard settings.  */
   if (!gfc_check_intrinsic_standard (isym, &symstd, false, sym->declared_at))
     {
-      gfc_error ("The intrinsic '%s' declared INTRINSIC at %L is not"
+      gfc_error ("The intrinsic %qs declared INTRINSIC at %L is not"
 		 " available in the current standard settings but %s.  Use"
 		 " an appropriate -std=* option or enable -fall-intrinsics"
 		 " in order to use it.",
@@ -1800,7 +1800,7 @@ resolve_actual_arglist (gfc_actual_arglist *arg, procedure_type ptype,
 
 	  if (sym->attr.proc == PROC_ST_FUNCTION)
 	    {
-	      gfc_error ("Statement function '%s' at %L is not allowed as an "
+	      gfc_error ("Statement function %qs at %L is not allowed as an "
 			 "actual argument", sym->name, &e->where);
 	    }
 
@@ -1808,7 +1808,7 @@ resolve_actual_arglist (gfc_actual_arglist *arg, procedure_type ptype,
 					       sym->attr.subroutine);
 	  if (sym->attr.intrinsic && actual_ok == 0)
 	    {
-	      gfc_error ("Intrinsic '%s' at %L is not allowed as an "
+	      gfc_error ("Intrinsic %qs at %L is not allowed as an "
 			 "actual argument", sym->name, &e->where);
 	    }
 
@@ -1823,7 +1823,7 @@ resolve_actual_arglist (gfc_actual_arglist *arg, procedure_type ptype,
 
 	  if (sym->attr.elemental && !sym->attr.intrinsic)
 	    {
-	      gfc_error ("ELEMENTAL non-INTRINSIC procedure '%s' is not "
+	      gfc_error ("ELEMENTAL non-INTRINSIC procedure %qs is not "
 			 "allowed as an actual argument at %L", sym->name,
 			 &e->where);
 	    }
@@ -1851,7 +1851,7 @@ resolve_actual_arglist (gfc_actual_arglist *arg, procedure_type ptype,
 	      if (isym == NULL || !isym->specific)
 		{
 		  gfc_error ("Unable to find a specific INTRINSIC procedure "
-			     "for the reference '%s' at %L", sym->name,
+			     "for the reference %qs at %L", sym->name,
 			     &e->where);
 		  goto cleanup;
 		}
@@ -1872,7 +1872,7 @@ resolve_actual_arglist (gfc_actual_arglist *arg, procedure_type ptype,
 
       if (gfc_find_sym_tree (sym->name, sym->ns->parent, 1, &parent_st))
 	{
-	  gfc_error ("Symbol '%s' at %L is ambiguous", sym->name, &e->where);
+	  gfc_error ("Symbol %qs at %L is ambiguous", sym->name, &e->where);
 	  goto cleanup;
 	}
 
@@ -2139,8 +2139,8 @@ resolve_elemental_actual (gfc_expr *expr, gfc_code *c)
 	   || eformal->sym->attr.intent == INTENT_INOUT)
 	  && arg->expr && arg->expr->rank == 0)
 	{
-	  gfc_error ("Actual argument at %L for INTENT(%s) dummy '%s' of "
-		     "ELEMENTAL subroutine '%s' is a scalar, but another "
+	  gfc_error ("Actual argument at %L for INTENT(%s) dummy %qs of "
+		     "ELEMENTAL subroutine %qs is a scalar, but another "
 		     "actual argument is an array", &arg->expr->where,
 		     (eformal->sym->attr.intent == INTENT_OUT) ? "OUT"
 		     : "INOUT", eformal->sym->name, esym->name);
@@ -2416,7 +2416,7 @@ resolve_global_procedure (gfc_symbol *sym, locus *where,
 
       if (sym->attr.function && !gfc_compare_types (&sym->ts, &def_sym->ts))
 	{
-	  gfc_error ("Return type mismatch of function '%s' at %L (%s/%s)",
+	  gfc_error ("Return type mismatch of function %qs at %L (%s/%s)",
 		     sym->name, &sym->declared_at, gfc_typename (&sym->ts),
 		     gfc_typename (&def_sym->ts));
 	  goto done;
@@ -2425,7 +2425,7 @@ resolve_global_procedure (gfc_symbol *sym, locus *where,
       if (sym->attr.if_source == IFSRC_UNKNOWN
 	  && gfc_explicit_interface_required (def_sym, reason, sizeof(reason)))
 	{
-	  gfc_error ("Explicit interface required for '%s' at %L: %s",
+	  gfc_error ("Explicit interface required for %qs at %L: %s",
 		     sym->name, &sym->declared_at, reason);
 	  goto done;
 	}
@@ -2437,7 +2437,7 @@ resolve_global_procedure (gfc_symbol *sym, locus *where,
       if (!gfc_compare_interfaces (sym, def_sym, sym->name, 0, 1,
 				   reason, sizeof(reason), NULL, NULL))
 	{
-	  gfc_error ("Interface mismatch in global procedure '%s' at %L: %s ",
+	  gfc_error ("Interface mismatch in global procedure %qs at %L: %s ",
 		    sym->name, &sym->declared_at, reason);
 	  goto done;
 	}
@@ -2545,7 +2545,7 @@ generic:
      that possesses a matching interface.  14.1.2.4  */
   if (sym  && !intr && !gfc_is_intrinsic (sym, 0, expr->where))
     {
-      gfc_error ("There is no specific function for the generic '%s' "
+      gfc_error ("There is no specific function for the generic %qs "
 		 "at %L", expr->symtree->n.sym->name, &expr->where);
       return false;
     }
@@ -2563,7 +2563,7 @@ generic:
     return true;
 
   if (m == MATCH_NO)
-    gfc_error ("Generic function '%s' at %L is not consistent with a "
+    gfc_error ("Generic function %qs at %L is not consistent with a "
 	       "specific intrinsic interface", expr->symtree->n.sym->name,
 	       &expr->where);
 
@@ -2601,7 +2601,7 @@ resolve_specific_f0 (gfc_symbol *sym, gfc_expr *expr)
       if (m == MATCH_YES)
 	return MATCH_YES;
       if (m == MATCH_NO)
-	gfc_error ("Function '%s' at %L is INTRINSIC but is not compatible "
+	gfc_error ("Function %qs at %L is INTRINSIC but is not compatible "
 		   "with an intrinsic", sym->name, &expr->where);
 
       return MATCH_ERROR;
@@ -2652,7 +2652,7 @@ resolve_specific_f (gfc_expr *expr)
 	break;
     }
 
-  gfc_error ("Unable to resolve the specific function '%s' at %L",
+  gfc_error ("Unable to resolve the specific function %qs at %L",
 	     expr->symtree->n.sym->name, &expr->where);
 
   return true;
@@ -2708,7 +2708,7 @@ set_type:
 
       if (ts->type == BT_UNKNOWN)
 	{
-	  gfc_error ("Function '%s' at %L has no IMPLICIT type",
+	  gfc_error ("Function %qs at %L has no IMPLICIT type",
 		     sym->name, &expr->where);
 	  return false;
 	}
@@ -2829,7 +2829,7 @@ resolve_function (gfc_expr *expr)
 
   if (sym && (sym->attr.flavor == FL_VARIABLE || sym->attr.subroutine))
     {
-      gfc_error ("'%s' at %L is not a function", sym->name, &expr->where);
+      gfc_error ("%qs at %L is not a function", sym->name, &expr->where);
       return false;
     }
 
@@ -2837,7 +2837,7 @@ resolve_function (gfc_expr *expr)
      of course be referenced), expr->value.function.esym will be set.  */
   if (sym && sym->attr.abstract && !expr->value.function.esym)
     {
-      gfc_error ("ABSTRACT INTERFACE '%s' must not be referenced at %L",
+      gfc_error ("ABSTRACT INTERFACE %qs must not be referenced at %L",
 		 sym->name, &expr->where);
       return false;
     }
@@ -2880,7 +2880,7 @@ resolve_function (gfc_expr *expr)
       && !sym->attr.contained)
     {
       /* Internal procedures are taken care of in resolve_contained_fntype.  */
-      gfc_error ("Function '%s' is declared CHARACTER(*) and cannot "
+      gfc_error ("Function %qs is declared CHARACTER(*) and cannot "
 		 "be used at %L since it is not a dummy argument",
 		 sym->name, &expr->where);
       return false;
@@ -2934,7 +2934,7 @@ resolve_function (gfc_expr *expr)
       && expr->value.function.esym
       && ! gfc_elemental (expr->value.function.esym))
     {
-      gfc_error ("User defined non-ELEMENTAL function '%s' at %L not allowed "
+      gfc_error ("User defined non-ELEMENTAL function %qs at %L not allowed "
 		 "in WORKSHARE construct", expr->value.function.esym->name,
 		 &expr->where);
       t = false;
@@ -2988,21 +2988,21 @@ resolve_function (gfc_expr *expr)
     {
       if (forall_flag)
 	{
-	  gfc_error ("Reference to non-PURE function '%s' at %L inside a "
+	  gfc_error ("Reference to non-PURE function %qs at %L inside a "
 		     "FORALL %s", name, &expr->where,
 		     forall_flag == 2 ? "mask" : "block");
 	  t = false;
 	}
       else if (gfc_do_concurrent_flag)
 	{
-	  gfc_error ("Reference to non-PURE function '%s' at %L inside a "
+	  gfc_error ("Reference to non-PURE function %qs at %L inside a "
 		     "DO CONCURRENT %s", name, &expr->where,
 		     gfc_do_concurrent_flag == 2 ? "mask" : "block");
 	  t = false;
 	}
       else if (gfc_pure (NULL))
 	{
-	  gfc_error ("Function reference to '%s' at %L is to a non-PURE "
+	  gfc_error ("Function reference to %qs at %L is to a non-PURE "
 		     "procedure within a PURE procedure", name, &expr->where);
 	  t = false;
 	}
@@ -3020,11 +3020,11 @@ resolve_function (gfc_expr *expr)
       if (is_illegal_recursion (esym, gfc_current_ns))
       {
 	if (esym->attr.entry && esym->ns->entries)
-	  gfc_error ("ENTRY '%s' at %L cannot be called recursively, as"
-		     " function '%s' is not RECURSIVE",
+	  gfc_error ("ENTRY %qs at %L cannot be called recursively, as"
+		     " function %qs is not RECURSIVE",
 		     esym->name, &expr->where, esym->ns->entries->sym->name);
 	else
-	  gfc_error ("Function '%s' at %L cannot be called recursively, as it"
+	  gfc_error ("Function %qs at %L cannot be called recursively, as it"
 		     " is not RECURSIVE", esym->name, &expr->where);
 
 	t = false;
@@ -3063,13 +3063,13 @@ pure_subroutine (gfc_code *c, gfc_symbol *sym)
     return;
 
   if (forall_flag)
-    gfc_error ("Subroutine call to '%s' in FORALL block at %L is not PURE",
+    gfc_error ("Subroutine call to %qs in FORALL block at %L is not PURE",
 	       sym->name, &c->loc);
   else if (gfc_do_concurrent_flag)
-    gfc_error ("Subroutine call to '%s' in DO CONCURRENT block at %L is not "
+    gfc_error ("Subroutine call to %qs in DO CONCURRENT block at %L is not "
 	       "PURE", sym->name, &c->loc);
   else if (gfc_pure (NULL))
-    gfc_error ("Subroutine call to '%s' at %L is not PURE", sym->name,
+    gfc_error ("Subroutine call to %qs at %L is not PURE", sym->name,
 	       &c->loc);
 
   gfc_unset_implicit_pure (NULL);
@@ -3134,7 +3134,7 @@ generic:
 
   if (!gfc_is_intrinsic (sym, 1, c->loc))
     {
-      gfc_error ("There is no specific subroutine for the generic '%s' at %L",
+      gfc_error ("There is no specific subroutine for the generic %qs at %L",
 		 sym->name, &c->loc);
       return false;
     }
@@ -3143,7 +3143,7 @@ generic:
   if (m == MATCH_YES)
     return true;
   if (m == MATCH_NO)
-    gfc_error ("Generic subroutine '%s' at %L is not consistent with an "
+    gfc_error ("Generic subroutine %qs at %L is not consistent with an "
 	       "intrinsic subroutine interface", sym->name, &c->loc);
 
   return false;
@@ -3178,7 +3178,7 @@ resolve_specific_s0 (gfc_code *c, gfc_symbol *sym)
       if (m == MATCH_YES)
 	return MATCH_YES;
       if (m == MATCH_NO)
-	gfc_error ("Subroutine '%s' at %L is INTRINSIC but is not compatible "
+	gfc_error ("Subroutine %qs at %L is INTRINSIC but is not compatible "
 		   "with an intrinsic", sym->name, &c->loc);
 
       return MATCH_ERROR;
@@ -3222,7 +3222,7 @@ resolve_specific_s (gfc_code *c)
     }
 
   sym = c->symtree->n.sym;
-  gfc_error ("Unable to resolve the specific subroutine '%s' at %L",
+  gfc_error ("Unable to resolve the specific subroutine %qs at %L",
 	     sym->name, &c->loc);
 
   return false;
@@ -3282,7 +3282,7 @@ resolve_call (gfc_code *c)
 
   if (csym && csym->ts.type != BT_UNKNOWN)
     {
-      gfc_error ("'%s' at %L has a type, which is not consistent with "
+      gfc_error_1 ("'%s' at %L has a type, which is not consistent with "
 		 "the CALL at %L", csym->name, &csym->declared_at, &c->loc);
       return false;
     }
@@ -3311,7 +3311,7 @@ resolve_call (gfc_code *c)
     {
       if (csym->attr.abstract)
 	{
-	  gfc_error ("ABSTRACT INTERFACE '%s' must not be referenced at %L",
+	  gfc_error ("ABSTRACT INTERFACE %qs must not be referenced at %L",
 		    csym->name, &c->loc);
 	  return false;
 	}
@@ -3321,11 +3321,11 @@ resolve_call (gfc_code *c)
       if (is_illegal_recursion (csym, gfc_current_ns))
 	{
 	  if (csym->attr.entry && csym->ns->entries)
-	    gfc_error ("ENTRY '%s' at %L cannot be called recursively, "
-		       "as subroutine '%s' is not RECURSIVE",
+	    gfc_error ("ENTRY %qs at %L cannot be called recursively, "
+		       "as subroutine %qs is not RECURSIVE",
 		       csym->name, &c->loc, csym->ns->entries->sym->name);
 	  else
-	    gfc_error ("SUBROUTINE '%s' at %L cannot be called recursively, "
+	    gfc_error ("SUBROUTINE %qs at %L cannot be called recursively, "
 		       "as it is not RECURSIVE", csym->name, &c->loc);
 
 	  t = false;
@@ -3402,7 +3402,7 @@ compare_shapes (gfc_expr *op1, gfc_expr *op2)
 	{
 	  if (mpz_cmp (op1->shape[i], op2->shape[i]) != 0)
 	   {
-	     gfc_error ("Shapes for operands at %L and %L are not conformable",
+	     gfc_error_1 ("Shapes for operands at %L and %L are not conformable",
 			 &op1->where, &op2->where);
 	     t = false;
 	     break;
@@ -6676,7 +6676,7 @@ conformable_arrays (gfc_expr *e1, gfc_expr *e2)
 
 	  if (mpz_cmp (e1->shape[i], s) != 0)
 	    {
-	      gfc_error ("Source-expr at %L and allocate-object at %L must "
+	      gfc_error_1 ("Source-expr at %L and allocate-object at %L must "
 			 "have the same shape", &e1->where, &e2->where);
 	      mpz_clear (s);
    	      return false;
@@ -6834,8 +6834,8 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code)
       /* Check F03:C631.  */
       if (!gfc_type_compatible (&e->ts, &code->expr3->ts))
 	{
-	  gfc_error ("Type of entity at %L is type incompatible with "
-		      "source-expr at %L", &e->where, &code->expr3->where);
+	  gfc_error_1 ("Type of entity at %L is type incompatible with "
+		       "source-expr at %L", &e->where, &code->expr3->where);
 	  goto failure;
 	}
 
@@ -6846,7 +6846,7 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code)
       /* Check F03:C633.  */
       if (code->expr3->ts.kind != e->ts.kind && !unlimited)
 	{
-	  gfc_error ("The allocate-object at %L and the source-expr at %L "
+	  gfc_error_1 ("The allocate-object at %L and the source-expr at %L "
 		      "shall have the same kind type parameter",
 		      &e->where, &code->expr3->where);
 	  goto failure;
@@ -6860,7 +6860,7 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code)
 		  && code->expr3->ts.u.derived->intmod_sym_id
 		     == ISOFORTRAN_LOCK_TYPE)))
 	{
-	  gfc_error ("The source-expr at %L shall neither be of type "
+	  gfc_error_1 ("The source-expr at %L shall neither be of type "
 		     "LOCK_TYPE nor have a LOCK_TYPE component if "
 		      "allocate-object at %L is a coarray",
 		      &code->expr3->where, &e->where);
@@ -7204,20 +7204,20 @@ resolve_allocate_deallocate (gfc_code *code, const char *fcn)
 		{
 		  if (pr == NULL && qr == NULL)
 		    {
-		      gfc_error ("Allocate-object at %L also appears at %L",
-				 &pe->where, &qe->where);
+		      gfc_error_1 ("Allocate-object at %L also appears at %L",
+				   &pe->where, &qe->where);
 		      break;
 		    }
 		  else if (pr != NULL && qr == NULL)
 		    {
-		      gfc_error ("Allocate-object at %L is subobject of"
-				 " object at %L", &pe->where, &qe->where);
+		      gfc_error_1 ("Allocate-object at %L is subobject of"
+				   " object at %L", &pe->where, &qe->where);
 		      break;
 		    }
 		  else if (pr == NULL && qr != NULL)
 		    {
-		      gfc_error ("Allocate-object at %L is subobject of"
-				 " object at %L", &qe->where, &pe->where);
+		      gfc_error_1 ("Allocate-object at %L is subobject of"
+				   " object at %L", &qe->where, &pe->where);
 		      break;
 		    }
 		  /* Here, pr != NULL && qr != NULL  */
@@ -7420,7 +7420,7 @@ check_case_overlap (gfc_case *list)
 			 element in the list.  Either way, we must
 			 issue an error and get the next case from P.  */
 		      /* FIXME: Sort P and Q by line number.  */
-		      gfc_error ("CASE label at %L overlaps with CASE "
+		      gfc_error_1 ("CASE label at %L overlaps with CASE "
 				 "label at %L", &p->where, &q->where);
 		      overlap_seen = 1;
 		      e = p;
@@ -7658,7 +7658,7 @@ resolve_select (gfc_code *code, bool select_type)
 	    {
 	      if (default_case != NULL)
 		{
-		  gfc_error ("The DEFAULT CASE at %L cannot be followed "
+		  gfc_error_1 ("The DEFAULT CASE at %L cannot be followed "
 			     "by a second DEFAULT CASE at %L",
 			     &default_case->where, &cp->where);
 		  t = false;
@@ -8028,7 +8028,7 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns)
 	  /* Check F03:C818.  */
 	  if (default_case)
 	    {
-	      gfc_error ("The DEFAULT CASE at %L cannot be followed "
+	      gfc_error_1 ("The DEFAULT CASE at %L cannot be followed "
 			 "by a second DEFAULT CASE at %L",
 			 &default_case->ext.block.case_list->where, &c->where);
 	      error++;
@@ -8586,7 +8586,7 @@ resolve_branch (gfc_st_label *label, gfc_code *code)
 
   if (label->defined != ST_LABEL_TARGET && label->defined != ST_LABEL_DO_TARGET)
     {
-      gfc_error ("Statement at %L is not a valid branch target statement "
+      gfc_error_1 ("Statement at %L is not a valid branch target statement "
 		 "for the branch statement at %L", &label->where, &code->loc);
       return;
     }
@@ -8612,11 +8612,11 @@ resolve_branch (gfc_st_label *label, gfc_code *code)
 	{
 	  if (stack->current->op == EXEC_CRITICAL
 	      && bitmap_bit_p (stack->reachable_labels, label->value))
-	    gfc_error ("GOTO statement at %L leaves CRITICAL construct for "
+	    gfc_error_1 ("GOTO statement at %L leaves CRITICAL construct for "
 		      "label at %L", &code->loc, &label->where);
 	  else if (stack->current->op == EXEC_DO_CONCURRENT
 		   && bitmap_bit_p (stack->reachable_labels, label->value))
-	    gfc_error ("GOTO statement at %L leaves DO CONCURRENT construct "
+	    gfc_error_1 ("GOTO statement at %L leaves DO CONCURRENT construct "
 		      "for label at %L", &code->loc, &label->where);
 	}
 
@@ -8635,13 +8635,13 @@ resolve_branch (gfc_st_label *label, gfc_code *code)
 	{
 	  /* Note: A label at END CRITICAL does not leave the CRITICAL
 	     construct as END CRITICAL is still part of it.  */
-	  gfc_error ("GOTO statement at %L leaves CRITICAL construct for label"
+	  gfc_error_1 ("GOTO statement at %L leaves CRITICAL construct for label"
 		      " at %L", &code->loc, &label->where);
 	  return;
 	}
       else if (stack->current->op == EXEC_DO_CONCURRENT)
 	{
-	  gfc_error ("GOTO statement at %L leaves DO CONCURRENT construct for "
+	  gfc_error_1 ("GOTO statement at %L leaves DO CONCURRENT construct for "
 		     "label at %L", &code->loc, &label->where);
 	  return;
 	}
@@ -10001,7 +10001,7 @@ gfc_resolve_code (gfc_code *code, gfc_namespace *ns)
 		gfc_error ("ASSIGNED GOTO statement at %L requires an "
 			   "INTEGER variable", &code->expr1->where);
 	      else if (code->expr1->symtree->n.sym->attr.assign != 1)
-		gfc_error ("Variable '%s' has not been assigned a target "
+		gfc_error ("Variable %qs has not been assigned a target "
 			   "label at %L", code->expr1->symtree->n.sym->name,
 			   &code->expr1->where);
 	    }
@@ -10386,7 +10386,7 @@ gfc_verify_binding_labels (gfc_symbol *sym)
 
   if (sym->attr.flavor == FL_VARIABLE && gsym->type != GSYM_UNKNOWN)
     {
-      gfc_error ("Variable %s with binding label %s at %L uses the same global "
+      gfc_error_1 ("Variable %s with binding label %s at %L uses the same global "
 		 "identifier as entity at %L", sym->name,
 		 sym->binding_label, &sym->declared_at, &gsym->where);
       /* Clear the binding label to prevent checking multiple times.  */
@@ -10399,8 +10399,8 @@ gfc_verify_binding_labels (gfc_symbol *sym)
     {
       /* This can only happen if the variable is defined in a module - if it
 	 isn't the same module, reject it.  */
-      gfc_error ("Variable %s from module %s with binding label %s at %L uses "
-		 "the same global identifier as entity at %L from module %s",
+      gfc_error_1 ("Variable %s from module %s with binding label %s at %L uses "
+		   "the same global identifier as entity at %L from module %s",
 		 sym->name, module, sym->binding_label,
 		 &sym->declared_at, &gsym->where, gsym->mod_name);
       sym->binding_label = NULL;
@@ -10416,7 +10416,7 @@ gfc_verify_binding_labels (gfc_symbol *sym)
       /* Print an error if the procedure is defined multiple times; we have to
 	 exclude references to the same procedure via module association or
 	 multiple checks for the same procedure.  */
-      gfc_error ("Procedure %s with binding label %s at %L uses the same "
+      gfc_error_1 ("Procedure %s with binding label %s at %L uses the same "
 		 "global identifier as entity at %L", sym->name,
 		 sym->binding_label, &sym->declared_at, &gsym->where);
       sym->binding_label = NULL;
@@ -10916,7 +10916,7 @@ resolve_fl_variable_derived (gfc_symbol *sym, int no_init_flag)
 	s = gfc_find_dt_in_generic (s);
       if (s && s->attr.flavor != FL_DERIVED)
 	{
-	  gfc_error ("The type '%s' cannot be host associated at %L "
+	  gfc_error_1 ("The type '%s' cannot be host associated at %L "
 		     "because it is blocked by an incompatible object "
 		     "of the same name declared at %L",
 		     sym->ts.u.derived->name, &sym->declared_at,
@@ -12335,7 +12335,7 @@ resolve_fl_derived0 (gfc_symbol *sym)
 	  && c->attr.codimension
 	  && (!c->attr.allocatable || (c->as && c->as->type != AS_DEFERRED)))
 	{
-	  gfc_error ("Coarray component '%s' at %L must be allocatable with "
+	  gfc_error ("Coarray component %qs at %L must be allocatable with "
 		     "deferred shape", c->name, &c->loc);
 	  return false;
 	}
@@ -12344,7 +12344,7 @@ resolve_fl_derived0 (gfc_symbol *sym)
       if (c->attr.codimension && c->ts.type == BT_DERIVED
 	  && c->ts.u.derived->ts.is_iso_c)
 	{
-	  gfc_error ("Component '%s' at %L of TYPE(C_PTR) or TYPE(C_FUNPTR) "
+	  gfc_error ("Component %qs at %L of TYPE(C_PTR) or TYPE(C_FUNPTR) "
 		     "shall not be a coarray", c->name, &c->loc);
 	  return false;
 	}
@@ -12354,7 +12354,7 @@ resolve_fl_derived0 (gfc_symbol *sym)
 	  && (c->attr.codimension || c->attr.pointer || c->attr.dimension
 	      || c->attr.allocatable))
 	{
-	  gfc_error ("Component '%s' at %L with coarray component "
+	  gfc_error ("Component %qs at %L with coarray component "
 		     "shall be a nonpointer, nonallocatable scalar",
 		     c->name, &c->loc);
 	  return false;
@@ -12363,7 +12363,7 @@ resolve_fl_derived0 (gfc_symbol *sym)
       /* F2008, C448.  */
       if (c->attr.contiguous && (!c->attr.dimension || !c->attr.pointer))
 	{
-	  gfc_error ("Component '%s' at %L has the CONTIGUOUS attribute but "
+	  gfc_error ("Component %qs at %L has the CONTIGUOUS attribute but "
 		     "is not an array pointer", c->name, &c->loc);
 	  return false;
 	}
@@ -12456,8 +12456,8 @@ resolve_fl_derived0 (gfc_symbol *sym)
 
 	      if (!me_arg)
 		{
-		  gfc_error ("Procedure pointer component '%s' with PASS(%s) "
-			     "at %L has no argument '%s'", c->name,
+		  gfc_error ("Procedure pointer component %qs with PASS(%s) "
+			     "at %L has no argument %qs", c->name,
 			     c->tb->pass_arg, &c->loc, c->tb->pass_arg);
 		  c->tb->error = 1;
 		  return false;
@@ -12470,7 +12470,7 @@ resolve_fl_derived0 (gfc_symbol *sym)
 	      c->tb->pass_arg_num = 1;
 	      if (!c->ts.interface->formal)
 		{
-		  gfc_error ("Procedure pointer component '%s' with PASS at %L "
+		  gfc_error ("Procedure pointer component %qs with PASS at %L "
 			     "must have at least one argument",
 			     c->name, &c->loc);
 		  c->tb->error = 1;
@@ -12486,8 +12486,8 @@ resolve_fl_derived0 (gfc_symbol *sym)
 	      || (me_arg->ts.type == BT_CLASS
 		  && CLASS_DATA (me_arg)->ts.u.derived != sym))
 	    {
-	      gfc_error ("Argument '%s' of '%s' with PASS(%s) at %L must be of"
-			 " the derived type '%s'", me_arg->name, c->name,
+	      gfc_error ("Argument %qs of %qs with PASS(%s) at %L must be of"
+			 " the derived type %qs", me_arg->name, c->name,
 			 me_arg->name, &c->loc, sym->name);
 	      c->tb->error = 1;
 	      return false;
@@ -12496,7 +12496,7 @@ resolve_fl_derived0 (gfc_symbol *sym)
 	  /* Check for C453.  */
 	  if (me_arg->attr.dimension)
 	    {
-	      gfc_error ("Argument '%s' of '%s' with PASS(%s) at %L "
+	      gfc_error ("Argument %qs of %qs with PASS(%s) at %L "
 			 "must be scalar", me_arg->name, c->name, me_arg->name,
 			 &c->loc);
 	      c->tb->error = 1;
@@ -12505,7 +12505,7 @@ resolve_fl_derived0 (gfc_symbol *sym)
 
 	  if (me_arg->attr.pointer)
 	    {
-	      gfc_error ("Argument '%s' of '%s' with PASS(%s) at %L "
+	      gfc_error ("Argument %qs of %qs with PASS(%s) at %L "
 			 "may not have the POINTER attribute", me_arg->name,
 			 c->name, me_arg->name, &c->loc);
 	      c->tb->error = 1;
@@ -12514,7 +12514,7 @@ resolve_fl_derived0 (gfc_symbol *sym)
 
 	  if (me_arg->attr.allocatable)
 	    {
-	      gfc_error ("Argument '%s' of '%s' with PASS(%s) at %L "
+	      gfc_error ("Argument %qs of %qs with PASS(%s) at %L "
 			 "may not be ALLOCATABLE", me_arg->name, c->name,
 			 me_arg->name, &c->loc);
 	      c->tb->error = 1;
@@ -12522,7 +12522,7 @@ resolve_fl_derived0 (gfc_symbol *sym)
 	    }
 
 	  if (gfc_type_is_extensible (sym) && me_arg->ts.type != BT_CLASS)
-	    gfc_error ("Non-polymorphic passed-object dummy argument of '%s'"
+	    gfc_error ("Non-polymorphic passed-object dummy argument of %qs"
 		       " at %L", c->name, &c->loc);
 
 	}
@@ -12551,7 +12551,7 @@ resolve_fl_derived0 (gfc_symbol *sym)
       if (super_type && !sym->attr.is_class
 	  && gfc_find_typebound_proc (super_type, NULL, c->name, true, NULL))
 	{
-	  gfc_error ("Component '%s' of '%s' at %L has the same name as an"
+	  gfc_error ("Component %qs of %qs at %L has the same name as an"
 		     " inherited type-bound procedure",
 		     c->name, sym->name, &c->loc);
 	  return false;
@@ -12564,7 +12564,7 @@ resolve_fl_derived0 (gfc_symbol *sym)
 	     || (!resolve_charlen(c->ts.u.cl))
 	     || !gfc_is_constant_expr (c->ts.u.cl->length))
 	   {
-	     gfc_error ("Character length of component '%s' needs to "
+	     gfc_error ("Character length of component %qs needs to "
 			"be a constant specification expression at %L",
 			c->name,
 			c->ts.u.cl->length ? &c->ts.u.cl->length->where : &c->loc);
@@ -12575,7 +12575,7 @@ resolve_fl_derived0 (gfc_symbol *sym)
       if (c->ts.type == BT_CHARACTER && c->ts.deferred
 	  && !c->attr.pointer && !c->attr.allocatable)
 	{
-	  gfc_error ("Character component '%s' of '%s' at %L with deferred "
+	  gfc_error ("Character component %qs of %qs at %L with deferred "
 		     "length must be a POINTER or ALLOCATABLE",
 		     c->name, sym->name, &c->loc);
 	  return false;
@@ -12641,7 +12641,7 @@ resolve_fl_derived0 (gfc_symbol *sym)
 	  && c->attr.pointer && c->ts.u.derived->components == NULL
 	  && !c->ts.u.derived->attr.zero_comp)
 	{
-	  gfc_error ("The pointer component '%s' of '%s' at %L is a type "
+	  gfc_error ("The pointer component %qs of %qs at %L is a type "
 		     "that has not been declared", c->name, sym->name,
 		     &c->loc);
 	  return false;
@@ -12653,7 +12653,7 @@ resolve_fl_derived0 (gfc_symbol *sym)
 	  && !CLASS_DATA (c)->ts.u.derived->attr.zero_comp
 	  && !UNLIMITED_POLY (c))
 	{
-	  gfc_error ("The pointer component '%s' of '%s' at %L is a type "
+	  gfc_error ("The pointer component %qs of %qs at %L is a type "
 		     "that has not been declared", c->name, sym->name,
 		     &c->loc);
 	  return false;
@@ -12665,7 +12665,7 @@ resolve_fl_derived0 (gfc_symbol *sym)
 	      || !(CLASS_DATA (c)->attr.class_pointer
 		   || CLASS_DATA (c)->attr.allocatable)))
 	{
-	  gfc_error ("Component '%s' with CLASS at %L must be allocatable "
+	  gfc_error ("Component %qs with CLASS at %L must be allocatable "
 		     "or pointer", c->name, &c->loc);
 	  /* Prevent a recurrence of the error.  */
 	  c->ts.type = BT_UNKNOWN;
@@ -13317,7 +13317,7 @@ resolve_symbol (gfc_symbol *sym)
       if (sym->ns->proc_name->attr.flavor != FL_MODULE &&
           sym->attr.in_common == 0)
 	{
-	  gfc_error ("Variable '%s' at %L cannot be BIND(C) because it "
+	  gfc_error ("Variable %qs at %L cannot be BIND(C) because it "
 		     "is neither a COMMON block nor declared at the "
 		     "module level scope", sym->name, &(sym->declared_at));
 	  t = false;
diff --git a/gcc/fortran/scanner.c b/gcc/fortran/scanner.c
index 718c323a5cc..6a37036fb7d 100644
--- a/gcc/fortran/scanner.c
+++ b/gcc/fortran/scanner.c
@@ -2045,6 +2045,7 @@ load_file (const char *realfilename, const char *displayedname, bool initial)
       b = XCNEWVAR (gfc_linebuf, gfc_linebuf_header_size
 		    + (len + 1) * sizeof (gfc_char_t));
 
+
       b->location
 	= linemap_line_start (line_table, current_file->line++, len);
       /* ??? We add the location for the maximum column possible here,
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index 92a15d06c86..aab144a3ea4 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -1701,18 +1701,18 @@ gfc_add_type (gfc_symbol *sym, gfc_typespec *ts, locus *where)
   if (type != BT_UNKNOWN && !(sym->attr.function && sym->attr.implicit_type))
     {
       if (sym->attr.use_assoc)
-	gfc_error ("Symbol '%s' at %L conflicts with symbol from module '%s', "
+	gfc_error_1 ("Symbol '%s' at %L conflicts with symbol from module '%s', "
 		   "use-associated at %L", sym->name, where, sym->module,
 		   &sym->declared_at);
       else
-	gfc_error ("Symbol '%s' at %L already has basic type of %s", sym->name,
+	gfc_error ("Symbol %qs at %L already has basic type of %s", sym->name,
 		 where, gfc_basic_typename (type));
       return false;
     }
 
   if (sym->attr.procedure && sym->ts.interface)
     {
-      gfc_error ("Procedure '%s' at %L may not have basic type of %s",
+      gfc_error ("Procedure %qs at %L may not have basic type of %s",
 		 sym->name, where, gfc_basic_typename (ts->type));
       return false;
     }
@@ -1895,7 +1895,7 @@ gfc_add_component (gfc_symbol *sym, const char *name,
     {
       if (strcmp (p->name, name) == 0)
 	{
-	  gfc_error ("Component '%s' at %C already declared at %L",
+	  gfc_error_1 ("Component '%s' at %C already declared at %L",
 		     name, &p->loc);
 	  return false;
 	}
@@ -1906,7 +1906,7 @@ gfc_add_component (gfc_symbol *sym, const char *name,
   if (sym->attr.extension
 	&& gfc_find_component (sym->components->ts.u.derived, name, true, true))
     {
-      gfc_error ("Component '%s' at %C already in the parent type "
+      gfc_error_1 ("Component '%s' at %C already in the parent type "
 		 "at %L", name, &sym->components->ts.u.derived->declared_at);
       return false;
     }
@@ -2061,7 +2061,7 @@ gfc_find_component (gfc_symbol *sym, const char *name,
 	   && !is_parent_comp))
 	{
 	  if (!silent)
-	    gfc_error ("Component '%s' at %C is a PRIVATE component of '%s'",
+	    gfc_error ("Component %qs at %C is a PRIVATE component of %qs",
 		       name, sym->name);
 	  return NULL;
 	}
@@ -2079,7 +2079,7 @@ gfc_find_component (gfc_symbol *sym, const char *name,
     }
 
   if (p == NULL && !silent)
-    gfc_error ("'%s' at %C is not a member of the '%s' structure",
+    gfc_error ("%qs at %C is not a member of the %qs structure",
 	       name, sym->name);
 
   return p;
@@ -2218,7 +2218,7 @@ gfc_define_st_label (gfc_st_label *lp, gfc_sl_type type, locus *label_locus)
   labelno = lp->value;
 
   if (lp->defined != ST_LABEL_UNKNOWN)
-    gfc_error ("Duplicate statement label %d at %L and %L", labelno,
+    gfc_error_1 ("Duplicate statement label %d at %L and %L", labelno,
 	       &lp->where, label_locus);
   else
     {
@@ -2628,10 +2628,10 @@ ambiguous_symbol (const char *name, gfc_symtree *st)
 {
 
   if (st->n.sym->module)
-    gfc_error ("Name '%s' at %C is an ambiguous reference to '%s' "
-	       "from module '%s'", name, st->n.sym->name, st->n.sym->module);
+    gfc_error ("Name %qs at %C is an ambiguous reference to %qs "
+	       "from module %qs", name, st->n.sym->name, st->n.sym->module);
   else
-    gfc_error ("Name '%s' at %C is an ambiguous reference to '%s' "
+    gfc_error ("Name %qs at %C is an ambiguous reference to %qs "
 	       "from current program unit", name, st->n.sym->name);
 }
 
@@ -2852,7 +2852,7 @@ gfc_get_sym_tree (const char *name, gfc_namespace *ns, gfc_symtree **result,
 	  && (ns->has_import_set || p->attr.imported)))
 	{
 	  /* Symbol is from another namespace.  */
-	  gfc_error ("Symbol '%s' at %C has already been host associated",
+	  gfc_error ("Symbol %qs at %C has already been host associated",
 		     name);
 	  return 2;
 	}
@@ -3895,7 +3895,7 @@ verify_bind_c_derived_type (gfc_symbol *derived_sym)
          J3/04-007, Section 15.2.3, C1505.	*/
       if (curr_comp->attr.pointer != 0)
         {
-          gfc_error ("Component '%s' at %L cannot have the "
+          gfc_error_1 ("Component '%s' at %L cannot have the "
                      "POINTER attribute because it is a member "
                      "of the BIND(C) derived type '%s' at %L",
                      curr_comp->name, &(curr_comp->loc),
@@ -3905,7 +3905,7 @@ verify_bind_c_derived_type (gfc_symbol *derived_sym)
 
       if (curr_comp->attr.proc_pointer != 0)
 	{
-	  gfc_error ("Procedure pointer component '%s' at %L cannot be a member"
+	  gfc_error_1 ("Procedure pointer component '%s' at %L cannot be a member"
 		     " of the BIND(C) derived type '%s' at %L", curr_comp->name,
 		     &curr_comp->loc, derived_sym->name,
 		     &derived_sym->declared_at);
@@ -3916,7 +3916,7 @@ verify_bind_c_derived_type (gfc_symbol *derived_sym)
          J3/04-007, Section 15.2.3, C1505.	*/
       if (curr_comp->attr.allocatable != 0)
         {
-          gfc_error ("Component '%s' at %L cannot have the "
+          gfc_error_1 ("Component '%s' at %L cannot have the "
                      "ALLOCATABLE attribute because it is a member "
                      "of the BIND(C) derived type '%s' at %L",
                      curr_comp->name, &(curr_comp->loc),
diff --git a/gcc/fortran/trans-common.c b/gcc/fortran/trans-common.c
index f5d831f31b1..a7d89c28988 100644
--- a/gcc/fortran/trans-common.c
+++ b/gcc/fortran/trans-common.c
@@ -908,7 +908,7 @@ confirm_condition (segment_info *s1, gfc_equiv *eq1, segment_info *s2,
   offset2 = calculate_offset (eq2->expr);
 
   if (s1->offset + offset1 != s2->offset + offset2)
-    gfc_error ("Inconsistent equivalence rules involving '%s' at %L and "
+    gfc_error_1 ("Inconsistent equivalence rules involving '%s' at %L and "
 	       "'%s' at %L", s1->sym->name, &s1->sym->declared_at,
 	       s2->sym->name, &s2->sym->declared_at);
 }