gcc/fortran/ChangeLog:

2015-05-24  Manuel López-Ibáñez  <manu@gcc.gnu.org>

	PR fortran/44054
	* gfortran.h (struct gfc_error_buf): Rename as
	gfc_error_buffer. Move closer to push, pop and free
	methods. Reimplement using an output_buffer.
	* error.c (errors, warnings, warning_buffer, cur_error_buffer):
	Delete everywhere in this file.
	(error_char): Delete all contents.
	(gfc_increment_error_count): Delete.
	(gfc_error_now): Update comment. Set error_buffer.flag.
	(gfc_warning_check): Do not handle warning_buffer.
	(gfc_error_1): Delete.
	(gfc_error_now_1): Delete.
	(gfc_error_check): Simplify.
	(gfc_move_error_buffer_from_to): Renamed from
	gfc_move_output_buffer_from_to.
	(gfc_push_error): Handle only gfc_error_buffer.
	(gfc_pop_error): Likewise.
	(gfc_free_error): Likewise.
	(gfc_get_errors): Remove warnings and errors.
	(gfc_diagnostics_init): Use static error_buffer.
	(gfc_error_1,gfc_error_now_1): Delete declarations.
	* symbol.c, decl.c, trans-common.c, data.c, expr.c, expr.c,
	frontend-passes.c, resolve.c, match.c, parse.c: Replace
	gfc_error_1 with gfc_error and gfc_error_now_1 with gfc_error_1
	everywhere.
	* f95-lang.c (gfc_be_parse_file): Do not update errorcount and
	warningcount here.
	* primary.c (match_complex_constant): Replace gfc_error_buf and
	output_buffer with gfc_error_buffer.




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

