[fortran/diagnostics] Move gfc_error (buffered) to common diagnostics

OK, this is then the final patch. Bootstrapped and regression tested
on x86_64-linux-gnu.

OK to commit?


gcc/ChangeLog:

2014-12-07  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.
    (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-07  Manuel López-Ibáñez  <manu@gcc.gnu.org>

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

gcc/fortran/ChangeLog:

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

    PR fortran/44054
    * error.c (pp_error_buffer): New static variable.
    (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.
    (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): Init pp_error_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.

Index: gcc/fortran/openmp.c
===================================================================
--- gcc/fortran/openmp.c	(revision 218457)
+++ gcc/fortran/openmp.c	(working copy)
@@ -2324,45 +2324,45 @@ resolve_omp_clauses (gfc_code *code, loc
 	  default:
 	    for (; n != NULL; n = n->next)
 	      {
 		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)
 		  switch (list)
 		    {
 		    case OMP_LIST_PRIVATE:
 		    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:
 		      break;
 		    }
@@ -2473,26 +2473,26 @@ resolve_omp_clauses (gfc_code *code, loc
 			  }
 		      }
 		    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)
 		      {
 			gfc_expr *expr = n->expr;
 			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);
 		      }
 		    break;
 		  /* Workaround for PR middle-end/26316, nothing really needs
@@ -2929,11 +2929,11 @@ resolve_omp_atomic (gfc_code *code)
 	      && arg->expr->symtree->n.sym == var)
 	    var_arg = arg;
 	  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;
 	    }
 	  if (arg->expr->rank != 0)
 	    {
@@ -2944,11 +2944,11 @@ 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;
 	}
 
       if (var_arg != expr2->value.function.actual)
 	{
@@ -3412,11 +3412,11 @@ gfc_resolve_omp_declare_simd (gfc_namesp
 
   for (ods = ns->omp_declare_simd; ods; ods = ods->next)
     {
       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);
     }
 }
 
Index: gcc/fortran/interface.c
===================================================================
--- gcc/fortran/interface.c	(revision 218457)
+++ gcc/fortran/interface.c	(working copy)
@@ -217,11 +217,11 @@ gfc_match_interface (void)
 	  && !gfc_add_generic (&sym->attr, sym->name, NULL))
 	return MATCH_ERROR;
 
       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;
 	}
 
       current_interface.sym = gfc_new_block = sym;
@@ -1559,14 +1559,14 @@ check_interface0 (gfc_interface *p, cons
       if (((!p->sym->attr.function && !p->sym->attr.subroutine)
 	   || !p->sym->attr.if_source)
 	  && 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;
 	}
 
@@ -1643,11 +1643,11 @@ check_interface1 (gfc_interface *p, gfc_
 	    && q->sym->attr.flavor != FL_DERIVED
 	    && gfc_compare_interfaces (p->sym, q->sym, q->sym->name,
 				       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)
 	      gfc_warning ("Ambiguous interfaces %qs and %qs in %s at %L",
 			   p->sym->name, q->sym->name, interface_name,
@@ -1685,11 +1685,11 @@ check_sym_interfaces (gfc_symbol *sym)
 	{
 	  if (p->sym->attr.mod_proc
 	      && (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;
 	    }
 	}
 
@@ -1890,25 +1890,25 @@ argument_rank_mismatch (const char *name
 
   /* TS 29113, C407b.  */
   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);
     }
 }
 
 
