PR fortran/44054 Convert all gfc_error_1 calls to gfc_error
diff mbox

Message ID CAESRpQBzH55yjhZ2Jax2z7VtQFvANCaeVnndpReht0uBO=m7Ow@mail.gmail.com
State New
Headers show

Commit Message

Manuel López-Ibáñez May 17, 2015, 6:22 p.m. UTC
Hi,

This patch finishes the conversion of Fortran diagnostics to use the
common diagnostics by removing all gfc_error*_1 variants.

I noticed that whether some buffered gfc_error_1() end up printed may
depend on whether a gfc_error_now is given or not, and not only on
whether there is any output buffered. Thus, I reintroduced a new
error_buffer of type gfc_buffer_error.

The rest is mostly mechanic.

I did not make an attempt in this patch to remove all code that has
become obsolete now:

gfc_get_terminal_width (already implemented in diagnostics.c)
error_char (already empty, but used by other obsolete functions)
error_string (obsolete, just use %s)
error_uinteger (obsolete, just use %lu)
error_integer (obsolete, just use %ld)
gfc_widechar_display_length, gfc_wide_display_length,
print_wide_char_into_buffer, gfc_print_wide_char (I'm not sure how
this functionality differs from what the common diagnostics already
do, perhaps some of it should be moved to the common code)
show_locus (obsolete, except "Included at" handling should be moved to
the common diagnostics, no testcase is testing this).
show_loci (obsolete, except "During initialization" handling should be
moved to the common diagnostics, no testcase is testing this)
error_print, error_printf (obsolete)

Bootstrapped and regression tested on x86_64-linux-gnu.

OK?

gcc/fortran/ChangeLog:

2015-05-17  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.

Comments

Manuel López-Ibáñez May 22, 2015, 11:04 p.m. UTC | #1
PING: https://gcc.gnu.org/ml/gcc-patches/2015-05/msg01511.html

This only needs approval from Fortran maintainers.

On 17 May 2015 at 20:22, Manuel López-Ibáñez <lopezibanez@gmail.com> wrote:
> Hi,
>
> This patch finishes the conversion of Fortran diagnostics to use the
> common diagnostics by removing all gfc_error*_1 variants.
>
> I noticed that whether some buffered gfc_error_1() end up printed may
> depend on whether a gfc_error_now is given or not, and not only on
> whether there is any output buffered. Thus, I reintroduced a new
> error_buffer of type gfc_buffer_error.
>
> The rest is mostly mechanic.
>
> I did not make an attempt in this patch to remove all code that has
> become obsolete now:
>
> gfc_get_terminal_width (already implemented in diagnostics.c)
> error_char (already empty, but used by other obsolete functions)
> error_string (obsolete, just use %s)
> error_uinteger (obsolete, just use %lu)
> error_integer (obsolete, just use %ld)
> gfc_widechar_display_length, gfc_wide_display_length,
> print_wide_char_into_buffer, gfc_print_wide_char (I'm not sure how
> this functionality differs from what the common diagnostics already
> do, perhaps some of it should be moved to the common code)
> show_locus (obsolete, except "Included at" handling should be moved to
> the common diagnostics, no testcase is testing this).
> show_loci (obsolete, except "During initialization" handling should be
> moved to the common diagnostics, no testcase is testing this)
> error_print, error_printf (obsolete)
>
> Bootstrapped and regression tested on x86_64-linux-gnu.
>
> OK?
>
> gcc/fortran/ChangeLog:
>
> 2015-05-17  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.
Mikael Morin May 23, 2015, 12:42 p.m. UTC | #2
Le 23/05/2015 01:04, Manuel López-Ibáñez a écrit :
> PING: https://gcc.gnu.org/ml/gcc-patches/2015-05/msg01511.html
> 
> This only needs approval from Fortran maintainers.
> 
I approved: https://gcc.gnu.org/ml/fortran/2015-05/msg00135.html
But it seems I replied to the fortran list only.