15 files changed, 211 insertions, 363 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 9ce4b567eae..420a99d7788 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,35 @@
+2015-05-24  Manuel López-Ibáñez  <manu@gcc.gnu.org>
+
+	PR fortran/44054
+	* gfortran.h (struct gfc_error_buf): Rename as
+	gfc_error_buffer. Move closer to push, pop and free
+	methods. Reimplement using an output_buffer.
+	* error.c (errors, warnings, warning_buffer, cur_error_buffer):
+	Delete everywhere in this file.
+	(error_char): Delete all contents.
+	(gfc_increment_error_count): Delete.
+	(gfc_error_now): Update comment. Set error_buffer.flag.
+	(gfc_warning_check): Do not handle warning_buffer.
+	(gfc_error_1): Delete.
+	(gfc_error_now_1): Delete.
+	(gfc_error_check): Simplify.
+	(gfc_move_error_buffer_from_to): Renamed from
+	gfc_move_output_buffer_from_to.
+	(gfc_push_error): Handle only gfc_error_buffer.
+	(gfc_pop_error): Likewise.
+	(gfc_free_error): Likewise.
+	(gfc_get_errors): Remove warnings and errors.
+	(gfc_diagnostics_init): Use static error_buffer.
+	(gfc_error_1,gfc_error_now_1): Delete declarations.
+	* symbol.c, decl.c, trans-common.c, data.c, expr.c, expr.c,
+	frontend-passes.c, resolve.c, match.c, parse.c: Replace
+	gfc_error_1 with gfc_error and gfc_error_now_1 with gfc_error_1
+	everywhere.
+	* f95-lang.c (gfc_be_parse_file): Do not update errorcount and
+	warningcount here.
+	* primary.c (match_complex_constant): Replace gfc_error_buf and
+	output_buffer with gfc_error_buffer.
+
 2015-05-22  Jim Wilson  <jim.wilson@linaro.org>
 
 	* Make-lang.in (check_gfortran_parallelize): Update comment.
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index a6ba549f296..3286a58df5c 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -1031,8 +1031,8 @@ gfc_check_atomic (gfc_expr *atom, int atom_no, gfc_expr *value, int val_no,
 
   if (atom->ts.type != value->ts.type)
     {
-      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_error ("%qs argument of %qs intrinsic at %L shall have the same "
+		 "type as %qs 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;
@@ -1575,7 +1575,7 @@ gfc_check_co_reduce (gfc_expr *a, gfc_expr *op, gfc_expr *result_image,
 
   if (!gfc_compare_types (&a->ts, &sym->result->ts))
     {
-      gfc_error_1 ("A argument at %L has type %s but the function passed as "
+      gfc_error ("A argument at %L has type %s but the function passed as "
 		 "OPERATOR at %L returns %s",
 		 &a->where, gfc_typename (&a->ts), &op->where,
 		 gfc_typename (&sym->result->ts));
@@ -1655,16 +1655,16 @@ gfc_check_co_reduce (gfc_expr *a, gfc_expr *op, gfc_expr *result_image,
 	  && ((formal_size1 && actual_size != formal_size1)
 	       || (formal_size2 && actual_size != formal_size2)))
 	{
-	  gfc_error_1 ("The character length of the A argument at %L and of the "
-		       "arguments of the OPERATOR at %L shall be the same",
+	  gfc_error ("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_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);
+	  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);
 	  return false;
 	}
     }
@@ -1680,10 +1680,10 @@ gfc_check_co_minmax (gfc_expr *a, gfc_expr *result_image, gfc_expr *stat,
   if (a->ts.type != BT_INTEGER && a->ts.type != BT_REAL
       && a->ts.type != BT_CHARACTER)
     {
-       gfc_error_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);
+       gfc_error ("%qs argument of %qs 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);
@@ -1956,7 +1956,7 @@ gfc_check_dshift (gfc_expr *i, gfc_expr *j, gfc_expr *shift)
 
   if (i->is_boz && j->is_boz)
     {
-      gfc_error_1 ("'I' at %L and 'J' at %L cannot both be BOZ literal "
+      gfc_error ("%<I%> at %L and %<J%>' at %L cannot both be BOZ literal "
 		   "constants", &i->where, &j->where);
       return false;
     }
@@ -2472,9 +2472,9 @@ gfc_check_ishftc (gfc_expr *i, gfc_expr *shift, gfc_expr *size)
 
 	      if (i2 > i3)
 		{
-		  gfc_error_1 ("The absolute value of SHIFT at %L must be less "
-			       "than or equal to SIZE at %L", &shift->where,
-			       &size->where);
+		  gfc_error ("The absolute value of SHIFT at %L must be less "
+			     "than or equal to SIZE at %L", &shift->where,
+			     &size->where);
 		  return false;
 		}
 	     }
diff --git a/gcc/fortran/data.c b/gcc/fortran/data.c
index 4fd84e4b415..ef9101b8d55 100644
--- a/gcc/fortran/data.c
+++ b/gcc/fortran/data.c
@@ -253,9 +253,9 @@ gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index,
 
 	  if (init && expr->expr_type != EXPR_ARRAY)
 	    {
-	      gfc_error_1 ("'%s' at %L already is initialized at %L",
-			   lvalue->symtree->n.sym->name, &lvalue->where,
-			   &init->where);
+	      gfc_error ("%qs at %L already is initialized at %L",
+			 lvalue->symtree->n.sym->name, &lvalue->where,
+			 &init->where);
 	      goto abort;
 	    }
 
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 086a20ea6d8..e2fd670de39 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -921,17 +921,17 @@ get_proc_name (const char *name, gfc_symbol **result, bool module_fcn_entry)
 	  && sym->attr.proc != 0
 	  && (sym->attr.subroutine || sym->attr.function)
 	  && sym->attr.if_source != IFSRC_UNKNOWN)
-	gfc_error_now_1 ("Procedure '%s' at %C is already defined at %L",
-			 name, &sym->declared_at);
+	gfc_error_now ("Procedure %qs at %C is already defined at %L",
+		       name, &sym->declared_at);
 
       /* Trap a procedure with a name the same as interface in the
 	 encompassing scope.  */
       if (sym->attr.generic != 0
 	  && (sym->attr.subroutine || sym->attr.function)
 	  && !sym->attr.mod_proc)
-	gfc_error_now_1 ("Name '%s' at %C is already defined"
-			 " as a generic interface at %L",
-			 name, &sym->declared_at);
+	gfc_error_now ("Name %qs at %C is already defined"
+		       " as a generic interface at %L",
+		       name, &sym->declared_at);
 
       /* Trap declarations of attributes in encompassing scope.  The
 	 signature for this is that ts.kind is set.  Legitimate
@@ -942,9 +942,9 @@ get_proc_name (const char *name, gfc_symbol **result, bool module_fcn_entry)
 	  && gfc_current_ns->parent != NULL
 	  && sym->attr.access == 0
 	  && !module_fcn_entry)
-	gfc_error_now_1 ("Procedure '%s' at %C has an explicit interface "
-			 "and must not have attributes declared at %L",
-			 name, &sym->declared_at);
+	gfc_error_now ("Procedure %qs at %C has an explicit interface "
+		       "and must not have attributes declared at %L",
+		       name, &sym->declared_at);
     }
 
   if (gfc_current_ns->parent == NULL || *result == NULL)
@@ -2868,9 +2868,9 @@ gfc_match_decl_type_spec (gfc_typespec *ts, int implicit_flag)
        && !(sym->attr.flavor == FL_PROCEDURE && sym->attr.generic))
       || sym->attr.subroutine)
     {
-      gfc_error_1 ("Type name '%s' at %C conflicts with previously declared "
-		   "entity at %L, which has the same name", name,
-		   &sym->declared_at);
+      gfc_error ("Type name %qs at %C conflicts with previously declared "
+		 "entity at %L, which has the same name", name,
+		 &sym->declared_at);
       return MATCH_ERROR;
     }
 
diff --git a/gcc/fortran/error.c b/gcc/fortran/error.c
index 23308b6544e..2512cfc36aa 100644
--- a/gcc/fortran/error.c
+++ b/gcc/fortran/error.c
@@ -40,12 +40,12 @@ static int suppress_errors = 0;
 
 static bool warnings_not_errors = false;
 
-static int terminal_width, errors, warnings;
-
-static gfc_error_buf error_buffer, warning_buffer, *cur_error_buffer;
+static int terminal_width;
 
 /* True if the error/warnings should be buffered.  */
 static bool buffered_p;
+
+static gfc_error_buffer error_buffer;
 /* These are always buffered buffers (.flush_p == false) to be used by
    the pretty-printer.  */
 static output_buffer *pp_error_buffer, *pp_warning_buffer;
@@ -100,8 +100,6 @@ void
 gfc_error_init_1 (void)
 {
   terminal_width = gfc_get_terminal_width ();
-  errors = 0;
-  warnings = 0;
   gfc_buffer_error (false);
 }
 
@@ -119,42 +117,9 @@ gfc_buffer_error (bool flag)
    buffered_p.  */
 
 static void
-error_char (char c)
+error_char (char)
 {
-  if (buffered_p)
-    {
-      if (cur_error_buffer->index >= cur_error_buffer->allocated)
-	{
-	  cur_error_buffer->allocated = cur_error_buffer->allocated
-				      ? cur_error_buffer->allocated * 2 : 1000;
-	  cur_error_buffer->message = XRESIZEVEC (char, cur_error_buffer->message,
-						  cur_error_buffer->allocated);
-	}
-      cur_error_buffer->message[cur_error_buffer->index++] = c;
-    }
-  else
-    {
-      if (c != 0)
-	{
-	  /* We build up complete lines before handing things
-	     over to the library in order to speed up error printing.  */
-	  static char *line;
-	  static size_t allocated = 0, index = 0;
-
-	  if (index + 1 >= allocated)
-	    {
-	      allocated = allocated ? allocated * 2 : 1000;
-	      line = XRESIZEVEC (char, line, allocated);
-	    }
-	  line[index++] = c;
-	  if (c == '\n')
-	    {
-	      line[index] = '\0';
-	      fputs (line, stderr);
-	      index = 0;
-	    }
-	}
-    }
+  /* FIXME: Unused function to be removed in a subsequent patch.  */
 }
 
 
@@ -782,18 +747,6 @@ error_printf (const char *gmsgid, ...)
 }
 
 
-/* Increment the number of errors, and check whether too many have 
-   been printed.  */
-
-static void
-gfc_increment_error_count (void)
-{
-  errors++;
-  if ((gfc_option.max_errors != 0) && (errors >= gfc_option.max_errors))
-    gfc_fatal_error ("Error count reached limit of %d.", gfc_option.max_errors);
-}
-
-
 /* Clear any output buffered in a pretty-print output_buffer.  */
 
 static void
@@ -1247,9 +1200,6 @@ gfc_warning_now (int opt, const char *gmsgid, ...)
 
 
 /* Immediate error (i.e. do not buffer).  */
-/* This function uses the common diagnostics, but does not support
-   two locations; when being used in scanner.c, ensure that the location
-   is properly setup. Otherwise, use gfc_error_now_1.   */
 
 void
 gfc_error_now (const char *gmsgid, ...)
@@ -1257,6 +1207,8 @@ gfc_error_now (const char *gmsgid, ...)
   va_list argp;
   diagnostic_info diagnostic;
 
+  error_buffer.flag = true;
+
   va_start (argp, gmsgid);
   diagnostic_set_info (&diagnostic, gmsgid, &argp, UNKNOWN_LOCATION, DK_ERROR);
   report_diagnostic (&diagnostic);
@@ -1285,8 +1237,6 @@ gfc_fatal_error (const char *gmsgid, ...)
 void
 gfc_clear_warning (void)
 {
-  warning_buffer.flag = 0;
-
   gfc_clear_pp_buffer (pp_warning_buffer);
   warningcount_buffered = 0;
   werrorcount_buffered = 0;
@@ -1299,15 +1249,8 @@ gfc_clear_warning (void)
 void
 gfc_warning_check (void)
 {
-  if (warning_buffer.flag)
-    {
-      warnings++;
-      if (warning_buffer.message != NULL)
-	fputs (warning_buffer.message, stderr);
-      gfc_clear_warning ();
-    }
   /* This is for the new diagnostics machinery.  */
-  else if (! gfc_output_buffer_empty_p (pp_warning_buffer))
+  if (! gfc_output_buffer_empty_p (pp_warning_buffer))
     {
       pretty_printer *pp = global_dc->printer;
       output_buffer *tmp_buffer = pp->buffer;
@@ -1325,62 +1268,6 @@ gfc_warning_check (void)
 
 
 /* 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_1 (const char *gmsgid, ...)
-{
-  va_list argp;
-
-  if (warnings_not_errors)
-    goto warning;
-
-  if (suppress_errors)
-    return;
-
-  error_buffer.flag = 1;
-  error_buffer.index = 0;
-  cur_error_buffer = &error_buffer;
-
-  va_start (argp, gmsgid);
-  error_print (_("Error:"), _(gmsgid), argp);
-  va_end (argp);
-
-  error_char ('\0');
-
-  if (!buffered_p)
-    gfc_increment_error_count();
-
-  return;
-
-warning:
-
-  if (inhibit_warnings)
-    return;
-
-  warning_buffer.flag = 1;
-  warning_buffer.index = 0;
-  cur_error_buffer = &warning_buffer;
-
-  va_start (argp, gmsgid);
-  error_print (_("Warning:"), _(gmsgid), argp);
-  va_end (argp);
-
-  error_char ('\0');
-
-  if (!buffered_p)
-  {
-    warnings++;
-    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.   */
 
 static void
 gfc_error (const char *gmsgid, va_list ap)
@@ -1440,38 +1327,6 @@ gfc_error (const char *gmsgid, ...)
 }
 
 
-/* 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.  */
-
-void
-gfc_error_now_1 (const char *gmsgid, ...)
-{
-  va_list argp;
-  bool buffered_p_saved;
-
-  error_buffer.flag = 1;
-  error_buffer.index = 0;
-  cur_error_buffer = &error_buffer;
-
-  buffered_p_saved = buffered_p;
-  buffered_p = false;
-
-  va_start (argp, gmsgid);
-  error_print (_("Error:"), _(gmsgid), argp);
-  va_end (argp);
-
-  error_char ('\0');
-
-  gfc_increment_error_count();
-
-  buffered_p = buffered_p_saved;
-
-  if (flag_fatal_errors)
-    exit (FATAL_EXIT_CODE);
-}
-
-
 /* This shouldn't happen... but sometimes does.  */
 
 void
@@ -1516,24 +1371,10 @@ gfc_error_flag_test (void)
 bool
 gfc_error_check (void)
 {
-  bool error_raised = (bool) error_buffer.flag;
-
-  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))
+  if (error_buffer.flag
+      || ! gfc_output_buffer_empty_p (pp_error_buffer))
     {
-      error_raised = true;
+      error_buffer.flag = false;
       pretty_printer *pp = global_dc->printer;
       output_buffer *tmp_buffer = pp->buffer;
       pp->buffer = pp_error_buffer;
@@ -1542,9 +1383,10 @@ gfc_error_check (void)
       gcc_assert (gfc_output_buffer_empty_p (pp_error_buffer));
       diagnostic_action_after_output (global_dc, DK_ERROR);
       pp->buffer = tmp_buffer;
+      return true;
     }
 
-  return error_raised;
+  return false;
 }
 
 /* Move the text buffered from FROM to TO, then clear
@@ -1552,8 +1394,15 @@ gfc_error_check (void)
    cleared. */
 
 static void
-gfc_move_output_buffer_from_to (output_buffer *from, output_buffer *to)
+gfc_move_error_buffer_from_to (gfc_error_buffer * buffer_from,
+			       gfc_error_buffer * buffer_to)
 {
+  output_buffer * from = &(buffer_from->buffer);
+  output_buffer * to =  &(buffer_to->buffer);
+
+  buffer_to->flag = buffer_from->flag;
+  buffer_from->flag = false;
+
   gfc_clear_pp_buffer (to);
   /* We make sure this is always buffered.  */
   to->flush_p = false;
@@ -1569,46 +1418,27 @@ gfc_move_output_buffer_from_to (output_buffer *from, output_buffer *to)
 /* Save the existing error state.  */
 
 void
-gfc_push_error (output_buffer *buffer_err, gfc_error_buf *err)
+gfc_push_error (gfc_error_buffer *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);
+  gfc_move_error_buffer_from_to (&error_buffer, err);
 }
 
 
 /* Restore a previous pushed error state.  */
 
 void
-gfc_pop_error (output_buffer *buffer_err, gfc_error_buf *err)
+gfc_pop_error (gfc_error_buffer *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);
+  gfc_move_error_buffer_from_to (err, &error_buffer);
 }
 
 
 /* Free a pushed error state, but keep the current error state.  */
 
 void
-gfc_free_error (output_buffer *buffer_err, gfc_error_buf *err)
+gfc_free_error (gfc_error_buffer *err)
 {
-  if (err->flag)
-    free (err->message);
-
-  gfc_clear_pp_buffer (buffer_err);
+  gfc_clear_pp_buffer (&(err->buffer));
 }
 
 
@@ -1618,9 +1448,9 @@ void
 gfc_get_errors (int *w, int *e)
 {
   if (w != NULL)
-    *w = warnings + warningcount + werrorcount;
+    *w = warningcount + werrorcount;
   if (e != NULL)
-    *e = errors + errorcount + sorrycount + werrorcount;
+    *e = errorcount + sorrycount + werrorcount;
 }
 
 
@@ -1642,7 +1472,7 @@ gfc_diagnostics_init (void)
   global_dc->caret_chars[1] = '2';
   pp_warning_buffer = new (XNEW (output_buffer)) output_buffer ();
   pp_warning_buffer->flush_p = false;
-  pp_error_buffer = new (XNEW (output_buffer)) output_buffer ();
+  pp_error_buffer = &(error_buffer.buffer);
   pp_error_buffer->flush_p = false;
 }
 
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index a0c37566cfb..b569e0ccb4c 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -4994,7 +4994,7 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj,
       if (!gfc_check_vardef_context (assoc->target, pointer, false, false, NULL))
 	{
 	  if (context)
-	    gfc_error_1 ("Associate-name '%s' can not appear in a variable"
+	    gfc_error ("Associate-name %qs can not appear in a variable"
 		       " definition context (%s) at %L because its target"
 		       " at %L can not, either",
 		       name, context, &e->where,
@@ -5036,12 +5036,12 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj,
 			  if (gfc_dep_compare_expr (ec, en) == 0)
 			    {
 			      if (context)
-				gfc_error_now_1 ("Elements with the same value "
-						 "at %L and %L in vector "
-						 "subscript in a variable "
-						 "definition context (%s)",
-						 &(ec->where), &(en->where),
-						 context);
+				gfc_error_now ("Elements with the same value "
+					       "at %L and %L in vector "
+					       "subscript in a variable "
+					       "definition context (%s)",
+					       &(ec->where), &(en->where),
+					       context);
 			      return false;
 			    }
 			}
diff --git a/gcc/fortran/f95-lang.c b/gcc/fortran/f95-lang.c
index de9c813bc53..28eaa6aebac 100644
--- a/gcc/fortran/f95-lang.c
+++ b/gcc/fortran/f95-lang.c
@@ -221,18 +221,10 @@ gfc_create_decls (void)
 static void
 gfc_be_parse_file (void)
 {
-  int errors;
-  int warnings;
-
   gfc_create_decls ();
   gfc_parse_file ();
   gfc_generate_constructors ();
 
-  /* Tell the frontend about any errors.  */
-  gfc_get_errors (&warnings, &errors);
-  errorcount += errors;
-  warningcount += warnings;
-
   /* Clear the binding level stack.  */
   while (!global_bindings_p ())
     poplevel (0, 0);
diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c
index aeee73e0489..45b053e665b 100644
--- a/gcc/fortran/frontend-passes.c
+++ b/gcc/fortran/frontend-passes.c
@@ -1879,19 +1879,19 @@ doloop_code (gfc_code **c, int *walk_subtrees ATTRIBUTE_UNUSED,
 		  && a->expr->symtree->n.sym == do_sym)
 		{
 		  if (f->sym->attr.intent == INTENT_OUT)
-		    gfc_error_now_1 ("Variable '%s' at %L set to undefined "
-				     "value inside loop  beginning at %L as "
-				     "INTENT(OUT) argument to subroutine '%s'",
-				     do_sym->name, &a->expr->where,
-				     &doloop_list[i]->loc,
-				     co->symtree->n.sym->name);
+		    gfc_error_now ("Variable %qs at %L set to undefined "
+				   "value inside loop  beginning at %L as "
+				   "INTENT(OUT) argument to subroutine %qs",
+				   do_sym->name, &a->expr->where,
+				   &doloop_list[i]->loc,
+				   co->symtree->n.sym->name);
 		  else if (f->sym->attr.intent == INTENT_INOUT)
-		    gfc_error_now_1 ("Variable '%s' at %L not definable inside "
-				     "loop beginning at %L as INTENT(INOUT) "
-				     "argument to subroutine '%s'",
-				     do_sym->name, &a->expr->where,
-				     &doloop_list[i]->loc,
-				     co->symtree->n.sym->name);
+		    gfc_error_now ("Variable %qs at %L not definable inside "
+				   "loop beginning at %L as INTENT(INOUT) "
+				   "argument to subroutine %qs",
+				   do_sym->name, &a->expr->where,
+				   &doloop_list[i]->loc,
+				   co->symtree->n.sym->name);
 		}
 	    }
 	  a = a->next;
@@ -1951,17 +1951,17 @@ do_function (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED,
 	      && a->expr->symtree->n.sym == do_sym)
 	    {
 	      if (f->sym->attr.intent == INTENT_OUT)
-		gfc_error_now_1 ("Variable '%s' at %L set to undefined value "
-				 "inside loop beginning at %L as INTENT(OUT) "
-				 "argument to function '%s'", do_sym->name,
-				 &a->expr->where, &doloop_list[i]->loc,
-				 expr->symtree->n.sym->name);
+		gfc_error_now ("Variable %qs at %L set to undefined value "
+			       "inside loop beginning at %L as INTENT(OUT) "
+			       "argument to function %qs", do_sym->name,
+			       &a->expr->where, &doloop_list[i]->loc,
+			       expr->symtree->n.sym->name);
 	      else if (f->sym->attr.intent == INTENT_INOUT)
-		gfc_error_now_1 ("Variable '%s' at %L not definable inside loop"
-				 " beginning at %L as INTENT(INOUT) argument to"
-				 " function '%s'", do_sym->name,
-				 &a->expr->where, &doloop_list[i]->loc,
-				 expr->symtree->n.sym->name);
+		gfc_error_now ("Variable %qs at %L not definable inside loop"
+			       " beginning at %L as INTENT(INOUT) argument to"
+			       " function %qs", do_sym->name,
+			       &a->expr->where, &doloop_list[i]->loc,
+			       expr->symtree->n.sym->name);
 	    }
 	}
       a = a->next;
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index aaa4e890979..905d47c0086 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2645,14 +2645,6 @@ const char * gfc_get_string (const char *, ...) ATTRIBUTE_PRINTF_1;
 bool gfc_find_sym_in_expr (gfc_symbol *, gfc_expr *);
 
 /* error.c */
-
-typedef struct gfc_error_buf
-{
-  int flag;
-  size_t allocated, index;
-  char *message;
-} gfc_error_buf;
-
 void gfc_error_init_1 (void);
 void gfc_diagnostics_init (void);
 void gfc_diagnostics_finish (void);
@@ -2668,9 +2660,7 @@ bool gfc_warning_now_at (location_t loc, int opt, const char *gmsgid, ...)
 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);
@@ -2685,10 +2675,17 @@ bool gfc_notify_std (int, const char *, ...) ATTRIBUTE_GCC_GFC(2,3);
 #define gfc_syntax_error(ST)	\
   gfc_error ("Syntax error in %s statement at %C", gfc_ascii_statement (ST));
 
-#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 *);
+#include "pretty-print.h"  /* For output_buffer.  */
+struct gfc_error_buffer
+{
+  bool flag;
+  output_buffer buffer;
+  gfc_error_buffer(void) : flag(false), buffer() {}
+};
+
+void gfc_push_error (gfc_error_buffer *);
+void gfc_pop_error (gfc_error_buffer *);
+void gfc_free_error (gfc_error_buffer *);
 
 void gfc_get_errors (int *, int *);
 void gfc_errors_to_warnings (bool);
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index 3e12483cc0f..2e15af29df6 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -3599,7 +3599,7 @@ alloc_opt_list:
 	  /* The next 2 conditionals check C631.  */
 	  if (ts.type != BT_UNKNOWN)
 	    {
-	      gfc_error_1 ("SOURCE tag at %L conflicts with the typespec at %L",
+	      gfc_error ("SOURCE tag at %L conflicts with the typespec at %L",
 			 &tmp->where, &old_locus);
 	      goto cleanup;
 	    }
@@ -3636,7 +3636,7 @@ alloc_opt_list:
 	  /* Check F08:C637.  */
 	  if (ts.type != BT_UNKNOWN)
 	    {
-	      gfc_error_1 ("MOLD tag at %L conflicts with the typespec at %L",
+	      gfc_error ("MOLD tag at %L conflicts with the typespec at %L",
 			 &tmp->where, &old_locus);
 	      goto cleanup;
 	    }
@@ -3662,8 +3662,8 @@ alloc_opt_list:
   /* Check F08:C637.  */
   if (source && mold)
     {
-      gfc_error_1 ("MOLD tag at %L conflicts with SOURCE tag at %L",
-		  &mold->where, &source->where);
+      gfc_error ("MOLD tag at %L conflicts with SOURCE tag at %L",
+		 &mold->where, &source->where);
       goto cleanup;
     }
 
@@ -4350,12 +4350,12 @@ gfc_match_common (void)
                   /* If we find an error, just print it and continue,
                      cause it's just semantic, and we can see if there
                      are more errors.  */
-                  gfc_error_now_1 ("Variable '%s' at %L in common block '%s' "
-				   "at %C must be declared with a C "
-				   "interoperable kind since common block "
-				   "'%s' is bind(c)",
-				   sym->name, &(sym->declared_at), t->name,
-				   t->name);
+                  gfc_error_now ("Variable %qs at %L in common block %qs "
+				 "at %C must be declared with a C "
+				 "interoperable kind since common block "
+				 "%qs is bind(c)",
+				 sym->name, &(sym->declared_at), t->name,
+				 t->name);
                 }
 
               if (sym->attr.is_bind_c == 1)
@@ -4889,8 +4889,7 @@ recursive_stmt_fcn (gfc_expr *e, gfc_symbol *sym)
 match
 gfc_match_st_function (void)
 {
-  gfc_error_buf old_error_1;
-  output_buffer old_error;
+  gfc_error_buffer old_error;
 
   gfc_symbol *sym;
   gfc_expr *expr;
@@ -4900,7 +4899,7 @@ gfc_match_st_function (void)
   if (m != MATCH_YES)
     return m;
 
-  gfc_push_error (&old_error, &old_error_1);
+  gfc_push_error (&old_error);
 
   if (!gfc_add_procedure (&sym->attr, PROC_ST_FUNCTION, sym->name, NULL))
     goto undo_error;
@@ -4912,7 +4911,7 @@ gfc_match_st_function (void)
   if (m == MATCH_NO)
     goto undo_error;
 
-  gfc_free_error (&old_error, &old_error_1);
+  gfc_free_error (&old_error);
 
   if (m == MATCH_ERROR)
     return m;
@@ -4931,7 +4930,7 @@ gfc_match_st_function (void)
   return MATCH_YES;
 
 undo_error:
-  gfc_pop_error (&old_error, &old_error_1);
+  gfc_pop_error (&old_error);
   return MATCH_NO;
 }
 
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 3135d9af797..56c67826dbe 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -108,14 +108,13 @@ match_word_omp_simd (const char *str, match (*subr) (void), locus *old_locus,
 static void
 use_modules (void)
 {
-  gfc_error_buf old_error_1;
-  output_buffer old_error;
+  gfc_error_buffer old_error;
 
-  gfc_push_error (&old_error, &old_error_1);
+  gfc_push_error (&old_error);
   gfc_buffer_error (false);
   gfc_use_modules ();
   gfc_buffer_error (true);
-  gfc_pop_error (&old_error, &old_error_1);
+  gfc_pop_error (&old_error);
   gfc_commit_symbols ();
   gfc_warning_check ();
   gfc_current_ns->old_cl_list = gfc_current_ns->cl_list;
@@ -2435,7 +2434,7 @@ verify_st_order (st_state *p, gfc_statement st, bool silent)
 
 order:
   if (!silent)
-    gfc_error_1 ("%s statement at %C cannot follow %s statement at %L",
+    gfc_error ("%s statement at %C cannot follow %s statement at %L",
 	       gfc_ascii_statement (st),
 	       gfc_ascii_statement (p->last_statement), &p->where);
 
@@ -2812,7 +2811,7 @@ endType:
 		   "subcomponent exists)", c->name, &c->loc, sym->name);
 
       if (sym->attr.lock_comp && coarray && !lock_type)
-	gfc_error_1 ("Noncoarray component %s at %L of type LOCK_TYPE or with "
+	gfc_error ("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 "
@@ -3527,7 +3526,7 @@ parse_if_block (void)
 	case ST_ELSEIF:
 	  if (seen_else)
 	    {
-	      gfc_error_1 ("ELSE IF statement at %C cannot follow ELSE "
+	      gfc_error ("ELSE IF statement at %C cannot follow ELSE "
 			 "statement at %L", &else_locus);
 
 	      reject_statement ();
@@ -3751,8 +3750,8 @@ gfc_check_do_variable (gfc_symtree *st)
   for (s=gfc_state_stack; s; s = s->previous)
     if (s->do_variable == st)
       {
-	gfc_error_now_1 ("Variable '%s' at %C cannot be redefined inside "
-			 "loop beginning at %L", st->name, &s->head->loc);
+	gfc_error_now ("Variable %qs at %C cannot be redefined inside "
+		       "loop beginning at %L", st->name, &s->head->loc);
 	return 1;
       }
 
@@ -5070,10 +5069,10 @@ gfc_global_used (gfc_gsymbol *sym, locus *where)
     }
 
   if (sym->binding_label)
-    gfc_error_1 ("Global binding name '%s' at %L is already being used as a %s "
+    gfc_error ("Global binding name %qs at %L is already being used as a %s "
 	       "at %L", sym->binding_label, where, name, &sym->where);
   else
-    gfc_error_1 ("Global name '%s' at %L is already being used as a %s at %L",
+    gfc_error ("Global name %qs at %L is already being used as a %s at %L",
 	       sym->name, where, name, &sym->where);
 }
 
@@ -5543,7 +5542,7 @@ duplicate_main:
   /* If we see a duplicate main program, shut down.  If the second
      instance is an implied main program, i.e. data decls or executable
      statements, we're in for lots of errors.  */
-  gfc_error_1 ("Two main PROGRAMs at %L and %C", &prog_locus);
+  gfc_error ("Two main PROGRAMs at %L and %C", &prog_locus);
   reject_statement ();
   gfc_done_2 ();
   return true;
diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c
index e9ced7e6f71..7d2f9c768fe 100644
--- a/gcc/fortran/primary.c
+++ b/gcc/fortran/primary.c
@@ -1274,8 +1274,7 @@ static match
 match_complex_constant (gfc_expr **result)
 {
   gfc_expr *e, *real, *imag;
-  gfc_error_buf old_error_1;
-  output_buffer old_error;
+  gfc_error_buffer old_error;
   gfc_typespec target;
   locus old_loc;
   int kind;
@@ -1288,18 +1287,18 @@ match_complex_constant (gfc_expr **result)
   if (m != MATCH_YES)
     return m;
 
-  gfc_push_error (&old_error, &old_error_1);
+  gfc_push_error (&old_error);
 
   m = match_complex_part (&real);
   if (m == MATCH_NO)
     {
-      gfc_free_error (&old_error, &old_error_1);
+      gfc_free_error (&old_error);
       goto cleanup;
     }
 
   if (gfc_match_char (',') == MATCH_NO)
     {
-      gfc_pop_error (&old_error, &old_error_1);
+      gfc_pop_error (&old_error);
       m = MATCH_NO;
       goto cleanup;
     }
@@ -1311,10 +1310,10 @@ match_complex_constant (gfc_expr **result)
 
   if (m == MATCH_ERROR)
     {
-      gfc_free_error (&old_error, &old_error_1);
+      gfc_free_error (&old_error);
       goto cleanup;
     }
-  gfc_pop_error (&old_error, &old_error_1);
+  gfc_pop_error (&old_error);
 
   m = match_complex_part (&imag);
   if (m == MATCH_NO)
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index fbf260f5233..492c016ad9c 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -418,7 +418,7 @@ resolve_formal_arglist (gfc_symbol *proc)
 	  /* F08:C1278a.  */
 	  if (sym->ts.type == BT_CLASS && sym->attr.intent == INTENT_OUT)
 	    {
-	      gfc_error ("INTENT(OUT) argument '%s' of pure procedure %qs at %L"
+	      gfc_error ("INTENT(OUT) argument %qs of pure procedure %qs at %L"
 			 " may not be polymorphic", sym->name, proc->name,
 			 &sym->declared_at);
 	      continue;
@@ -993,7 +993,7 @@ resolve_common_blocks (gfc_symtree *common_root)
 	      || (!common_root->n.common->binding_label
 		  && gsym->binding_label)))
 	{
-	  gfc_error_1 ("In Fortran 2003 COMMON '%s' block at %L is a global "
+	  gfc_error ("In Fortran 2003 COMMON %qs 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,
@@ -1007,7 +1007,7 @@ resolve_common_blocks (gfc_symtree *common_root)
       if (gsym && gsym->type != GSYM_COMMON
 	  && !common_root->n.common->binding_label)
 	{
-	  gfc_error_1 ("COMMON block '%s' at %L uses the same global identifier "
+	  gfc_error ("COMMON block %qs at %L uses the same global identifier "
 		     "as entity at %L",
 		     common_root->n.common->name, &common_root->n.common->where,
 		     &gsym->where);
@@ -1015,7 +1015,7 @@ resolve_common_blocks (gfc_symtree *common_root)
 	}
       if (gsym && gsym->type != GSYM_COMMON)
 	{
-	  gfc_error_1 ("Fortran 2008: COMMON block '%s' with binding label at "
+	  gfc_error ("Fortran 2008: COMMON block %qs 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);
@@ -1037,7 +1037,7 @@ resolve_common_blocks (gfc_symtree *common_root)
 			       common_root->n.common->binding_label);
       if (gsym && gsym->type != GSYM_COMMON)
 	{
-	  gfc_error_1 ("COMMON block at %L with binding label %s uses the same "
+	  gfc_error ("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);
@@ -1058,7 +1058,7 @@ resolve_common_blocks (gfc_symtree *common_root)
     return;
 
   if (sym->attr.flavor == FL_PARAMETER)
-    gfc_error_1 ("COMMON block '%s' at %L is used as PARAMETER at %L",
+    gfc_error ("COMMON block %qs at %L is used as PARAMETER at %L",
 	       sym->name, &common_root->n.common->where, &sym->declared_at);
 
   if (sym->attr.external)
@@ -3368,7 +3368,7 @@ resolve_call (gfc_code *c)
 
   if (csym && csym->ts.type != BT_UNKNOWN)
     {
-      gfc_error_1 ("'%s' at %L has a type, which is not consistent with "
+      gfc_error ("%qs at %L has a type, which is not consistent with "
 		 "the CALL at %L", csym->name, &csym->declared_at, &c->loc);
       return false;
     }
@@ -3494,8 +3494,8 @@ compare_shapes (gfc_expr *op1, gfc_expr *op2)
 	{
 	  if (mpz_cmp (op1->shape[i], op2->shape[i]) != 0)
 	   {
-	     gfc_error_1 ("Shapes for operands at %L and %L are not conformable",
-			 &op1->where, &op2->where);
+	     gfc_error ("Shapes for operands at %L and %L are not conformable",
+			&op1->where, &op2->where);
 	     t = false;
 	     break;
 	   }
@@ -6785,7 +6785,7 @@ conformable_arrays (gfc_expr *e1, gfc_expr *e2)
 
 	  if (mpz_cmp (e1->shape[i], s) != 0)
 	    {
-	      gfc_error_1 ("Source-expr at %L and allocate-object at %L must "
+	      gfc_error ("Source-expr at %L and allocate-object at %L must "
 			 "have the same shape", &e1->where, &e2->where);
 	      mpz_clear (s);
    	      return false;
@@ -6943,8 +6943,8 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code)
       /* Check F03:C631.  */
       if (!gfc_type_compatible (&e->ts, &code->expr3->ts))
 	{
-	  gfc_error_1 ("Type of entity at %L is type incompatible with "
-		       "source-expr at %L", &e->where, &code->expr3->where);
+	  gfc_error ("Type of entity at %L is type incompatible with "
+		     "source-expr at %L", &e->where, &code->expr3->where);
 	  goto failure;
 	}
 
@@ -6955,9 +6955,9 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code)
       /* Check F03:C633.  */
       if (code->expr3->ts.kind != e->ts.kind && !unlimited)
 	{
-	  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);
+	  gfc_error ("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;
 	}
 
@@ -6969,7 +6969,7 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code)
 		  && code->expr3->ts.u.derived->intmod_sym_id
 		     == ISOFORTRAN_LOCK_TYPE)))
 	{
-	  gfc_error_1 ("The source-expr at %L shall neither be of type "
+	  gfc_error ("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);
@@ -7318,20 +7318,20 @@ resolve_allocate_deallocate (gfc_code *code, const char *fcn)
 		{
 		  if (pr == NULL && qr == NULL)
 		    {
-		      gfc_error_1 ("Allocate-object at %L also appears at %L",
-				   &pe->where, &qe->where);
+		      gfc_error ("Allocate-object at %L also appears at %L",
+				 &pe->where, &qe->where);
 		      break;
 		    }
 		  else if (pr != NULL && qr == NULL)
 		    {
-		      gfc_error_1 ("Allocate-object at %L is subobject of"
-				   " object at %L", &pe->where, &qe->where);
+		      gfc_error ("Allocate-object at %L is subobject of"
+				 " object at %L", &pe->where, &qe->where);
 		      break;
 		    }
 		  else if (pr == NULL && qr != NULL)
 		    {
-		      gfc_error_1 ("Allocate-object at %L is subobject of"
-				   " object at %L", &qe->where, &pe->where);
+		      gfc_error ("Allocate-object at %L is subobject of"
+				 " object at %L", &qe->where, &pe->where);
 		      break;
 		    }
 		  /* Here, pr != NULL && qr != NULL  */
@@ -7534,7 +7534,7 @@ check_case_overlap (gfc_case *list)
 			 element in the list.  Either way, we must
 			 issue an error and get the next case from P.  */
 		      /* FIXME: Sort P and Q by line number.  */
-		      gfc_error_1 ("CASE label at %L overlaps with CASE "
+		      gfc_error ("CASE label at %L overlaps with CASE "
 				 "label at %L", &p->where, &q->where);
 		      overlap_seen = 1;
 		      e = p;
@@ -7772,7 +7772,7 @@ resolve_select (gfc_code *code, bool select_type)
 	    {
 	      if (default_case != NULL)
 		{
-		  gfc_error_1 ("The DEFAULT CASE at %L cannot be followed "
+		  gfc_error ("The DEFAULT CASE at %L cannot be followed "
 			     "by a second DEFAULT CASE at %L",
 			     &default_case->where, &cp->where);
 		  t = false;
@@ -8145,7 +8145,7 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns)
 	  /* Check F03:C818.  */
 	  if (default_case)
 	    {
-	      gfc_error_1 ("The DEFAULT CASE at %L cannot be followed "
+	      gfc_error ("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++;
@@ -8708,7 +8708,7 @@ resolve_branch (gfc_st_label *label, gfc_code *code)
 
   if (label->defined != ST_LABEL_TARGET && label->defined != ST_LABEL_DO_TARGET)
     {
-      gfc_error_1 ("Statement at %L is not a valid branch target statement "
+      gfc_error ("Statement at %L is not a valid branch target statement "
 		 "for the branch statement at %L", &label->where, &code->loc);
       return;
     }
@@ -8735,11 +8735,11 @@ resolve_branch (gfc_st_label *label, gfc_code *code)
 	{
 	  if (stack->current->op == EXEC_CRITICAL
 	      && bitmap_bit_p (stack->reachable_labels, label->value))
-	    gfc_error_1 ("GOTO statement at %L leaves CRITICAL construct for "
+	    gfc_error ("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_1 ("GOTO statement at %L leaves DO CONCURRENT construct "
+	    gfc_error ("GOTO statement at %L leaves DO CONCURRENT construct "
 		      "for label at %L", &code->loc, &label->where);
 	}
 
@@ -8758,13 +8758,13 @@ resolve_branch (gfc_st_label *label, gfc_code *code)
 	{
 	  /* Note: A label at END CRITICAL does not leave the CRITICAL
 	     construct as END CRITICAL is still part of it.  */
-	  gfc_error_1 ("GOTO statement at %L leaves CRITICAL construct for label"
+	  gfc_error ("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_1 ("GOTO statement at %L leaves DO CONCURRENT construct for "
+	  gfc_error ("GOTO statement at %L leaves DO CONCURRENT construct for "
 		     "label at %L", &code->loc, &label->where);
 	  return;
 	}
@@ -10545,7 +10545,7 @@ gfc_verify_binding_labels (gfc_symbol *sym)
 
   if (sym->attr.flavor == FL_VARIABLE && gsym->type != GSYM_UNKNOWN)
     {
-      gfc_error_1 ("Variable %s with binding label %s at %L uses the same global "
+      gfc_error ("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.  */
@@ -10558,7 +10558,7 @@ gfc_verify_binding_labels (gfc_symbol *sym)
     {
       /* This can only happen if the variable is defined in a module - if it
 	 isn't the same module, reject it.  */
-      gfc_error_1 ("Variable %s from module %s with binding label %s at %L uses "
+      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",
 		 sym->name, module, sym->binding_label,
 		 &sym->declared_at, &gsym->where, gsym->mod_name);
@@ -10575,7 +10575,7 @@ gfc_verify_binding_labels (gfc_symbol *sym)
       /* Print an error if the procedure is defined multiple times; we have to
 	 exclude references to the same procedure via module association or
 	 multiple checks for the same procedure.  */
-      gfc_error_1 ("Procedure %s with binding label %s at %L uses the same "
+      gfc_error ("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;
@@ -11075,7 +11075,7 @@ resolve_fl_variable_derived (gfc_symbol *sym, int no_init_flag)
 	s = gfc_find_dt_in_generic (s);
       if (s && s->attr.flavor != FL_DERIVED)
 	{
-	  gfc_error_1 ("The type '%s' cannot be host associated at %L "
+	  gfc_error ("The type %qs 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,
@@ -11145,7 +11145,7 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag)
     {
       /* The shape of a main program or module array needs to be
 	 constant.  */
-      gfc_error ("The module or main program array '%s' at %L must "
+      gfc_error ("The module or main program array %qs at %L must "
 		 "have constant shape", sym->name, &sym->declared_at);
       specification_expr = saved_specification_expr;
       return false;
@@ -11194,7 +11194,7 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag)
 	      && (sym->ns->proc_name->attr.flavor == FL_MODULE
 		  || sym->ns->proc_name->attr.is_main_program))
 	    {
-	      gfc_error ("'%s' at %L must have constant character length "
+	      gfc_error ("%qs at %L must have constant character length "
 			"in this context", sym->name, &sym->declared_at);
 	      specification_expr = saved_specification_expr;
 	      return false;
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index e470cb956a7..08bdf18b857 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -1706,7 +1706,7 @@ gfc_add_type (gfc_symbol *sym, gfc_typespec *ts, locus *where)
   if (type != BT_UNKNOWN && !(sym->attr.function && sym->attr.implicit_type))
     {
       if (sym->attr.use_assoc)
-	gfc_error_1 ("Symbol '%s' at %L conflicts with symbol from module '%s', "
+	gfc_error ("Symbol %qs at %L conflicts with symbol from module %qs, "
 		   "use-associated at %L", sym->name, where, sym->module,
 		   &sym->declared_at);
       else
@@ -1900,7 +1900,7 @@ gfc_add_component (gfc_symbol *sym, const char *name,
     {
       if (strcmp (p->name, name) == 0)
 	{
-	  gfc_error_1 ("Component '%s' at %C already declared at %L",
+	  gfc_error ("Component %qs at %C already declared at %L",
 		     name, &p->loc);
 	  return false;
 	}
@@ -1911,7 +1911,7 @@ gfc_add_component (gfc_symbol *sym, const char *name,
   if (sym->attr.extension
 	&& gfc_find_component (sym->components->ts.u.derived, name, true, true))
     {
-      gfc_error_1 ("Component '%s' at %C already in the parent type "
+      gfc_error ("Component %qs at %C already in the parent type "
 		 "at %L", name, &sym->components->ts.u.derived->declared_at);
       return false;
     }
@@ -2223,7 +2223,7 @@ gfc_define_st_label (gfc_st_label *lp, gfc_sl_type type, locus *label_locus)
   labelno = lp->value;
 
   if (lp->defined != ST_LABEL_UNKNOWN)
-    gfc_error_1 ("Duplicate statement label %d at %L and %L", labelno,
+    gfc_error ("Duplicate statement label %d at %L and %L", labelno,
 	       &lp->where, label_locus);
   else
     {
@@ -3900,9 +3900,9 @@ verify_bind_c_derived_type (gfc_symbol *derived_sym)
          J3/04-007, Section 15.2.3, C1505.	*/
       if (curr_comp->attr.pointer != 0)
         {
-          gfc_error_1 ("Component '%s' at %L cannot have the "
+          gfc_error ("Component %qs at %L cannot have the "
                      "POINTER attribute because it is a member "
-                     "of the BIND(C) derived type '%s' at %L",
+                     "of the BIND(C) derived type %qs at %L",
                      curr_comp->name, &(curr_comp->loc),
                      derived_sym->name, &(derived_sym->declared_at));
           retval = false;
@@ -3910,8 +3910,8 @@ verify_bind_c_derived_type (gfc_symbol *derived_sym)
 
       if (curr_comp->attr.proc_pointer != 0)
 	{
-	  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,
+	  gfc_error ("Procedure pointer component %qs at %L cannot be a member"
+		     " of the BIND(C) derived type %qs at %L", curr_comp->name,
 		     &curr_comp->loc, derived_sym->name,
 		     &derived_sym->declared_at);
           retval = false;
@@ -3921,9 +3921,9 @@ verify_bind_c_derived_type (gfc_symbol *derived_sym)
          J3/04-007, Section 15.2.3, C1505.	*/
       if (curr_comp->attr.allocatable != 0)
         {
-          gfc_error_1 ("Component '%s' at %L cannot have the "
+          gfc_error ("Component %qs at %L cannot have the "
                      "ALLOCATABLE attribute because it is a member "
-                     "of the BIND(C) derived type '%s' at %L",
+                     "of the BIND(C) derived type %qs at %L",
                      curr_comp->name, &(curr_comp->loc),
                      derived_sym->name, &(derived_sym->declared_at));
           retval = false;
diff --git a/gcc/fortran/trans-common.c b/gcc/fortran/trans-common.c
index 8064d891870..a2bc089cb11 100644
--- a/gcc/fortran/trans-common.c
+++ b/gcc/fortran/trans-common.c
@@ -918,8 +918,8 @@ confirm_condition (segment_info *s1, gfc_equiv *eq1, segment_info *s2,
   offset2 = calculate_offset (eq2->expr);
 
   if (s1->offset + offset1 != s2->offset + offset2)
-    gfc_error_1 ("Inconsistent equivalence rules involving '%s' at %L and "
-	       "'%s' at %L", s1->sym->name, &s1->sym->declared_at,
+    gfc_error ("Inconsistent equivalence rules involving %qs at %L and "
+	       "%qs at %L", s1->sym->name, &s1->sym->declared_at,
 	       s2->sym->name, &s2->sym->declared_at);
 }