@@ -1954,11 +1954,11 @@ compare_parameter (gfc_symbol *formal, g
 
       if (!gfc_compare_interfaces (formal, act_sym, act_sym->name, 0, 1, err,
 				   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;
 	}
 
       if (formal->attr.function && !act_sym->attr.function)
@@ -1979,11 +1979,11 @@ compare_parameter (gfc_symbol *formal, g
   /* F2008, C1241.  */
   if (formal->attr.pointer && formal->attr.contiguous
       && !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;
     }
 
   if ((actual->expr_type != EXPR_NULL || actual->ts.type != BT_UNKNOWN)
@@ -1994,21 +1994,21 @@ compare_parameter (gfc_symbol *formal, g
       && !(formal->ts.type == BT_DERIVED && actual->ts.type == BT_CLASS
 	   && gfc_compare_derived_types (formal->ts.u.derived,
 					 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;
     }
 
   if (actual->ts.type == BT_ASSUMED && formal->ts.type != BT_ASSUMED)
     {
       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;
     }
 
   /* F2008, 12.5.2.5; IR F08/0073.  */
@@ -2019,11 +2019,11 @@ compare_parameter (gfc_symbol *formal, g
           || CLASS_DATA (formal)->attr.allocatable))
     {
       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;
 	}
 
       if (!gfc_expr_attr (actual).class_ok)
@@ -2032,11 +2032,11 @@ compare_parameter (gfc_symbol *formal, g
       if ((!UNLIMITED_POLY (formal) || !UNLIMITED_POLY(actual))
 	  && !gfc_compare_derived_types (CLASS_DATA (actual)->ts.u.derived,
 					 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;
 	}
     }
 
@@ -2047,22 +2047,22 @@ compare_parameter (gfc_symbol *formal, g
   if (UNLIMITED_POLY (formal) && !UNLIMITED_POLY (actual)
       && (CLASS_DATA (formal)->attr.allocatable
 	  ||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,
 		   &actual->where);
       return 0;
     }
 
   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;
     }
 
   if (formal->attr.codimension && formal->attr.allocatable)
@@ -2077,11 +2077,11 @@ compare_parameter (gfc_symbol *formal, g
       if ((last && last->u.c.component->as->corank != formal->as->corank)
 	  || (!last
 	      && 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);
 	  return 0;
 	}
@@ -2094,11 +2094,11 @@ compare_parameter (gfc_symbol *formal, g
 	  && (formal->attr.contiguous || formal->as->type != AS_ASSUMED_SHAPE)
 	  && gfc_expr_attr (actual).dimension
 	  && !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;
 	}
 
       /* F2008, C1303 and C1304.  */
@@ -2108,11 +2108,11 @@ compare_parameter (gfc_symbol *formal, g
 	       && formal->ts.u.derived->intmod_sym_id == ISOFORTRAN_LOCK_TYPE)
 	      || formal->attr.lock_comp))
 
     	{
 	  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;
 	}
     }
@@ -2126,11 +2126,11 @@ compare_parameter (gfc_symbol *formal, g
       && ((formal->as->type != AS_ASSUMED_SHAPE
 	   && formal->as->type != AS_ASSUMED_RANK && !formal->attr.pointer)
 	  || 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);
       return 0;
     }
@@ -2140,11 +2140,11 @@ compare_parameter (gfc_symbol *formal, g
     {
       if (formal->attr.intent == INTENT_OUT)
 	{
 	  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;
 	}
       else if (warn_surprising && where && formal->attr.intent != INTENT_IN)
 	gfc_warning (OPT_Wsurprising,
@@ -2209,21 +2209,21 @@ compare_parameter (gfc_symbol *formal, g
     }
 
   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;
     }
 
   if (actual->expr_type != EXPR_NULL && ref && actual->ts.type != BT_CHARACTER
       && (is_pointer || ref->u.ar.as->type == AS_ASSUMED_SHAPE))
     {
       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;
     }
 
   if (actual->ts.type == BT_CHARACTER && actual->expr_type != EXPR_NULL
@@ -2232,18 +2232,18 @@ compare_parameter (gfc_symbol *formal, g
       if (formal->ts.kind != 1 && (gfc_option.allow_std & GFC_STD_GNU) == 0)
 	{
 	  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;
 	}
       else if ((gfc_option.allow_std & GFC_STD_F2003) == 0)
 	return 0;
@@ -2553,19 +2553,19 @@ compare_actual_formal (gfc_actual_arglis
 	    }
 
 	  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;
 	    }
 
 	  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;
 	    }
 	}
@@ -2618,15 +2618,15 @@ compare_actual_formal (gfc_actual_arglis
 	  if (where
 	      && (!f->sym->attr.optional
 		  || (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;
 	}
 
       if (!compare_parameter (f->sym, a->expr, ranks_must_agree,
@@ -2688,11 +2688,11 @@ compare_actual_formal (gfc_actual_arglis
 	    && f->sym->ts.deferred != a->expr->ts.deferred
 	    && a->expr->ts.type == BT_CHARACTER)
 	{
 	  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;
 	}
 
@@ -2728,22 +2728,22 @@ compare_actual_formal (gfc_actual_arglis
 	       || (a->expr->expr_type == EXPR_FUNCTION
 		   && a->expr->symtree->n.sym->result->attr.proc_pointer)
 	       || 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;
 	}
 
       /* Satisfy F03:12.4.1.3 by ensuring that a procedure actual argument is
 	 provided for a procedure formal argument.  */
       if (f->sym->attr.flavor == FL_PROCEDURE
 	  && 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;
 	}
 
       if (f->sym->as && f->sym->as->type == AS_ASSUMED_SHAPE
@@ -2753,41 +2753,41 @@ compare_actual_formal (gfc_actual_arglis
 	  && (a->expr->ref == NULL
 	      || (a->expr->ref->type == REF_ARRAY
 		  && 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;
 	}
 
       if (a->expr->expr_type != EXPR_NULL
 	  && 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;
 	}
 
       if (a->expr->expr_type != EXPR_NULL
 	  && (gfc_option.allow_std & GFC_STD_F2008) == 0
 	  && compare_pointer (f->sym, a->expr) == 2)
 	{
 	  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;
 	}
 
 
       /* Fortran 2008, C1242.  */
       if (f->sym->attr.pointer && gfc_is_coindexed (a->expr))
 	{
 	  if (where)
 	    gfc_error ("Coindexed actual argument at %L to pointer "
-		       "dummy '%s'",
+		       "dummy %qs",
 		       &a->expr->where, f->sym->name);
 	  return 0;
 	}
 
       /* Fortran 2008, 12.5.2.5 (no constraint).  */
@@ -2796,11 +2796,11 @@ compare_actual_formal (gfc_actual_arglis
 	  && f->sym->attr.allocatable
 	  && gfc_is_coindexed (a->expr))
 	{
 	  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;
 	}
 
       /* Fortran 2008, C1237.  */
@@ -2810,11 +2810,11 @@ compare_actual_formal (gfc_actual_arglis
 	  && (a->expr->symtree->n.sym->attr.volatile_
 	      || a->expr->symtree->n.sym->attr.asynchronous))
 	{
 	  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;
 	}
 
@@ -2824,32 +2824,32 @@ compare_actual_formal (gfc_actual_arglis
 	  && gfc_is_coindexed (a->expr)
 	  && gfc_has_ultimate_allocatable (a->expr))
 	{
 	  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;
 	}
 
      if (f->sym->ts.type == BT_CLASS
 	   && CLASS_DATA (f->sym)->attr.allocatable
 	   && gfc_is_class_array_ref (a->expr, &full_array)
 	   && !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;
 	}
 
 
       if (a->expr->expr_type != EXPR_NULL
 	  && 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;
 	}
 
       /* Check intent = OUT/INOUT for definable actual argument.  */
@@ -2877,11 +2877,11 @@ compare_actual_formal (gfc_actual_arglis
 	{
 	  if (where)
 	    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;
 	}
 
       /* C1232 (R1221) For an actual argument which is an array section or
@@ -2894,11 +2894,11 @@ compare_actual_formal (gfc_actual_arglis
 	  && !(f->sym->as && f->sym->as->type == AS_ASSUMED_SHAPE))
 	{
 	  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;
 	}
 
       if (f->sym->attr.volatile_
@@ -2906,11 +2906,11 @@ compare_actual_formal (gfc_actual_arglis
 	  && !(f->sym->as && f->sym->as->type == AS_ASSUMED_SHAPE))
 	{
 	  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;
 	}
 
       /* C1233 (R1221) For an actual argument which is a pointer array, the
@@ -2925,11 +2925,11 @@ compare_actual_formal (gfc_actual_arglis
 		   || f->sym->attr.pointer)))
 	{
 	  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;
 	}
 
     match:
@@ -2953,11 +2953,11 @@ compare_actual_formal (gfc_actual_arglis
 	  return 0;
 	}
       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;
 	}
     }
 
@@ -3224,11 +3224,11 @@ check_intents (gfc_formal_arglist *f, gf
        /* F2008, Section 12.5.2.4.  */
        if (expr->ts.type == BT_CLASS && f->sym->ts.type == BT_CLASS
 	   && 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;
 	 }
     }
 
@@ -3251,11 +3251,11 @@ gfc_procedure_use (gfc_symbol *sym, gfc_
      explicitly declared at all if requested.  */
   if (sym->attr.if_source == IFSRC_UNKNOWN && !sym->attr.is_iso_c)
     {
       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;
 	}
       if (warn_implicit_interface)
 	gfc_warning (OPT_Wimplicit_interface,
@@ -3271,38 +3271,38 @@ gfc_procedure_use (gfc_symbol *sym, gfc_
     {
       gfc_actual_arglist *a;
 
       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;
 	}
 
       for (a = *ap; a; a = a->next)
 	{
 	  /* 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;
 	    }
 
 	  /* TS 29113, 6.2.  */
 	  if (a->expr && a->expr->ts.type == BT_ASSUMED
@@ -3319,13 +3319,13 @@ gfc_procedure_use (gfc_symbol *sym, gfc_
 	      && (a->expr->ts.type == BT_DERIVED || a->expr->ts.type == BT_CLASS)
 	      && ((a->expr->ts.u.derived->from_intmod == INTMOD_ISO_FORTRAN_ENV
 		   && 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;
 	    }
 
 	  if (a->expr && a->expr->expr_type == EXPR_NULL
 	      && a->expr->ts.type == BT_UNKNOWN)
@@ -3385,13 +3385,13 @@ gfc_ppc_use (gfc_component *comp, gfc_ac
       for (a = *ap; a; a = a->next)
 	{
 	  /* 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;
 	    }
 	}
 
       return;
@@ -3911,11 +3911,11 @@ gfc_check_new_interface (gfc_interface *
 
   for (ip = base; ip; ip = ip->next)
     {
       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;
 	}
     }
 
@@ -4122,11 +4122,11 @@ gfc_check_typebound_override (gfc_symtre
   gcc_assert (!proc->n.tb->is_generic);
 
   /* 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;
     }
 
   where = proc->n.tb->where;
@@ -4134,81 +4134,81 @@ gfc_check_typebound_override (gfc_symtre
   old_target = old->n.tb->u.specific->n.sym;
 
   /* 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;
     }
 
   /* 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;
     }
 
   /* 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;
     }
 
   /* If the overridden binding is ELEMENTAL, the overriding must be, too.  If it
      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;
     }
 
   /* If the overridden binding is a SUBROUTINE, the overriding must also be a
      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;
     }
 
   /* If the overridden binding is a FUNCTION, the overriding must also be a
      FUNCTION and have the same characteristics.  */
   if (old_target->attr.function)
     {
       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;
 	}
 
       if (!check_result_characteristics (proc_target, old_target, err, 
 					 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;
 	}
     }
 
   /* If the overridden binding is PUBLIC, the overriding one must not be
      PRIVATE.  */
   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;
     }
 
   /* Compare the formal argument lists of both procedures.  This is also abused
@@ -4234,11 +4234,11 @@ gfc_check_typebound_override (gfc_symtre
 	old_pass_arg = argpos;
 
       /* 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);
 	  return false;
 	}
@@ -4246,46 +4246,46 @@ gfc_check_typebound_override (gfc_symtre
       check_type = proc_pass_arg != argpos && old_pass_arg != argpos;
       if (!check_dummy_characteristics (proc_formal->sym, old_formal->sym, 
 					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;
 	}
 
       ++argpos;
     }
   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;
     }
 
   /* If the overridden binding is NOPASS, the overriding one must also be
      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;
     }
 
   /* If the overridden binding is PASS(x), the overriding one must also be
      PASS and the passed-object dummy arguments must correspond.  */
   if (!old->n.tb->nopass)
     {
       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;
 	}
     }
Index: gcc/fortran/intrinsic.c
===================================================================
--- gcc/fortran/intrinsic.c	(revision 218457)
+++ gcc/fortran/intrinsic.c	(working copy)
@@ -3813,11 +3813,11 @@ sort_actual (const char *name, gfc_actua
     }
 
   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:
   /* Associate the remaining actual arguments, all of which have
      to be keyword arguments.  */
@@ -3831,18 +3831,18 @@ keywords:
 	{
 	  if (a->name[0] == '%')
 	    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;
 	}
 
       f->actual = a;
@@ -3852,11 +3852,11 @@ optional:
   /* At this point, all unmatched formal args must be optional.  */
   for (f = formal; f; f = f->next)
     {
       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;
 	}
     }
 
@@ -3924,11 +3924,11 @@ check_arglist (gfc_actual_arglist **ap, 
 	ts.kind = actual->expr->ts.kind;
 
       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),
 		       gfc_typename (&actual->expr->ts));
 	  return false;
@@ -4532,18 +4532,18 @@ gfc_intrinsic_sub_interface (gfc_code *c
       c->resolved_sym->attr.elemental = isym->elemental;
     }
 
   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;
     }
 
   if (!isym->pure)
Index: gcc/fortran/class.c
===================================================================
--- gcc/fortran/class.c	(revision 218457)
+++ gcc/fortran/class.c	(working copy)
@@ -664,11 +664,11 @@ gfc_build_class_symbol (gfc_typespec *ts
     {
       /* Since the extension field is 8 bit wide, we can only have
 	 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;
 	}
 
       fclass->attr.extension = ts->u.derived->attr.extension + 1;
@@ -2684,11 +2684,11 @@ find_typebound_proc_uop (gfc_symbol* der
 
       if (!noaccess && derived->attr.use_assoc
 	  && 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;
 	}
 
@@ -2758,11 +2758,11 @@ gfc_find_typebound_intrinsic_op (gfc_sym
 
       if (!noaccess && derived->attr.use_assoc
 	  && 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;
 	}
 
Index: gcc/fortran/symbol.c
===================================================================
--- gcc/fortran/symbol.c	(revision 218457)
+++ gcc/fortran/symbol.c	(working copy)
@@ -1699,22 +1699,22 @@ gfc_add_type (gfc_symbol *sym, gfc_types
     type = sym->ns->proc_name->ts.type;
 
   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;
     }
 
   flavor = sym->attr.flavor;
@@ -1893,22 +1893,22 @@ gfc_add_component (gfc_symbol *sym, cons
 
   for (p = sym->components; p; p = p->next)
     {
       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;
 	}
 
       tail = p;
     }
 
   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;
     }
 
   /* Allocate a new component.  */
@@ -2059,11 +2059,11 @@ gfc_find_component (gfc_symbol *sym, con
 	  (p->attr.access != ACCESS_PUBLIC
 	   && sym->component_access == ACCESS_PRIVATE
 	   && !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;
 	}
     }
 
@@ -2077,11 +2077,11 @@ gfc_find_component (gfc_symbol *sym, con
       if (p == NULL)
 	return p;
     }
 
   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;
 }
 
@@ -2216,11 +2216,11 @@ gfc_define_st_label (gfc_st_label *lp, g
   int labelno;
 
   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
     {
       lp->where = *label_locus;
 
@@ -2626,14 +2626,14 @@ gfc_new_symbol (const char *name, gfc_na
 static void
 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);
 }
 
 
 /* If we're in a SELECT TYPE block, check if the variable 'st' matches any
@@ -2850,11 +2850,11 @@ gfc_get_sym_tree (const char *name, gfc_
 	  && !(allow_subroutine && p->attr.subroutine)
 	  && !(ns->proc_name && ns->proc_name->attr.if_source == IFSRC_IFBODY
 	  && (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;
 	}
 
       p->mark = 1;
@@ -3893,32 +3893,32 @@ verify_bind_c_derived_type (gfc_symbol *
     {
       /* The components cannot be pointers (fortran sense).  
          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),
                      derived_sym->name, &(derived_sym->declared_at));
           retval = false;
         }
 
       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);
           retval = false;
         }
 
       /* The components cannot be allocatable.
          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),
                      derived_sym->name, &(derived_sym->declared_at));
           retval = false;
Index: gcc/fortran/decl.c
===================================================================
--- gcc/fortran/decl.c	(revision 218457)
+++ gcc/fortran/decl.c	(working copy)
@@ -259,11 +259,11 @@ var_element (gfc_data_variable *new_var)
     return MATCH_ERROR;
 
   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;
     }
 
   if (gfc_current_state () != COMP_BLOCK_DATA
@@ -377,11 +377,11 @@ match_data_constant (gfc_expr **result)
 
   if (sym == NULL
       || (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;
     }
   else if (dt_sym && dt_sym->attr.flavor == FL_DERIVED)
     return gfc_match_structure_constructor (dt_sym, result);
@@ -1015,19 +1015,19 @@ gfc_verify_c_interop_param (gfc_symbol *
 
 	  if (is_c_interop != 1)
 	    {
 	      /* 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);
 	      else if (warn_c_binding_type)
 		gfc_warning (OPT_Wc_binding_type,
@@ -1044,13 +1044,13 @@ gfc_verify_c_interop_param (gfc_symbol *
 	    {
 	      gfc_charlen *cl = sym->ts.u.cl;
 	      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;
 		}
 	    }
@@ -1074,21 +1074,21 @@ gfc_verify_c_interop_param (gfc_symbol *
 				  sym->ns->proc_name->name))
 	    retval = false;
 
 	  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;
 	    }
 
 	  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;
 	    }
 	  else if (sym->attr.optional == 1
@@ -1321,11 +1321,11 @@ add_init_expr_to_sym (const char *name, 
      then an initialization expression is not allowed.  */
   if (attr.flavor == FL_PARAMETER
       && 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;
     }
 
   if (init == NULL)
@@ -1341,11 +1341,11 @@ add_init_expr_to_sym (const char *name, 
     {
       /* If a variable appears in a DATA block, it cannot have an
 	 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;
 	}
 
       /* Check if the assignment can happen. This has to be put off
@@ -1781,11 +1781,11 @@ check_function_name (char *name)
       gfc_symbol *block = gfc_current_block ();
       if (block && block->result && block->result != block
 	  && 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;
 	}
     }
 
   return true;
@@ -1848,11 +1848,11 @@ variable_decl (int elem)
   if (as)
     {
       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;
 	}
 
       if (as->type == AS_ASSUMED_SIZE && as->rank == 1
@@ -2817,11 +2817,11 @@ gfc_match_decl_type_spec (gfc_typespec *
   if (ts->kind != -1)
     {
       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)
 	dt_sym = gfc_find_dt_in_generic (sym);
     }
@@ -2830,11 +2830,11 @@ gfc_match_decl_type_spec (gfc_typespec *
       int iface = gfc_state_stack->previous->state != COMP_INTERFACE
 		    || gfc_current_ns->has_import_set;
       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)
 	dt_sym = gfc_find_dt_in_generic (sym);
 
@@ -2845,13 +2845,13 @@ gfc_match_decl_type_spec (gfc_typespec *
 
   if ((sym->attr.flavor != FL_UNKNOWN
        && !(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;
     }
 
   gfc_set_sym_referenced (sym);
   if (!sym->attr.generic
@@ -3272,25 +3272,25 @@ gfc_match_import (void)
 	{
 	case MATCH_YES:
 	  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
 		   && gfc_find_symbol (name,
 				       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;
 	    }
 
 	  if (gfc_find_symtree (gfc_current_ns->sym_root, name))
@@ -4062,27 +4062,27 @@ verify_bind_c_sym (gfc_symbol *tmp_sym, 
                            &(tmp_sym->declared_at), com_block->name);
 	    }
 	  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));
 	    }
 	}
 
       /* Variables declared w/in a common block can't be bind(c)
 	 since there's no way for C to see these variables, so there's
 	 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,
 		     &(tmp_sym->declared_at));
 	  retval = false;
@@ -4092,19 +4092,19 @@ verify_bind_c_sym (gfc_symbol *tmp_sym, 
 	 or allocatable attributes.  */
       if (tmp_sym->attr.is_bind_c == 1)
 	{
 	  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;
 	    }
 
 	  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;
 	    }
 
@@ -4112,19 +4112,19 @@ verify_bind_c_sym (gfc_symbol *tmp_sym, 
 
       /* If it is a BIND(C) function, make sure the return value is a
 	 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.  */
       if (bind_c_function && tmp_sym->ts.type == BT_CHARACTER)
 	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));
     }
 
   /* See if the symbol has been marked as private.  If it has, make sure
@@ -4595,11 +4595,11 @@ gfc_match_formal_arglist (gfc_symbol *pr
 	 so check for it explicitly.  After the statement is accepted,
 	 the name is checked for especially in gfc_get_symbol().  */
       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;
 	}
 
@@ -4624,11 +4624,11 @@ ok:
 	    continue;
 
 	  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;
 		goto cleanup;
 	      }
@@ -4999,11 +4999,11 @@ match_procedure_decl (void)
       /* Set interface.  */
       if (proc_if != NULL)
 	{
           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;
 	    }
 	  sym->ts.interface = proc_if;
@@ -6275,11 +6275,11 @@ gfc_match_end (gfc_statement *st)
 	return MATCH_YES;
 
       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;
     }
 
@@ -6301,19 +6301,19 @@ gfc_match_end (gfc_statement *st)
   if (block_name == NULL)
     goto syntax;
 
   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;
     }
   /* Procedure pointer as function result.  */
   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;
     }
 
@@ -7313,11 +7313,11 @@ gfc_match_volatile (void)
 	case MATCH_YES:
 	  /* F2008, C560+C561. VOLATILE for host-/use-associated variable or
 	     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;
 	    }
 	  if (!gfc_add_volatile (&sym->attr, sym->name, &gfc_current_locus))
 	    return MATCH_ERROR;
@@ -7529,31 +7529,31 @@ check_extended_derived_type (char *name)
   extended = gfc_find_dt_in_generic (extended);
 
   /* 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;
     }
 
   return extended;
@@ -7680,21 +7680,21 @@ gfc_match_derived_decl (void)
     return m;
 
   /* 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;
     }
 
   if (gfc_get_symbol (name, NULL, &gensym))
     return MATCH_ERROR;
 
   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;
     }
 
   if (!gensym->attr.generic
@@ -7707,11 +7707,11 @@ gfc_match_derived_decl (void)
 
   sym = gfc_find_dt_in_generic (gensym);
 
   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;
     }
 
   if (!sym)
@@ -7778,11 +7778,11 @@ gfc_match_derived_decl (void)
       /* Set extension level.  */
       if (extended->attr.extension == 255)
 	{
 	  /* 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;
 	}
       sym->attr.extension = extended->attr.extension + 1;
 
@@ -8373,23 +8373,23 @@ match_procedure_in_type (void)
       gcc_assert (ns);
 
       /* 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;
 	}
 
       /* See if we already have a binding with this name in the symtree which
 	 would be an error.  If a GENERIC already targeted this binding, it may
 	 be already there but then typebound is still NULL.  */
       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;
 	}
 
       /* Insert it and set attributes.  */
 
@@ -8534,19 +8534,19 @@ gfc_match_generic (void)
     {
       if (!tb->is_generic)
 	{
 	  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;
 	}
 
       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;
 	}
     }
   else
     {
@@ -8600,12 +8600,12 @@ gfc_match_generic (void)
 
       /* See if this is a duplicate specification.  */
       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;
 	  }
 
       target = gfc_get_tbp_generic ();
       target->specific_st = target_st;
@@ -8709,11 +8709,11 @@ gfc_match_final_decl (void)
 	  return MATCH_ERROR;
 	}
 
       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;
 	}
 
       /* Mark the symbol as module procedure.  */
       if (sym->attr.proc != PROC_MODULE
@@ -8722,11 +8722,11 @@ gfc_match_final_decl (void)
 
       /* Check if we already have this symbol in the list, this is an error.  */
       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;
 	  }
 
       /* Add this symbol to the list of finalizers.  */
Index: gcc/fortran/trans-common.c
===================================================================
--- gcc/fortran/trans-common.c	(revision 218457)
+++ gcc/fortran/trans-common.c	(working copy)
@@ -906,11 +906,11 @@ confirm_condition (segment_info *s1, gfc
 
   offset1 = calculate_offset (eq1->expr);
   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);
 }
 
 
Index: gcc/fortran/array.c
===================================================================
--- gcc/fortran/array.c	(revision 218457)
+++ gcc/fortran/array.c	(working copy)
@@ -98,11 +98,11 @@ match_subscript (gfc_array_ref *ar, int 
   if (gfc_match_char (':') == MATCH_NO)
     goto matched;
 
   if (star)
     {
-      gfc_error ("Unexpected '*' in coarray subscript at %C");
+      gfc_error ("Unexpected %<*%> in coarray subscript at %C");
       return MATCH_ERROR;
     }
 
   /* Get an optional end element.  Because we've seen the colon, we
      definitely have a range along this dimension.  */
@@ -244,19 +244,19 @@ 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");
 	  return MATCH_ERROR;
 	}
       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;
 	}
 
       if (ar->codimen >= corank)
@@ -311,11 +311,11 @@ resolve_array_bound (gfc_expr *e, int ch
     return false;
 
   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",
 		   &e->where);
       return false;
@@ -750,11 +750,11 @@ gfc_set_array_spec (gfc_symbol *sym, gfc
     }
 
   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;
     }
 
   if (as->corank)
@@ -910,11 +910,11 @@ check_duplicate_iterator (gfc_constructo
       if (c->iterator == NULL)
 	continue;
 
       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;
 	}
     }
@@ -1660,11 +1660,11 @@ gfc_expand_constructor (gfc_expr *e, boo
       gfc_free_expr (f);
       if (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;
 	}
       return true;
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h	(revision 218457)
+++ gcc/fortran/gfortran.h	(working copy)
@@ -2680,10 +2680,11 @@ bool gfc_warning_now (const char *, ...)
 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);
 void gfc_fatal_error (const char *, ...) ATTRIBUTE_NORETURN ATTRIBUTE_GCC_GFC(1,2);
 void gfc_internal_error (const char *, ...) ATTRIBUTE_NORETURN ATTRIBUTE_GCC_GFC(1,2);
@@ -2696,13 +2697,14 @@ bool gfc_notify_std (int, const char *, 
 
 /* A general purpose syntax error.  */
 #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);
 
 /* arith.c */
Index: gcc/fortran/error.c
===================================================================
--- gcc/fortran/error.c	(revision 218457)
+++ gcc/fortran/error.c	(working copy)
@@ -50,18 +50,26 @@ static int terminal_width, errors, warni
 
 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.  */
 
 void
 gfc_push_suppress_errors (void)
 {
@@ -129,11 +137,11 @@ gfc_error_init_1 (void)
 
 void
 gfc_buffer_error (bool flag)
 {
   buffered_p = flag;
-  pp_warning_buffer.flush_p = !flag;
+  buffered_p = flag;
 }
 
 
 /* Add a single character to the error buffer or output depending on
    buffered_p.  */
@@ -1281,11 +1289,10 @@ gfc_clear_warning (void)
   warning_buffer.flag = 0;
 
   gfc_clear_pp_buffer (&pp_warning_buffer);
   warningcount_buffered = 0;
   werrorcount_buffered = 0;
-  pp_warning_buffer.flush_p = false;
 }
 
 
 /* Check to see if any warnings have been saved.
    If so, print the warning.  */
@@ -1296,33 +1303,32 @@ gfc_warning_check (void)
   if (warning_buffer.flag)
     {
       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;
+      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;
 
   if (warnings_not_errors)
     goto warning;
@@ -1366,10 +1372,63 @@ warning:
     if (warnings_are_errors)
       gfc_increment_error_count();
   }
 }
 
+/* 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
    warning or for scanner.c, if the location is not properly set up.  */
 
@@ -1423,19 +1482,21 @@ gfc_internal_error (const char *gmsgid, 
 void
 gfc_clear_error (void)
 {
   error_buffer.flag = 0;
   warnings_not_errors = false;
+  gfc_clear_pp_buffer (&pp_error_buffer);
 }
 
 
 /* Tests the state of error_flag.  */
 
 bool
 gfc_error_flag_test (void)
 {
-  return error_buffer.flag;
+  return error_buffer.flag 
+    || !gfc_output_buffer_empty_p (&pp_error_buffer);
 }
 
 
 /* Check to see if any errors have been saved.
    If so, print the error.  Returns the state of error_flag.  */
@@ -1448,57 +1509,97 @@ gfc_error_check (void)
   if (error_raised)
     {
       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;
+      diagnostic_action_after_output (global_dc, DK_ERROR);
+      pp_really_flush (pp);
+      gcc_assert (gfc_output_buffer_empty_p (&pp_error_buffer));
+      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)
     {
       size_t len = strlen (err->message) + 1;
       gcc_assert (len <= error_buffer.allocated);
       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);
 }
 
 
 /* Report the number of warnings and errors that occurred to the caller.  */
 
@@ -1526,10 +1627,13 @@ gfc_diagnostics_init (void)
   diagnostic_starter (global_dc) = gfc_diagnostic_starter;
   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.flush_p = false;
+  new (&pp_error_buffer) output_buffer ();
+  pp_error_buffer.flush_p = false;
 }
 
 void
 gfc_diagnostics_finish (void)
 {
Index: gcc/fortran/data.c
===================================================================
--- gcc/fortran/data.c	(revision 218457)
+++ gcc/fortran/data.c	(working copy)
@@ -251,13 +251,13 @@ gfc_assign_data_value (gfc_expr *lvalue,
 	      continue;
 	    }
 
 	  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;
 	    }
 
 	  if (init == NULL)
 	    {
Index: gcc/fortran/expr.c
===================================================================
--- gcc/fortran/expr.c	(revision 218457)
+++ gcc/fortran/expr.c	(working copy)
@@ -2202,13 +2202,13 @@ check_alloc_comp_init (gfc_expr *e)
        comp; comp = comp->next, ctor = gfc_constructor_next (ctor))
     {
       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;
 	}
     }
 
   return true;
@@ -2313,11 +2313,11 @@ check_inquiry (gfc_expr *e, int not_rest
 	if (i == 5 && not_restricted
 	    && ap->expr->symtree->n.sym->ts.type == BT_CHARACTER
 	    && (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);
 	      return MATCH_ERROR;
 	  }
@@ -2379,12 +2379,12 @@ check_transformational (gfc_expr *e)
     if (strcmp (functions[i], name) == 0)
        break;
 
   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;
     }
 
   return check_init_expr_arguments (e);
 }
@@ -2479,11 +2479,11 @@ 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;
 	  }
 
@@ -2491,11 +2491,11 @@ gfc_check_init_expr (gfc_expr *e)
 	    && (m = check_inquiry (e, 1)) == MATCH_NO
 	    && (m = check_null (e)) == MATCH_NO
 	    && (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;
 	  }
 
@@ -2526,12 +2526,12 @@ gfc_check_init_expr (gfc_expr *e)
 	  /* A PARAMETER shall not be used to define itself, i.e.
 		REAL, PARAMETER :: x = transfer(0, x)
 	     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
 	    t = simplify_parameter_variable (e, 0);
 
@@ -2546,39 +2546,39 @@ gfc_check_init_expr (gfc_expr *e)
       if (e->symtree->n.sym->as)
 	{
 	  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;
 
 	      default:
 		gcc_unreachable();
 	  }
 	}
       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);
 
       break;
 
@@ -2727,32 +2727,32 @@ external_spec_function (gfc_expr *e)
 
   f = e->value.function.esym;
 
   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;
     }
 
   return restricted_args (e->value.function.actual);
@@ -2882,25 +2882,25 @@ check_restricted (gfc_expr *e)
 	 don't need to jump through hoops to distinguish valid from
 	 invalid cases.  */
       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;
 	}
 
       /* Check reference chain if any.  */
@@ -2927,11 +2927,11 @@ check_restricted (gfc_expr *e)
 	{
 	  t = true;
 	  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;
       break;
 
@@ -2990,11 +2990,11 @@ gfc_specification_expr (gfc_expr *e)
       && !e->value.function.isym
       && !e->value.function.esym
       && !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;
       return false;
     }
@@ -3136,11 +3136,11 @@ gfc_check_assign (gfc_expr *lvalue, gfc_
 	    && sym != gfc_current_ns->parent->proc_name->result)
 	bad_proc = true;
 
       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;
 	}
     }
 
   if (rvalue->rank != 0 && lvalue->rank != rvalue->rank)