Mikael

Patch
diff mbox

Index: gcc/fortran/symbol.c
===================================================================
--- gcc/fortran/symbol.c	(revision 223238)
+++ gcc/fortran/symbol.c	(working copy)
@@ -1699,11 +1699,11 @@  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_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
 	gfc_error ("Symbol %qs at %L already has basic type of %s", sym->name,
 		 where, gfc_basic_typename (type));
@@ -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_1 ("Component '%s' at %C already declared at %L",
+	  gfc_error ("Component %qs 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_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;
     }
 
   /* Allocate a new component.  */
@@ -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_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
     {
       lp->where = *label_locus;
 
@@ -3893,34 +3893,34 @@  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_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;
         }
 
       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;
         }
 
       /* The components cannot be allocatable.
          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;
         }
       
Index: gcc/fortran/decl.c
===================================================================
--- gcc/fortran/decl.c	(revision 223238)
+++ gcc/fortran/decl.c	(working copy)
@@ -919,34 +919,34 @@  get_proc_name (const char *name, gfc_sym
 	 accessible names.  */
       if (sym->attr.flavor != 0
 	  && 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
 	 references only set ts.type.  */
       if (sym->ts.kind != 0
 	  && !sym->attr.implicit_type
 	  && sym->attr.proc == 0
 	  && 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)
     return rc;
 
@@ -2866,13 +2866,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_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;
     }
 
   gfc_save_symbol_data (sym);
   gfc_set_sym_referenced (sym);
Index: gcc/fortran/trans-common.c
===================================================================
--- gcc/fortran/trans-common.c	(revision 223238)
+++ gcc/fortran/trans-common.c	(working copy)
@@ -916,12 +916,12 @@  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_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);
 }
 
 
 /* Process a new equivalence condition. eq1 is know to be in segment f.
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h	(revision 223238)
+++ gcc/fortran/gfortran.h	(working copy)
@@ -2643,18 +2643,10 @@  void gfc_maybe_initialize_eh (void);
 /* iresolve.c */
 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);
 void gfc_buffer_error (bool);
 
@@ -2666,13 +2658,11 @@  bool gfc_warning_now_at (location_t loc,
   ATTRIBUTE_GCC_GFC(3,4);
 
 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);
 void gfc_clear_error (void);
 bool gfc_error_check (void);
@@ -2683,14 +2673,21 @@  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));
 
-#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);
 
 /* arith.c */
Index: gcc/fortran/error.c
===================================================================
--- gcc/fortran/error.c	(revision 223238)
+++ gcc/fortran/error.c	(working copy)
@@ -38,16 +38,16 @@  along with GCC; see the file COPYING3.  
 
 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;
 static int warningcount_buffered, werrorcount_buffered;
 
@@ -98,12 +98,10 @@  gfc_get_terminal_width (void)
 
 void
 gfc_error_init_1 (void)
 {
   terminal_width = gfc_get_terminal_width ();
-  errors = 0;
-  warnings = 0;
   gfc_buffer_error (false);
 }
 
 
 /* Set the flag for buffering errors or not.  */
@@ -117,46 +115,13 @@  gfc_buffer_error (bool flag)
 
 /* Add a single character to the error buffer or output depending on
    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.  */
 }
 
 
 /* Copy a string to wherever it needs to go.  */
 
@@ -780,22 +745,10 @@  error_printf (const char *gmsgid, ...)
   error_print ("", _(gmsgid), argp);
   va_end (argp);
 }
 
 
-/* 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
 gfc_clear_pp_buffer (output_buffer *this_buffer)
 {
@@ -1245,20 +1198,19 @@  gfc_warning_now (int opt, const char *gm
   return ret;
 }
 
 
 /* Immediate error (i.e. do not buffer).  */
