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

gcc/ChangeLog:

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

	PR fortran/44054
	* diagnostic.c: Set default caret.
	(diagnostic_show_locus): Use it. Tell pretty-printer that a new
	line is needed.
	* diagnostic.h (struct diagnostic_context):


gcc/fortran/ChangeLog:

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

	PR fortran/44054
	* error.c (gfc_diagnostic_build_locus_prefix): New function.
	(gfc_diagnostic_starter): Follow Fortran FE diagnostics.
	(gfc_diagnostic_finalizer): Do not call default finalizer.

From-SVN: r214251

2 files changed, 51 insertions, 13 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index d47bffc2a7f..91330ffdd5f 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,6 +1,13 @@
 2014-08-21  Manuel López-Ibáñez  <manu@gcc.gnu.org>
 
 	PR fortran/44054
+	* error.c (gfc_diagnostic_build_locus_prefix): New function.
+	(gfc_diagnostic_starter): Follow Fortran FE diagnostics.
+	(gfc_diagnostic_finalizer): Do not call default finalizer.
+
+2014-08-21  Manuel López-Ibáñez  <manu@gcc.gnu.org>
+
+	PR fortran/44054
 	* error.c (gfc_diagnostic_finalizer): Call default finalizer.
 
 2014-08-20  Joost VandeVondele  <Joost.VandeVondele@mat.ethz.ch>
diff --git a/gcc/fortran/error.c b/gcc/fortran/error.c
index 7aab46d4311..a08aa9bd72e 100644
--- a/gcc/fortran/error.c
+++ b/gcc/fortran/error.c
@@ -987,39 +987,69 @@ gfc_diagnostic_build_prefix (diagnostic_context *context,
 				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.  */
@@ -1291,4 +1321,5 @@ gfc_diagnostics_init (void)
 {
   diagnostic_starter (global_dc) = gfc_diagnostic_starter;
   diagnostic_finalizer (global_dc) = gfc_diagnostic_finalizer;
+  global_dc->caret_char = '^';
 }