@@ -3329,11 +3329,11 @@ gfc_check_pointer_assign (gfc_expr *lval
     }
 
   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;
     }
 
@@ -3352,11 +3352,11 @@ gfc_check_pointer_assign (gfc_expr *lval
 	  if (ref->u.ar.type == AR_FULL)
 	    break;
 
 	  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;
 	    }
 
 	  if (!gfc_notify_std (GFC_STD_F2003, "Bounds specification "
@@ -3459,30 +3459,30 @@ gfc_check_pointer_assign (gfc_expr *lval
 	      gfc_namespace *ns;
 
 	      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;
 		  }
 	    }
 	}
       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;
 	}
       /* Check for F08:C729.  */
       if (attr.flavor == FL_PROCEDURE)
 	{
 	  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;
 	    }
 	  if (attr.proc == PROC_INTERNAL &&
@@ -3491,19 +3491,19 @@ gfc_check_pointer_assign (gfc_expr *lval
 			      "at %L", rvalue->symtree->name, &rvalue->where))
 	    return false;
 	  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;
 	    }
 	}
       /* 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;
 	}
 
@@ -3578,18 +3578,18 @@ gfc_check_pointer_assign (gfc_expr *lval
 
       /* F08:7.2.2.4 (4)  */
       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;
 	}
 
       if (!gfc_compare_interfaces (s1, s2, name, 0, 1,
@@ -3602,11 +3602,11 @@ gfc_check_pointer_assign (gfc_expr *lval
 
       /* Check F2008Cor2, C729.  */
       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;
 	}
 
@@ -4756,20 +4756,20 @@ gfc_check_vardef_context (gfc_expr* e, b
     }
 
   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;
     }
   if (!pointer && sym->attr.flavor != FL_VARIABLE
       && !(sym->attr.flavor == FL_PROCEDURE && sym == sym->result)
       && !(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;
     }
 
   /* Find out whether the expr is a pointer; this also means following
@@ -4818,19 +4818,19 @@ gfc_check_vardef_context (gfc_expr* e, b
   if (check_intentin && sym->attr.intent == INTENT_IN)
     {
       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;
 	}
       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;
 	}
     }
@@ -4839,19 +4839,19 @@ gfc_check_vardef_context (gfc_expr* e, b
   if (sym->attr.is_protected && sym->attr.use_assoc && check_intentin)
     {
       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;
 	}
       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;
 	}
     }
@@ -4859,11 +4859,11 @@ gfc_check_vardef_context (gfc_expr* e, b
   /* Variable not assignable from a PURE procedure but appears in
      variable definition context.  */
   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;
     }
 
@@ -4918,26 +4918,26 @@ gfc_check_vardef_context (gfc_expr* e, b
       if (!assoc->variable)
 	{
 	  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);
 	    }
 	  return false;
 	}
 
       /* Target must be allowed to appear in a variable definition context.  */
       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,
 		       &assoc->target->where);
 	  return false;