-/* This function uses the common diagnostics, but does not support
-   two locations; when being used in scanner.c, ensure that the location
-   is properly setup. Otherwise, use gfc_error_now_1.   */
 
 void
 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);
   va_end (argp);
 }
@@ -1283,12 +1235,10 @@  gfc_fatal_error (const char *gmsgid, ...
 /* Clear the warning flag.  */
 
 void
 gfc_clear_warning (void)
 {
-  warning_buffer.flag = 0;
-
   gfc_clear_pp_buffer (pp_warning_buffer);
   warningcount_buffered = 0;
   werrorcount_buffered = 0;
 }
 
@@ -1297,19 +1247,12 @@  gfc_clear_warning (void)
    If so, print the warning.  */
 
 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;
       pp->buffer = pp_warning_buffer;
       pp_really_flush (pp);
@@ -1323,66 +1266,10 @@  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)
 {
   va_list argp;
@@ -1438,42 +1325,10 @@  gfc_error (const char *gmsgid, ...)
   gfc_error (gmsgid, argp);
   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.  */
-
-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
 gfc_internal_error (const char *gmsgid, ...)
 {
@@ -1514,48 +1369,42 @@  gfc_error_flag_test (void)
    If so, print the error.  Returns the state of error_flag.  */
 
 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;
       pp_really_flush (pp);
       ++errorcount;
       gcc_assert (gfc_output_buffer_empty_p (pp_error_buffer));
       diagnostic_action_after_output (global_dc, DK_ERROR);
       pp->buffer = tmp_buffer;
+      return true;
     }
 
-  return error_raised;
+  return false;
 }
 
 /* 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_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;
 
   if (! gfc_output_buffer_empty_p (from))
@@ -1567,62 +1416,43 @@  gfc_move_output_buffer_from_to (output_b
 }
 
 /* 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));
 }
 
 
 /* Report the number of warnings and errors that occurred to the caller.  */
 
 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;
 }
 
 
 /* Switch errors into warnings.  */
 
@@ -1640,11 +1470,11 @@  gfc_diagnostics_init (void)
   diagnostic_format_decoder (global_dc) = gfc_format_decoder;
   global_dc->caret_chars[0] = '1';
   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;
 }
 
 void
 gfc_diagnostics_finish (void)
Index: gcc/fortran/data.c
===================================================================
--- gcc/fortran/data.c	(revision 223238)
+++ 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_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;
 	    }
 
 	  if (init == NULL)
 	    {
Index: gcc/fortran/expr.c
===================================================================
--- gcc/fortran/expr.c	(revision 223238)
+++ gcc/fortran/expr.c	(working copy)
@@ -4989,11 +4989,11 @@  gfc_check_vardef_context (gfc_expr* e, b
 
       /* 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_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,
 		       &assoc->target->where);
 	  return false;
@@ -5031,16 +5031,16 @@  gfc_check_vardef_context (gfc_expr* e, b
 			  
 			  en = n->expr;
 			  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;
 			    }
 			}
 		    }
 		}
Index: gcc/fortran/frontend-passes.c
===================================================================
--- gcc/fortran/frontend-passes.c	(revision 223238)
+++ gcc/fortran/frontend-passes.c	(working copy)
@@ -1877,23 +1877,23 @@  doloop_code (gfc_code **c, int *walk_sub
 	      
 	      if (a->expr && a->expr->symtree
 		  && 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;
 	  f = f->next;
 	}
@@ -1949,21 +1949,21 @@  do_function (gfc_expr **e, int *walk_sub
 	  
 	  if (a->expr && a->expr->symtree
 	      && 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;
       f = f->next;
     }
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(revision 223238)
+++ gcc/fortran/resolve.c	(working copy)
@@ -416,11 +416,11 @@  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;
 	    }
 	}
@@ -991,11 +991,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_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,
 		     &gsym->where,
 		     common_root->n.common->binding_label
@@ -1005,19 +1005,19 @@  resolve_common_blocks (gfc_symtree *comm
 	}
 
       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);
 	  return;
 	}
       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);
 	  return;
 	}
@@ -1035,11 +1035,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_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);
 	  return;
 	}
@@ -1056,11 +1056,11 @@  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_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)
     gfc_error ("COMMON block %qs at %L can not have the EXTERNAL attribute",
 	       sym->name, &common_root->n.common->where);
@@ -3366,11 +3366,11 @@  resolve_call (gfc_code *c)
 
   csym = c->symtree ? c->symtree->n.sym : NULL;
 
   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;
     }
 
   if (csym && gfc_current_ns->parent && csym->ns != gfc_current_ns)
@@ -3492,12 +3492,12 @@  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_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;
 	   }
 	}
     }
@@ -6783,11 +6783,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_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;
 	    }
 	}
@@ -6941,25 +6941,25 @@  resolve_allocate_expr (gfc_expr *e, gfc_
   if (code->expr3)
     {
       /* 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;
 	}
 
       /* 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_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;
 	}
 
       /* Check F2008, C642.  */
       if (code->expr3->ts.type == BT_DERIVED
@@ -6967,11 +6967,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_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);
 	  goto failure;
 	}
@@ -7316,24 +7316,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_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  */
 		  gcc_assert(pr->type == qr->type);
 		  if (pr->type == REF_ARRAY)
@@ -7532,11 +7532,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_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;
 		      p = p->right;
 		      psize--;
@@ -7770,11 +7770,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_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;
 		  break;
 		}
