re PR fortran/44054 (Handle -Werror, -Werror=, -fdiagnostics-show-option, !GCC$…

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

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.

From-SVN: r223614

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.
+
 2015-05-22  Jim Wilson  <jim.wilson@linaro.org>
 
 	* Make-lang.in (check_gfortran_parallelize): Update comment.

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,14 +1655,14 @@ 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 "
+	  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 "
+	  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,7 +1680,7 @@ 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 "
+       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);
@@ -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,7 +2472,7 @@ 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 "
+		  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;

gcc/fortran/data.c

@@ -253,7 +253,7 @@ 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",
+	      gfc_error ("%qs at %L already is initialized at %L",
 			 lvalue->symtree->n.sym->name, &lvalue->where,
 			 &init->where);
 	      goto abort;

gcc/fortran/decl.c

@@ -921,7 +921,7 @@ 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",
+	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
@@ -929,7 +929,7 @@ get_proc_name (const char *name, gfc_symbol **result, bool module_fcn_entry)
       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"
+	gfc_error_now ("Name %qs at %C is already defined"
 		       " as a generic interface at %L",
 		       name, &sym->declared_at);
 
@@ -942,7 +942,7 @@ 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 "
+	gfc_error_now ("Procedure %qs at %C has an explicit interface "
 		       "and must not have attributes declared at %L",
 		       name, &sym->declared_at);
     }
@@ -2868,7 +2868,7 @@ 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 "
+      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;

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.flag
+      || ! gfc_output_buffer_empty_p (pp_error_buffer))
     {
-      if (error_buffer.message != NULL)
-	fputs (error_buffer.message, stderr);
-      error_buffer.flag = 0;
-      gfc_clear_pp_buffer (pp_error_buffer);
-
-      gfc_increment_error_count();
-
-      if (flag_fatal_errors)
-	exit (FATAL_EXIT_CODE);
-    }
-  /* This is for the new diagnostics machinery.  */
-  else if (! gfc_output_buffer_empty_p (pp_error_buffer))
-    {
-      error_raised = true;
+      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;
 }
 

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,7 +5036,7 @@ 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 "
+				gfc_error_now ("Elements with the same value "
 					       "at %L and %L in vector "
 					       "subscript in a variable "
 					       "definition context (%s)",

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);

gcc/fortran/frontend-passes.c

@@ -1879,16 +1879,16 @@ 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 "
+		    gfc_error_now ("Variable %qs at %L set to undefined "
 				   "value inside loop  beginning at %L as "
-				     "INTENT(OUT) argument to subroutine '%s'",
+				   "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 "
+		    gfc_error_now ("Variable %qs at %L not definable inside "
 				   "loop beginning at %L as INTENT(INOUT) "
-				     "argument to subroutine '%s'",
+				   "argument to subroutine %qs",
 				   do_sym->name, &a->expr->where,
 				   &doloop_list[i]->loc,
 				   co->symtree->n.sym->name);
@@ -1951,15 +1951,15 @@ 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 "
+		gfc_error_now ("Variable %qs at %L set to undefined value "
 			       "inside loop beginning at %L as INTENT(OUT) "
-				 "argument to function '%s'", do_sym->name,
+			       "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"
+		gfc_error_now ("Variable %qs at %L not definable inside loop"
 			       " beginning at %L as INTENT(INOUT) argument to"
-				 " function '%s'", do_sym->name,
+			       " function %qs", do_sym->name,
 			       &a->expr->where, &doloop_list[i]->loc,
 			       expr->symtree->n.sym->name);
 	    }

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);
@@ -2686,9 +2676,16 @@ bool gfc_notify_std (int, const char *, ...) ATTRIBUTE_GCC_GFC(2,3);
   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 *);
+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);

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,7 +3662,7 @@ alloc_opt_list:
   /* Check F08:C637.  */
   if (source && mold)
     {
-      gfc_error_1 ("MOLD tag at %L conflicts with SOURCE tag at %L",
+      gfc_error ("MOLD tag at %L conflicts with SOURCE tag at %L",
 		 &mold->where, &source->where);
       goto cleanup;
     }
@@ -4350,10 +4350,10 @@ 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' "
+                  gfc_error_now ("Variable %qs at %L in common block %qs "
 				 "at %C must be declared with a C "
 				 "interoperable kind since common block "
-				   "'%s' is bind(c)",
+				 "%qs is bind(c)",
 				 sym->name, &(sym->declared_at), t->name,
 				 t->name);
                 }
@@ -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;
 }
 

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,7 +3750,7 @@ 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 "
+	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;

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)

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;

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);
 }