Index: gcc/fortran/scanner.c
===================================================================
--- gcc/fortran/scanner.c	(revision 218457)
+++ gcc/fortran/scanner.c	(working copy)
@@ -2043,10 +2043,11 @@ load_file (const char *realfilename, con
       /* Add line.  */
 
       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,
 	 because otherwise if the next call creates a new line-map, it
 	 will not reserve space for any offset.  */
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(revision 218457)
+++ gcc/fortran/resolve.c	(working copy)
@@ -467,28 +467,28 @@ resolve_formal_arglist (gfc_symbol *proc
 
 	  if (sym->attr.pointer
 	      || (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;
 	    }
 
 	  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;
 	    }
 
 	  /* 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);
 	      continue;
 	    }
@@ -497,21 +497,21 @@ resolve_formal_arglist (gfc_symbol *proc
       /* Each dummy shall be specified to be scalar.  */
       if (proc->attr.proc == PROC_ST_FUNCTION)
 	{
 	  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;
 	    }
 
 	  if (sym->ts.type == BT_CHARACTER)
 	    {
 	      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;
 		}
 	    }
@@ -565,14 +565,14 @@ resolve_contained_fntype (gfc_symbol *sy
       t = gfc_set_default_type (sym->result, 0, 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;
 	}
     }
@@ -592,11 +592,11 @@ resolve_contained_fntype (gfc_symbol *sy
 	     accordingly.  */
 	  bool module_proc;
 	  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"),
 		     sym->name, &sym->declared_at);
 	}