@@ -8143,11 +8143,11 @@  resolve_select_type (gfc_code *code, gfc
       if (c->ts.type == BT_UNKNOWN)
 	{
 	  /* 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++;
 	      continue;
 	    }
@@ -8706,11 +8706,11 @@  resolve_branch (gfc_st_label *label, gfc
       return;
     }
 
   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;
     }
 
   /* Step two: make sure this branch is not a branch to itself ;-)  */
@@ -8733,15 +8733,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_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);
 	}
 
       return;
     }
@@ -8756,17 +8756,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_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;
 	}
     }
 
@@ -10543,11 +10543,11 @@  gfc_verify_binding_labels (gfc_symbol *s
       return;
     }
 
   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.  */
       sym->binding_label = NULL;
 
@@ -10556,11 +10556,11 @@  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_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);
       sym->binding_label = NULL;
     }
@@ -10573,11 +10573,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_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;
     }
 }
@@ -11073,11 +11073,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_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,
 		     &s->declared_at);
 	  return false;
@@ -11143,11 +11143,11 @@  resolve_fl_variable (gfc_symbol *sym, in
       && !sym->attr.pointer
       && is_non_constant_shape_array (sym))
     {
       /* 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;
     }
 
@@ -11192,11 +11192,11 @@  resolve_fl_variable (gfc_symbol *sym, in
 	{
 	  if (!sym->attr.use_assoc && sym->ns->proc_name
 	      && (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;
 	    }
 	  if (sym->attr.in_common)
Index: gcc/fortran/f95-lang.c
===================================================================
--- gcc/fortran/f95-lang.c	(revision 223238)
+++ gcc/fortran/f95-lang.c	(working copy)
@@ -219,22 +219,14 @@  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);
 
   /* Switch to the default tree diagnostics here, because there may be
Index: gcc/fortran/match.c
===================================================================
--- gcc/fortran/match.c	(revision 223238)
+++ gcc/fortran/match.c	(working copy)
@@ -3594,11 +3594,11 @@  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;
 	    }
 
 	  if (head->next
@@ -3631,11 +3631,11 @@  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;
 	    }
 
 	  mold = tmp;
@@ -3657,12 +3657,12 @@  alloc_opt_list:
     goto syntax;
 
   /* 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;
     }
 
   /* Check F03:C623,  */
   if (saw_deferred && ts.type == BT_UNKNOWN && !source && !mold)
@@ -4345,16 +4345,16 @@  gfc_match_common (void)
               if (sym->ts.type != BT_UNKNOWN && sym->ts.is_c_interop != 1)
                 {
                   /* 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)
                 gfc_error_now ("Variable %qs in common block %qs at %C can not "
                                "be bind(c) since it is not global", sym->name,
@@ -4884,22 +4884,21 @@  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_1;
-  output_buffer old_error;
+  gfc_error_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, &old_error_1);
+  gfc_push_error (&old_error);
 
   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)
@@ -4907,11 +4906,11 @@  gfc_match_st_function (void)
 
   m = gfc_match (" = %e%t", &expr);
   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;
 
   if (recursive_stmt_fcn (expr, sym))
@@ -4926,11 +4925,11 @@  gfc_match_st_function (void)
     return MATCH_ERROR;
 
   return MATCH_YES;
 
 undo_error:
-  gfc_pop_error (&old_error, &old_error_1);
+  gfc_pop_error (&old_error);
   return MATCH_NO;
 }
 
 
 /***************** SELECT CASE subroutines ******************/
Index: gcc/fortran/parse.c
===================================================================
--- gcc/fortran/parse.c	(revision 223238)
+++ gcc/fortran/parse.c	(working copy)
@@ -106,18 +106,17 @@  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_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;
   gfc_current_ns->old_equiv = gfc_current_ns->equiv;
   gfc_current_ns->old_data = gfc_current_ns->data;
@@ -2434,11 +2433,11 @@  verify_st_order (st_state *p, gfc_statem
   p->last_statement = st;
   return true;
 
 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);
 
   return false;
 }
@@ -2811,11 +2810,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_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 "
 		   "coarray subcomponent)", lock_comp->name, &lock_comp->loc,
 		   sym->name, c->name, &c->loc);
