[diagnostics/Fortran] Implement Fortran prefix/caret style using the common diagnostics machinery

diff -u gcc/diagnostic.c gcc/diagnostic.c
--- gcc/diagnostic.c	(working copy)
+++ gcc/diagnostic.c	(working copy)
@@ -131,6 +131,7 @@ 
     context->classify_diagnostic[i] = DK_UNSPECIFIED;
   context->show_caret = false;
   diagnostic_set_caret_max_width (context, pp_line_cutoff (context->printer));
+  context->caret_char = '^';
   context->show_option_requested = false;
   context->abort_on_error = false;
   context->show_column = false;
@@ -279,7 +280,7 @@ 
 }
 
 /* Print the physical source line corresponding to the location of
-   this diagnostics, and a caret indicating the precise column.  */
+   this diagnostic, and a caret indicating the precise column.  */
 void
 diagnostic_show_locus (diagnostic_context * context,
 		       const diagnostic_info *diagnostic)
@@ -327,9 +328,10 @@ 
   /* pp_printf does not implement %*c.  */
   size_t len = s.column + 3 + strlen (caret_cs) + strlen (caret_ce);
   buffer = XALLOCAVEC (char, len);
-  snprintf (buffer, len, "%s %*c%s", caret_cs, s.column, '^', caret_ce);
+  snprintf (buffer, len, "%s %*c%s", caret_cs, s.column, context->caret_char, caret_ce);
   pp_string (context->printer, buffer);
   pp_set_prefix (context->printer, saved_prefix);
+  pp_needs_newline (context->printer) = true;
 }
 
 /* Functions at which to stop the backtrace print.  It's not
diff -u gcc/fortran/error.c gcc/fortran/error.c
--- gcc/fortran/error.c	(working copy)
+++ gcc/fortran/error.c	(working copy)
@@ -987,39 +987,71 @@ 
 				diagnostic_kind_color[diagnostic->kind]);
       text_ce = colorize_stop (pp_show_color (pp));
     }
+  return build_message_string ("%s%s%s: ", text_cs, text, text_ce);
+}
+
+/* Return a malloc'd string describing a location.  The caller is
+   responsible for freeing the memory.  */
+static char *
+gfc_diagnostic_build_locus_prefix (diagnostic_context *context,
+				   const diagnostic_info *diagnostic)
+{
+  pretty_printer *pp = context->printer;
   const char *locus_cs = colorize_start (pp_show_color (pp), "locus");
   const char *locus_ce = colorize_stop (pp_show_color (pp));
-
   expanded_location s = expand_location_to_spelling_point (diagnostic->location);
   if (diagnostic->override_column)
     s.column = diagnostic->override_column;
 
   return (s.file == NULL
-	  ? build_message_string ("%s%s:%s %s%s%s: ", locus_cs, progname, locus_ce,
-				  text_cs, text, text_ce)
+	  ? build_message_string ("%s%s:%s ", locus_cs, progname, locus_ce )
 	  : !strcmp (s.file, N_("<built-in>"))
-	  ? build_message_string ("%s%s:%s %s%s%s: ", locus_cs, s.file, locus_ce,
-			     text_cs, text, text_ce)
+	  ? build_message_string ("%s%s:%s ", locus_cs, s.file, locus_ce)
 	  : context->show_column
-	  ? build_message_string ("%s%s:%d:%d:%s %s%s%s: ", locus_cs, s.file, s.line,
-				  s.column, locus_ce, text_cs, text, text_ce)
-	  : build_message_string ("%s%s:%d:%s %s%s%s: ", locus_cs, s.file, s.line, locus_ce,
-				  text_cs, text, text_ce));
+	  ? build_message_string ("%s%s:%d:%d:%s ", locus_cs, s.file, s.line,
+				  s.column, locus_ce)
+	  : build_message_string ("%s%s:%d:%s ", locus_cs, s.file, s.line, locus_ce));
 }
 
 static void
 gfc_diagnostic_starter (diagnostic_context *context,
 			diagnostic_info *diagnostic)
 {
-  pp_set_prefix (context->printer, gfc_diagnostic_build_prefix (context,
-								diagnostic));
+  char * locus_prefix = gfc_diagnostic_build_locus_prefix (context, diagnostic);
+  char * prefix = gfc_diagnostic_build_prefix (context, diagnostic);
+  /* First we assume there is a caret line.  */
+  pp_set_prefix (context->printer, NULL);
+  if (pp_needs_newline (context->printer))
+    pp_newline (context->printer);
+  pp_verbatim (context->printer, locus_prefix);
+  /* Fortran uses an empty line between locus and caret line.  */
+  pp_newline (context->printer);
+  diagnostic_show_locus (context, diagnostic);
+  if (pp_needs_newline (context->printer))
+    {
+      pp_newline (context->printer);
+      /* If the caret line was shown, the prefix does not contain the
+	 locus. */
+      pp_set_prefix (context->printer, prefix);
+    }
+  else 
+    {
+      /* Otherwise, start again.  */
+      pp_clear_output_area(context->printer);
+      pp_set_prefix (context->printer, concat (locus_prefix, prefix, NULL));
+      free (prefix);
+    }
+  free (locus_prefix);
 }
 
 static void
 gfc_diagnostic_finalizer (diagnostic_context *context,
-			  diagnostic_info *diagnostic)
+			  diagnostic_info *diagnostic ATTRIBUTE_UNUSED)
 {
-  default_diagnostic_finalizer(context, diagnostic);
+  pp_destroy_prefix (context->printer);
+  pp_newline_and_flush (context->printer);
+}
+
 }
 
 /* Give a warning about the command-line.  */
@@ -1293,2 +1325,3 @@ 
   diagnostic_finalizer (global_dc) = gfc_diagnostic_finalizer;
+  global_dc->caret_char = '1';
 }
only in patch2:
unchanged:
--- gcc/diagnostic.h	(revision 214024)
+++ gcc/diagnostic.h	(working copy)
@@ -103,10 +103,13 @@  struct diagnostic_context
   bool show_caret;
 
   /* Maximum width of the source line printed.  */
   int caret_max_width;
 
+  /* Character used for caret diagnostics.  */
+  char caret_char;
+
   /* True if we should print the command line option which controls
      each diagnostic, if known.  */
   bool show_option_requested;
 
   /* True if we should raise a SIGABRT on errors.  */