@@ -982,11 +982,11 @@ resolve_common_blocks (gfc_symtree *comm
 		   || strcmp (common_root->n.common->binding_label,
 			      gsym->binding_label) != 0))
 	      || (!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,
 		     &gsym->where,
 		     common_root->n.common->binding_label
@@ -996,19 +996,19 @@ resolve_common_blocks (gfc_symtree *comm
 	}
 
       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);
 	  return;
 	}
       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);
 	  return;
 	}
@@ -1026,11 +1026,11 @@ resolve_common_blocks (gfc_symtree *comm
     {
       gsym = gfc_find_gsymbol (gfc_gsym_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);
 	  return;
 	}
@@ -1047,19 +1047,19 @@ resolve_common_blocks (gfc_symtree *comm
   gfc_find_symbol (common_root->name, gfc_current_ns, 0, &sym);
   if (sym == NULL)
     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))
     gfc_notify_std (GFC_STD_F2003, "COMMON block '%s' at %L "
 		    "that is also a function result", sym->name,
@@ -1169,11 +1169,11 @@ resolve_structure_cons (gfc_expr *expr, 
 	      cons->expr->ts = comp->ts;
 	    }
 	  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));
 	      t = false;
 	    }
@@ -1254,11 +1254,11 @@ resolve_structure_cons (gfc_expr *expr, 
 		   && (CLASS_DATA (comp)->attr.class_pointer
 		       || CLASS_DATA (comp)->attr.allocatable))))
 	{
 	  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);
 	}
 
       if (comp->attr.proc_pointer && comp->ts.interface)
@@ -1288,11 +1288,11 @@ resolve_structure_cons (gfc_expr *expr, 
 
 	  if (s2 && !gfc_compare_interfaces (comp->ts.interface, s2, name, 0, 1,
 					     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;
 	    }
 	}
 
@@ -1304,11 +1304,11 @@ resolve_structure_cons (gfc_expr *expr, 
 
       if (!a.pointer && !a.target)
 	{
 	  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);
 	}
 
       if (init)
 	{
@@ -1333,11 +1333,11 @@ resolve_structure_cons (gfc_expr *expr, 
 			|| gfc_is_coindexed (cons->expr));
       if (impure && gfc_pure (NULL))
 	{
 	  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);
 	}
 
       if (impure)
 	gfc_unset_implicit_pure (NULL);
@@ -1459,11 +1459,11 @@ check_assumed_size_reference (gfc_symbol
 	  && (e->ref->u.ar.as->type == AS_ASSUMED_SIZE)
 	       && (e->ref->u.ar.type == AR_FULL))
     {
       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;
 }
 
@@ -1519,15 +1519,15 @@ count_specific_procs (gfc_expr *e)
 				       sym->name);
 	n++;
       }
 
   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;
 }
 
@@ -1657,22 +1657,22 @@ gfc_resolve_intrinsic (gfc_symbol *sym, 
     }
   else if (isym || (isym = gfc_find_subroutine (sym->name)))
     {
       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;
 	}
 
       if (!sym->attr.subroutine &&
 	  !gfc_add_subroutine(&sym->attr, sym->name, loc))
 	return false;
     }
   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;
     }
 
   gfc_copy_formal_args_intr (sym, isym, NULL);
@@ -1681,11 +1681,11 @@ gfc_resolve_intrinsic (gfc_symbol *sym, 
   sym->attr.elemental = isym->elemental;
 
   /* 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.",
 		 sym->name, &sym->declared_at, symstd);
       return false;
@@ -1798,19 +1798,19 @@ resolve_actual_arglist (gfc_actual_argli
 	  if (gfc_is_intrinsic (sym, sym->attr.subroutine, e->where))
 	    sym->attr.intrinsic = 1;
 
 	  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);
 	    }
 
 	  actual_ok = gfc_intrinsic_actual_ok (sym->name,
 					       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);
 	    }
 
 	  if (sym->attr.contained && !sym->attr.use_assoc
 	      && sym->ns->proc_name->attr.flavor != FL_MODULE)
@@ -1821,11 +1821,11 @@ resolve_actual_arglist (gfc_actual_argli
 		goto cleanup;
 	    }
 
 	  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);
 	    }
 
 	  /* Check if a generic interface has a specific procedure
@@ -1849,11 +1849,11 @@ resolve_actual_arglist (gfc_actual_argli
 
 	      isym = gfc_find_function (sym->name);
 	      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;
 		}
 	      sym->ts = isym->ts;
 	      sym->attr.intrinsic = 1;
@@ -1870,11 +1870,11 @@ resolve_actual_arglist (gfc_actual_argli
       if (was_declared (sym) || sym->ns->parent == NULL)
 	goto got_variable;
 
       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;
 	}
 
       if (parent_st == NULL)
 	goto got_variable;
@@ -2137,12 +2137,12 @@ resolve_elemental_actual (gfc_expr *expr
 	 arg = arg->next, eformal = eformal->next)
       if ((eformal->sym->attr.intent == INTENT_OUT
 	   || 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);
 	  return false;
 	}
@@ -2414,20 +2414,20 @@ resolve_global_procedure (gfc_symbol *sy
 	      }
 	}
 
       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;
 	}
 
       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;
 	}
 
       if (!pedantic && (gfc_option.allow_std & GFC_STD_GNU))
@@ -2435,11 +2435,11 @@ resolve_global_procedure (gfc_symbol *sy
 	gfc_errors_to_warnings (true);
 
       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;
 	}
 
       if (!pedantic
@@ -2543,11 +2543,11 @@ generic:
 
   /* Last ditch attempt.  See if the reference is to an intrinsic
      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;
     }
 
   if (intr)
@@ -2561,11 +2561,11 @@ generic:
   m = gfc_intrinsic_func_interface (expr, 0);
   if (m == MATCH_YES)
     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);
 
   return false;
 }
@@ -2599,11 +2599,11 @@ resolve_specific_f0 (gfc_symbol *sym, gf
     {
       m = gfc_intrinsic_func_interface (expr, 1);
       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;
     }
 
@@ -2650,11 +2650,11 @@ resolve_specific_f (gfc_expr *expr)
 
       if (sym == NULL)
 	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;
 }
 
@@ -2706,11 +2706,11 @@ set_type:
     {
       ts = gfc_get_default_type (sym->name, sym->ns);
 
       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;
 	}
       else
 	expr->ts = *ts;
@@ -2827,19 +2827,19 @@ resolve_function (gfc_expr *expr)
       && !gfc_resolve_intrinsic (sym, &expr->where))
     return false;
 
   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;
     }
 
   /* If this ia a deferred TBP with an abstract interface (which may
      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;
     }
 
   /* Switch off assumed size checking and do this again for certain kinds
@@ -2878,11 +2878,11 @@ resolve_function (gfc_expr *expr)
       && !sym->ts.deferred
       && expr->value.function.esym == NULL
       && !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;
     }
 
@@ -2932,11 +2932,11 @@ resolve_function (gfc_expr *expr)
 
   if (omp_workshare_flag
       && 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;
     }
 
@@ -2986,25 +2986,25 @@ resolve_function (gfc_expr *expr)
 
   if (!pure_function (expr, &name) && name)
     {
       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;
 	}
 
       gfc_unset_implicit_pure (NULL);
@@ -3018,15 +3018,15 @@ resolve_function (gfc_expr *expr)
       esym = expr->value.function.esym;
 
       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;
       }
     }
@@ -3061,17 +3061,17 @@ pure_subroutine (gfc_code *c, gfc_symbol
 {
   if (gfc_pure (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);
 }
 
@@ -3132,20 +3132,20 @@ generic:
      that possesses a matching interface.  14.1.2.4  */
   sym = c->symtree->n.sym;
 
   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;
     }
 
   m = gfc_intrinsic_sub_interface (c, 0);
   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;
 }
 
@@ -3176,11 +3176,11 @@ resolve_specific_s0 (gfc_code *c, gfc_sy
     {
       m = gfc_intrinsic_sub_interface (c, 1);
       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;
     }
 
@@ -3220,11 +3220,11 @@ resolve_specific_s (gfc_code *c)
       if (sym == NULL)
 	break;
     }
 
   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;
 }
 
@@ -3280,11 +3280,11 @@ resolve_call (gfc_code *c)
 
   csym = c->symtree ? c->symtree->n.sym : NULL;
 
   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;
     }
 
   if (csym && gfc_current_ns->parent && csym->ns != gfc_current_ns)