@@ -3526,11 +3525,11 @@  parse_if_block (void)
 	  unexpected_eof ();
 
 	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 ();
 	      break;
 	    }
@@ -3750,12 +3749,12 @@  gfc_check_do_variable (gfc_symtree *st)
   gfc_state_data *s;
 
   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;
       }
 
   return 0;
 }
@@ -5069,14 +5068,14 @@  gfc_global_used (gfc_gsymbol *sym, locus
       gfc_internal_error ("gfc_global_used(): Bad type");
       name = NULL;
     }
 
   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);
 }
 
 
 /* Parse a block data program unit.  */
@@ -5542,11 +5541,11 @@  prog_units:
 
 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;
 }
 
Index: gcc/fortran/check.c
===================================================================
--- gcc/fortran/check.c	(revision 223238)
+++ gcc/fortran/check.c	(working copy)
@@ -1029,12 +1029,12 @@  gfc_check_atomic (gfc_expr *atom, int at
       return false;
     }
 
   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;
     }
 
@@ -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_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));
       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_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;
 	}
     }
 
   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_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);
 }
 
@@ -1954,11 +1954,11 @@  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_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;
     }
 
   if (!i->is_boz && !j->is_boz && !same_type_check (i, 0, j, 1))
@@ -2470,13 +2470,13 @@  gfc_check_ishftc (gfc_expr *i, gfc_expr 
 	      if (i2 < 0)
 		i2 = -i2;
 
 	      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;
 		}
 	     }
 	}
     }
Index: gcc/fortran/primary.c
===================================================================
--- gcc/fortran/primary.c	(revision 223238)
+++ gcc/fortran/primary.c	(working copy)
@@ -1272,12 +1272,11 @@  match_complex_part (gfc_expr **result)
 
 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;
   match m;
 
@@ -1286,22 +1285,22 @@  match_complex_constant (gfc_expr **resul
 
   m = gfc_match_char ('(');
   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;
     }
 
   /* If m is error, then something was wrong with the real part and we
@@ -1309,14 +1308,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, &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)
     goto syntax;
   if (m == MATCH_ERROR)