@@ -3309,25 +3309,25 @@ resolve_call (gfc_code *c)
   /* If this ia a deferred TBP, c->expr1 will be set.  */
   if (!c->expr1 && csym)
     {
       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;
 	}
 
       /* Subroutines without the RECURSIVE attribution are not allowed to
 	 call themselves.  */
       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;
 	}
     }
@@ -3400,11 +3400,11 @@ compare_shapes (gfc_expr *op1, gfc_expr 
     {
       for (i = 0; i < op1->rank; i++)
 	{
 	  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;
 	   }
 	}
@@ -6674,11 +6674,11 @@ conformable_arrays (gfc_expr *e1, gfc_ex
 	      mpz_set (s, tail->u.ar.start[i]->value.integer);
 	    }
 
 	  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;
 	    }
 	}
@@ -6832,23 +6832,23 @@ resolve_allocate_expr (gfc_expr *e, gfc_
   if (code->expr3)
     {
       /* 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;
 	}
 
       /* Check F03:C632 and restriction following Note 6.18.  */
       if (code->expr3->rank > 0 && !conformable_arrays (code->expr3, e))
 	goto failure;
 
       /* 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;
 	}
 
@@ -6858,11 +6858,11 @@ resolve_allocate_expr (gfc_expr *e, gfc_
 	      || (code->expr3->ts.u.derived->from_intmod
 		     == INTMOD_ISO_FORTRAN_ENV
 		  && 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);
 	  goto failure;
 	}
@@ -7202,24 +7202,24 @@ resolve_allocate_deallocate (gfc_code *c
 		 c) One of them stops, which is also an error.  */
 	      while (1)
 		{
 		  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  */
 		  gcc_assert(pr->type == qr->type);
 		  if (pr->type == REF_ARRAY)
@@ -7418,11 +7418,11 @@ check_case_overlap (gfc_case *list)
 		    {
 		      /* The cases overlap, or they are the same
 			 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;
 		      p = p->right;
 		      psize--;
@@ -7656,11 +7656,11 @@ resolve_select (gfc_code *code, bool sel
 	  /* Intercept the DEFAULT case.  */
 	  if (cp->low == NULL && cp->high == NULL)
 	    {
 	      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;
 		  break;
 		}
@@ -8026,11 +8026,11 @@ resolve_select_type (gfc_code *code, gfc
       if (c->ts.type == BT_UNKNOWN)
 	{
 	  /* 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++;
 	      continue;
 	    }
@@ -8584,11 +8584,11 @@ resolve_branch (gfc_st_label *label, gfc
       return;
     }
 
   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;
     }
 
   /* Step two: make sure this branch is not a branch to itself ;-)  */
@@ -8610,15 +8610,15 @@ resolve_branch (gfc_st_label *label, gfc
 	 which is invalid.  */
       for (stack = cs_base; stack; stack = stack->prev)
 	{
 	  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);
 	}
 
       return;
     }
@@ -8633,17 +8633,17 @@ resolve_branch (gfc_st_label *label, gfc
 	break;
       if (stack->current->op == EXEC_CRITICAL)
 	{
 	  /* 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;
 	}
     }
 
@@ -9999,11 +9999,11 @@ gfc_resolve_code (gfc_code *code, gfc_na
 	    {
 	      if (code->expr1->ts.type != BT_INTEGER)
 		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);
 	    }
 	  else
 	    resolve_branch (code->label1, code);
@@ -10384,11 +10384,11 @@ gfc_verify_binding_labels (gfc_symbol *s
       return;
     }
 
   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.  */
       sym->binding_label = NULL;
 
@@ -10397,12 +10397,12 @@ gfc_verify_binding_labels (gfc_symbol *s
 	   && (strcmp (module, gsym->mod_name) != 0
 	       || strcmp (sym->name, gsym->sym_name) != 0))
     {
       /* 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;
     }
   else if ((sym->attr.function || sym->attr.subroutine)
@@ -10414,11 +10414,11 @@ gfc_verify_binding_labels (gfc_symbol *s
 	       || (module && strcmp (module, gsym->mod_name) != 0)))
     {
       /* 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;
     }
 }
@@ -10914,11 +10914,11 @@ resolve_fl_variable_derived (gfc_symbol 
       gfc_find_symbol (sym->ts.u.derived->name, sym->ns, 0, &s);
       if (s && s->attr.generic)
 	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,
 		     &s->declared_at);
 	  return false;
@@ -12333,39 +12333,39 @@ resolve_fl_derived0 (gfc_symbol *sym)
       /* F2008, C442.  */
       if ((!sym->attr.is_class || c != sym->components)
 	  && 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;
 	}
 
       /* F2008, C443.  */
       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;
 	}
 
       /* F2008, C444.  */
       if (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.coarray_comp
 	  && (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;
 	}
 
       /* 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;
 	}
 
       if (c->attr.proc_pointer && c->ts.interface)
@@ -12454,12 +12454,12 @@ resolve_fl_derived0 (gfc_symbol *sym)
 		  c->tb->pass_arg_num++;
 		}
 
 	      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;
 		}
 	    }
@@ -12468,11 +12468,11 @@ resolve_fl_derived0 (gfc_symbol *sym)
 	      /* Otherwise, take the first one; there should in fact be at least
 		one.  */
 	      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;
 		  return false;
 		}
@@ -12484,47 +12484,47 @@ resolve_fl_derived0 (gfc_symbol *sym)
 	  if ((me_arg->ts.type != BT_DERIVED && me_arg->ts.type != BT_CLASS)
 	      || (me_arg->ts.type == BT_DERIVED && me_arg->ts.u.derived != 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;
 	    }
 
 	  /* 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;
 	      return false;
 	    }
 
 	  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;
 	      return false;
 	    }
 
 	  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;
 	      return false;
 	    }
 
 	  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);
 
 	}
 
       /* Check type-spec if this is not the parent-type component.  */
@@ -12549,11 +12549,11 @@ resolve_fl_derived0 (gfc_symbol *sym)
       /* If this type is an extension, see if this component has the same name
 	 as an inherited type-bound procedure.  */
       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;
 	}
 
@@ -12562,22 +12562,22 @@ resolve_fl_derived0 (gfc_symbol *sym)
 	{
 	 if (c->ts.u.cl->length == NULL
 	     || (!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);
 	     return false;
 	   }
 	}
 
       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;
 	}
 
@@ -12639,11 +12639,11 @@ resolve_fl_derived0 (gfc_symbol *sym)
 
       if (!sym->attr.is_class && c->ts.type == BT_DERIVED && !sym->attr.vtype
 	  && 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;
 	}
 
@@ -12651,11 +12651,11 @@ resolve_fl_derived0 (gfc_symbol *sym)
 	  && CLASS_DATA (c)->attr.class_pointer
 	  && CLASS_DATA (c)->ts.u.derived->components == NULL
 	  && !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;
 	}
 
@@ -12663,11 +12663,11 @@ resolve_fl_derived0 (gfc_symbol *sym)
       if (c->ts.type == BT_CLASS && c->attr.flavor != FL_PROCEDURE
 	  && (!c->attr.class_ok
 	      || !(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;
 	  return false;
 	}
@@ -13315,11 +13315,11 @@ resolve_symbol (gfc_symbol *sym)
       /* First, make sure the variable is declared at the
 	 module-level scope (J3/04-007, Section 15.3).	*/
       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;
 	}
       else if (sym->common_head != NULL)
Index: gcc/fortran/match.c
===================================================================
--- gcc/fortran/match.c	(revision 218457)
+++ gcc/fortran/match.c	(working copy)
@@ -3546,11 +3546,11 @@ 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;
 	    }
 
 	  if (head->next
@@ -3583,11 +3583,11 @@ 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;
 	    }
 
 	  mold = tmp;
@@ -3609,11 +3609,11 @@ alloc_opt_list:
     goto syntax;
 
   /* 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;
     }
 
   /* Check F03:C623,  */
@@ -4313,11 +4313,11 @@ gfc_match_common (void)
 			       t->name);
             }
 
 	  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;
 	    }
 
 	  if (((sym->value != NULL && sym->value->expr_type != EXPR_NULL)
@@ -4836,20 +4836,22 @@ recursive_stmt_fcn (gfc_expr *e, gfc_sym
    MATCH_NO that we suppress error message in most cases.  */
 
 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;
 
   m = gfc_match_symbol (&sym, 0);
   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;
 
   if (gfc_match_formal_arglist (sym, 1, 0) != MATCH_YES)
@@ -4857,11 +4859,12 @@ gfc_match_st_function (void)
 
   m = gfc_match (" = %e%t", &expr);
   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;
 
   if (recursive_stmt_fcn (expr, sym))
     {
@@ -4875,11 +4878,11 @@ gfc_match_st_function (void)
     return MATCH_ERROR;
 
   return MATCH_YES;
 
 undo_error:
-  gfc_pop_error (&old_error);
+  gfc_pop_error (&old_error, &old_error_1);
   return MATCH_NO;
 }
 
 
 /***************** SELECT CASE subroutines ******************/
Index: gcc/fortran/arith.c
===================================================================
--- gcc/fortran/arith.c	(revision 218457)
+++ gcc/fortran/arith.c	(working copy)
@@ -1913,21 +1913,21 @@ arith_error (arith rc, gfc_typespec *fro
       gfc_error ("Arithmetic OK converting %s to %s at %L",
 		 gfc_typename (from), gfc_typename (to), 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:
       gfc_error ("Division by zero converting %s to %s at %L",
 		 gfc_typename (from), gfc_typename (to), where);
Index: gcc/fortran/parse.c
===================================================================
--- gcc/fortran/parse.c	(revision 218457)
+++ gcc/fortran/parse.c	(working copy)
@@ -105,17 +105,18 @@ match_word_omp_simd (const char *str, ma
 /* Load symbols from all USE statements encountered in this scoping unit.  */
 
 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;
   gfc_current_ns->old_equiv = gfc_current_ns->equiv;
   last_was_use_stmt = false;
@@ -2200,11 +2201,11 @@ verify_st_order (st_state *p, gfc_statem
   p->last_statement = st;
   return true;
 
 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);
 
   return false;
 }
@@ -2577,11 +2578,11 @@ endType:
 		   "be a subcomponent of a coarray. (Variables of type %s may "
 		   "not have a codimension as already a coarray "
 		   "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 "
 		   "coarray subcomponent)", lock_comp->name, &lock_comp->loc,
 		   sym->name, c->name, &c->loc);
@@ -3279,11 +3280,11 @@ parse_if_block (void)
 	  unexpected_eof ();
 
 	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 ();
 	      break;
 	    }
@@ -4672,14 +4673,14 @@ gfc_global_used (gfc_gsymbol *sym, locus
       gfc_internal_error ("gfc_global_used(): Bad type");
       name = NULL;
     }
 
   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);
 }
 
 
 /* Parse a block data program unit.  */
Index: gcc/fortran/check.c
===================================================================
--- gcc/fortran/check.c	(revision 218457)
+++ gcc/fortran/check.c	(working copy)
@@ -41,11 +41,11 @@ static bool
 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);
 
   return false;
 }
@@ -57,11 +57,11 @@ static bool
 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));
 
   return false;
 }
@@ -84,11 +84,11 @@ numeric_check (gfc_expr *e, int n)
     {
       e->ts = e->symtree->n.sym->ts;
       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);
 
   return false;
 }
@@ -99,11 +99,11 @@ numeric_check (gfc_expr *e, int n)
 static bool
 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;
     }
 
@@ -116,11 +116,11 @@ int_or_real_check (gfc_expr *e, int n)
 static bool
 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;
     }
 
@@ -133,11 +133,11 @@ real_or_complex_check (gfc_expr *e, int 
 static bool
 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;
     }
 
@@ -162,11 +162,11 @@ kind_check (gfc_expr *k, int n, bt type)
   if (!scalar_check (k, n))
     return false;
 
   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;
     }
 
@@ -190,11 +190,11 @@ double_check (gfc_expr *d, int n)
   if (!type_check (d, n, BT_REAL))
     return false;
 
   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;
     }
 
@@ -213,11 +213,11 @@ coarray_check (gfc_expr *e, int n)
       return true;
     }
 
   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;
     }
 
@@ -230,11 +230,11 @@ coarray_check (gfc_expr *e, int n)
 static bool
 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;
     }
 
@@ -256,11 +256,11 @@ 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);
 
   return false;
 }
@@ -277,11 +277,11 @@ nonnegative_check (const char *arg, gfc_
   if (expr->expr_type == EXPR_CONSTANT)
     {
       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;
 	}
     }
 
   return true;
@@ -309,31 +309,31 @@ less_than_bitsize1 (const char *arg1, gf
 	    i2 = -i2;
 
 	  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;
 	    }
 	}
 
       if (or_equal)
 	{
 	  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;
 	    }
 	}
       else
 	{
 	  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;
 	    }
 	}
     }
@@ -356,11 +356,11 @@ less_than_bitsizekind (const char *arg, 
   i = gfc_validate_kind (BT_INTEGER, k, false);
   gfc_extract_int (expr, &val);
 
   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;
     }
 
   return true;
@@ -383,11 +383,11 @@ less_than_bitsize2 (const char *arg1, gf
       i2 += i3;
       i3 = gfc_validate_kind (BT_INTEGER, expr1->ts.kind, false);
       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;
 	}
     }
 
@@ -400,12 +400,12 @@ static bool
 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);
 
   return false;
 }
@@ -417,11 +417,11 @@ static bool
 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);
 
   return false;
 }
@@ -432,11 +432,11 @@ rank_check (gfc_expr *e, int n, int rank
 static bool
 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);
     }
 
   /* TODO: Recursive check on nonoptional variables?  */
@@ -453,11 +453,11 @@ allocatable_check (gfc_expr *e, int n)
   symbol_attribute attr;
 
   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;
     }
 
@@ -471,11 +471,11 @@ static bool
 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);
 
   return false;
 }
@@ -509,11 +509,11 @@ variable_check (gfc_expr *e, int n, bool
 	    break;
 	}
 
       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;
 	}
     }
@@ -530,11 +530,11 @@ variable_check (gfc_expr *e, int n, bool
       for (ns = gfc_current_ns; ns; ns = ns->parent)
 	if (ns->proc_name == e->symtree->n.sym)
 	  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;
 }
 
@@ -579,11 +579,11 @@ dim_corank_check (gfc_expr *dim, gfc_exp
   corank = gfc_get_corank (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;
     }
 
@@ -629,11 +629,11 @@ dim_rank_check (gfc_expr *dim, gfc_expr 
     }
 
   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;
     }
 
@@ -854,11 +854,11 @@ gfc_check_a_p (gfc_expr *a, gfc_expr *p)
   if (!int_or_real_check (a, 0))
     return false;
 
   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);
       return false;
     }
@@ -899,20 +899,20 @@ gfc_check_associated (gfc_expr *pointer,
 
   attr1 = gfc_expr_attr (pointer);
 
   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;
     }
 
   /* 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;
     }
 
@@ -926,29 +926,29 @@ gfc_check_associated (gfc_expr *pointer,
 
   if (target->expr_type == EXPR_VARIABLE || target->expr_type == EXPR_FUNCTION)
     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);
       return false;
     }
 
   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;
     }
 
   /* 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;
     }
 
@@ -972,11 +972,11 @@ gfc_check_associated (gfc_expr *pointer,
   return t;
 
 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;
 
 }
 
 
@@ -1029,11 +1029,11 @@ gfc_check_atomic (gfc_expr *atom, int at
       return false;
     }
 
   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);
       return false;
     }
@@ -1375,20 +1375,20 @@ gfc_check_cmplx (gfc_expr *x, gfc_expr *
       if (!numeric_check (y, 1))
 	return false;
 
       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);
 	  return false;
 	}
 
       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);
 	  return false;
 	}
@@ -1573,11 +1573,11 @@ gfc_check_co_reduce (gfc_expr *a, gfc_ex
   if (sym->result->ts.type == BT_UNKNOWN)
     gfc_set_default_type (sym->result, 0, NULL);
 
   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));
       return false;
     }
@@ -1653,20 +1653,20 @@ gfc_check_co_reduce (gfc_expr *a, gfc_ex
 
       if (actual_size
 	  && ((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;
 	}
     }
 
   return true;
@@ -1678,14 +1678,14 @@ gfc_check_co_minmax (gfc_expr *a, gfc_ex
 		     gfc_expr *errmsg)
 {
   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);
 }
 
@@ -1773,11 +1773,11 @@ gfc_check_cshift (gfc_expr *array, gfc_e
 	  for (i = 0, j = 0; i < array->rank; i++)
 	    if (i != d - 1)
 	      {
 		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,
 			       mpz_get_si (array->shape[i]),
 			       mpz_get_si (shift->shape[j]));
@@ -1788,11 +1788,11 @@ gfc_check_cshift (gfc_expr *array, gfc_e
 	      }
 	}
     }
   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;
     }
 
@@ -1832,20 +1832,20 @@ gfc_check_dcmplx (gfc_expr *x, gfc_expr 
       if (!numeric_check (y, 1))
 	return false;
 
       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);
 	  return false;
 	}
 
       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);
 	  return false;
 	}
@@ -1891,11 +1891,11 @@ gfc_check_dot_product (gfc_expr *vector_
       if (!numeric_check (vector_b, 1))
 	return false;
       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;
     }
 
@@ -1905,11 +1905,11 @@ gfc_check_dot_product (gfc_expr *vector_
   if (!rank_check (vector_b, 1, 1))
     return false;
 
   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;
     }
 
@@ -1924,19 +1924,19 @@ gfc_check_dprod (gfc_expr *x, gfc_expr *
       || !type_check (y, 1, BT_REAL))
     return false;
 
   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;
     }
 
   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;
     }
 
@@ -1953,12 +1953,12 @@ gfc_check_dshift (gfc_expr *i, gfc_expr 
   if (!type_check (j, 1, BT_INTEGER))
     return false;
 
   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;
     }
 
   if (!i->is_boz && !j->is_boz && !same_type_check (i, 0, j, 1))
     return false;
@@ -2023,11 +2023,11 @@ gfc_check_eoshift (gfc_expr *array, gfc_
 	  for (i = 0, j = 0; i < array->rank; i++)
 	    if (i != d - 1)
 	      {
 		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,
 			       mpz_get_si (array->shape[i]),
 			       mpz_get_si (shift->shape[j]));
@@ -2038,11 +2038,11 @@ gfc_check_eoshift (gfc_expr *array, gfc_
 	      }
 	}
     }
   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;
     }
 
@@ -2066,11 +2066,11 @@ gfc_check_eoshift (gfc_expr *array, gfc_
 				      gfc_current_intrinsic))
 	    return false;
 	}
       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);
 	  return false;
 	}
@@ -2367,12 +2367,12 @@ gfc_check_index (gfc_expr *string, gfc_e
 			       gfc_current_intrinsic, &kind->where))
     return false;
 
   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;
     }
 
@@ -2469,13 +2469,13 @@ gfc_check_ishftc (gfc_expr *i, gfc_expr 
 	      if (i2 < 0)
 		i2 = -i2;
 
 	      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;
 		}
 	     }
 	}
     }
@@ -2530,11 +2530,11 @@ gfc_check_kill_sub (gfc_expr *pid, gfc_e
 bool
 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;
     }
 
@@ -2741,11 +2741,11 @@ min_max_args (gfc_actual_arglist *args)
   int i, j, nargs, *nlabels, nlabelless;
   bool a1 = false, a2 = false;
 
   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;
     }
 
   if (!args->name)
@@ -2789,11 +2789,11 @@ min_max_args (gfc_actual_arglist *args)
     else
       nlabelless++;
 
   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;
     }
 
@@ -2804,16 +2804,16 @@ min_max_args (gfc_actual_arglist *args)
 	goto duplicate;
 
   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;
 }
 
 
@@ -2838,11 +2838,11 @@ check_rest (bt type, int kind, gfc_actua
 				   "kinds at %L", &x->where))
 		return false;
 	    }
 	  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;
 	    }
 	}
@@ -2876,11 +2876,11 @@ gfc_check_min_max (gfc_actual_arglist *a
 			   gfc_current_intrinsic, &x->where))
 	return false;
     }
   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;
     }
 
   return check_rest (x->ts.type, x->ts.kind, arg);
@@ -2926,28 +2926,28 @@ gfc_check_malloc (gfc_expr *size)
 bool
 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;
     }
 
   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;
     }
 
   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;
     }
 
@@ -2957,12 +2957,12 @@ gfc_check_matmul (gfc_expr *matrix_a, gf
       if (!rank_check (matrix_b, 1, 2))
 	return false;
       /* 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;
 	}
       break;
@@ -2976,20 +2976,20 @@ gfc_check_matmul (gfc_expr *matrix_a, gf
       /* matrix_b has rank 1 or 2 here. Common check for the cases
 	 - matrix_a has shape (n,m) and matrix_b has shape (m, k)
 	 - 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;
 	}
       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;
     }
 
@@ -3160,11 +3160,11 @@ gfc_check_mask (gfc_expr *i, gfc_expr *k
 bool
 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;
     }
 
@@ -3335,11 +3335,11 @@ gfc_check_null (gfc_expr *mold)
 
   attr = gfc_variable_attr (mold, NULL);
 
   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);
       return false;
     }
@@ -3350,11 +3350,11 @@ gfc_check_null (gfc_expr *mold)
     return false;
 
   /* 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;
     }
 
@@ -3422,13 +3422,13 @@ gfc_check_pack (gfc_expr *array, gfc_exp
 	  else if (mask->expr_type == EXPR_CONSTANT && mask->value.logical)
 	    mask_true_values = mpz_get_si (array_size);
 
 	  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,
 			 mpz_get_si (vector_size), mask_true_values);
 	      return false;
@@ -3480,19 +3480,19 @@ gfc_check_present (gfc_expr *a)
     return false;
 
   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;
     }
 
   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);
       return false;
     }
@@ -3507,12 +3507,12 @@ gfc_check_present (gfc_expr *a)
       && !(a->ref->next == NULL && a->ref->type == REF_ARRAY
 	   && (a->ref->u.ar.type == AR_FULL
 	       || (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;
     }
 
   return true;
@@ -3669,11 +3669,11 @@ gfc_check_reshape (gfc_expr *source, gfc
   shape_size = mpz_get_ui (size);
   mpz_clear (size);
 
   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;
     }
   else if (shape_size > GFC_MAX_DIMENSIONS)
@@ -3693,11 +3693,11 @@ gfc_check_reshape (gfc_expr *source, gfc
 	    continue;
 
 	  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);
 	      return false;
 	    }
@@ -3733,11 +3733,11 @@ gfc_check_reshape (gfc_expr *source, gfc
 	  order_size = mpz_get_ui (size);
 	  mpz_clear (size);
 
 	  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,
 			 order_size, shape_size);
 	      return false;
@@ -3751,20 +3751,20 @@ gfc_check_reshape (gfc_expr *source, gfc
 
 	      gfc_extract_int (e, &dim);
 
 	      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);
 		  return false;
 		}
 
 	      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,
 			     gfc_current_intrinsic, &e->where, dim);
 		  return false;
@@ -3813,40 +3813,40 @@ gfc_check_reshape (gfc_expr *source, gfc
 bool
 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,
 		   &a->where, gfc_typename (&a->ts));
         return false;
     }
 
   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);
       return false;
     }
 
   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,
 		   &b->where, gfc_typename (&b->ts));
       return false;
     }
 
   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);
       return false;
     }
@@ -4084,11 +4084,11 @@ gfc_check_size (gfc_expr *array, gfc_exp
 bool
 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;
     }
 
@@ -4097,22 +4097,22 @@ gfc_check_sizeof (gfc_expr *arg)
       && (arg->symtree->n.sym->as == NULL
 	  || (arg->symtree->n.sym->as->type != AS_ASSUMED_SHAPE
 	      && 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;
     }
 
   if (arg->rank && arg->expr_type == EXPR_VARIABLE
       && arg->symtree->n.sym->as != NULL
       && 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;
     }
 
@@ -4227,20 +4227,20 @@ gfc_check_c_sizeof (gfc_expr *arg)
 {
   const char *msg;
 
   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);
       return false;
     }
 
   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);
       return false;
     }
@@ -4248,11 +4248,11 @@ gfc_check_c_sizeof (gfc_expr *arg)
   if (arg->rank && arg->expr_type == EXPR_VARIABLE
       && arg->symtree->n.sym->as != NULL
       && 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;
     }
 
@@ -4447,11 +4447,11 @@ gfc_check_c_funloc (gfc_expr *x)
       gfc_namespace *ns = gfc_current_ns;
 
       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;
 	  }
     }
 
@@ -4573,11 +4573,11 @@ gfc_check_sngl (gfc_expr *a)
 bool
 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);
 
       return false;
     }
@@ -4592,11 +4592,11 @@ gfc_check_spread (gfc_expr *source, gfc_
   if (dim
       && dim->expr_type == EXPR_CONSTANT
       && (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;
     }
 
@@ -5187,13 +5187,13 @@ gfc_check_unpack (gfc_expr *vector, gfc_
 	  mask_ctor = gfc_constructor_next (mask_ctor);
 	}
 
       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);
 	  return false;
 	}
@@ -5201,12 +5201,12 @@ gfc_check_unpack (gfc_expr *vector, gfc_
       mpz_clear (vector_size);
     }
 
   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;
     }
 
@@ -5214,11 +5214,11 @@ gfc_check_unpack (gfc_expr *vector, gfc_
     {
       int i;
       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,
 		     &field->where);
 	}
@@ -5472,11 +5472,11 @@ gfc_check_random_seed (gfc_expr *size, g
       if (!kind_value_check (put, 1, gfc_default_integer_kind))
 	return false;
 
       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);
     }
 
@@ -5504,11 +5504,11 @@ gfc_check_random_seed (gfc_expr *size, g
       if (!kind_value_check (get, 2, gfc_default_integer_kind))
 	return false;
 
        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);
     }
 
@@ -5815,11 +5815,11 @@ gfc_check_getarg (gfc_expr *pos, gfc_exp
   if (!type_check (pos, 0, BT_INTEGER))
     return false;
 
   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);
       return false;
     }
@@ -6167,27 +6167,27 @@ gfc_check_system_sub (gfc_expr *cmd, gfc
 bool
 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;
     }
 
   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;
     }
 
   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);
       return false;
     }
@@ -6205,19 +6205,19 @@ gfc_check_and (gfc_expr *i, gfc_expr *j)
 bool
 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;
     }
 
   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;
     }
 
@@ -6230,11 +6230,11 @@ gfc_check_storage_size (gfc_expr *a, gfc
   if (!scalar_check (kind, 1))
     return false;
 
   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;
     }
 
Index: gcc/fortran/primary.c
===================================================================
--- gcc/fortran/primary.c	(revision 218457)
+++ gcc/fortran/primary.c	(working copy)
@@ -1272,11 +1272,12 @@ match_complex_part (gfc_expr **result)
 
 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;
   match m;
 
@@ -1285,22 +1286,22 @@ match_complex_constant (gfc_expr **resul
 
   m = gfc_match_char ('(');
   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;
     }
 
   /* If m is error, then something was wrong with the real part and we
@@ -1308,14 +1309,14 @@ match_complex_constant (gfc_expr **resul
      ambiguous case here is the start of an iterator list of some
      sort. These sort of lists are matched prior to coming here.  */
 
   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)
     goto syntax;
   if (m == MATCH_ERROR)
@@ -2491,11 +2492,11 @@ gfc_convert_to_structure_constructor (gf
 	   comp_iter = comp_iter->next)
 	{
 	  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);
 	      goto cleanup;
 	    }
Index: gcc/testsuite/gfortran.dg/do_iterator.f90
===================================================================
--- gcc/testsuite/gfortran.dg/do_iterator.f90	(revision 218457)
+++ gcc/testsuite/gfortran.dg/do_iterator.f90	(working copy)
@@ -8,6 +8,6 @@ DO I=1,5       ! { dg-error "cannot be r
 END DO
 DO I=1,5       ! { dg-error "cannot be redefined" "changing do-iterator 3" }
    READ(5,*,iostat=i) j ! { dg-error "cannot be redefined" "changing do-iterator 3" }
 ENDDO
 END
-! { dg-error "Invalid character" "character" { target *-*-* } 7 }
+

Manuel López-Ibáñez wrote:
> OK, this is then the final patch. Bootstrapped and regression tested
> on x86_64-linux-gnu.
> OK to commit?

  void
  gfc_buffer_error (bool flag)
  {
    buffered_p = flag;
-  pp_warning_buffer.flush_p = !flag;
+  buffered_p = flag;
  }

Now there are two "buffered_p" …

Otherwise, it looks good to me. Thanks!

Tobias

> gcc/ChangeLog:
>
> 2014-12-07  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.
>      (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-07  Manuel López-Ibáñez  <manu@gcc.gnu.org>
>
>          * gfortran.dg/do_iterator.f90: Remove bogus dg-warning.
>
> gcc/fortran/ChangeLog:
>
> 2014-12-07  Manuel López-Ibáñez  <manu@gcc.gnu.org>
>
>      PR fortran/44054
>      * error.c (pp_error_buffer): New static variable.
>      (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.
>      (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): Init pp_error_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.