PR other/69554: avoid excessive source printing for widely-separated locations

gcc/ChangeLog:
	PR other/69554
	* diagnostic-show-locus.c (struct line_span): New struct.
	(layout::get_first_line): Delete.
	(layout::get_last_line): Delete.
	(layout::get_num_line_spans): New member function.
	(layout::get_line_span): Likewise.
	(layout::print_heading_for_line_span_index_p): Likewise.
	(layout::get_expanded_location): Likewise.
	(layout::calculate_line_spans): Likewise.
	(layout::m_first_line): Delete.
	(layout::m_last_line): Delete.
	(layout::m_line_spans): New field.
	(layout::layout): Update comment.  Replace m_first_line and
	m_last_line with m_line_spans, replacing their initialization
	with a call to calculate_line_spans.
	(diagnostic_show_locus): When printing source lines and
	annotations, rather than looping over a single span
	of lines, instead loop over each line_span within
	the layout, with an inner loop over the lines within them.
	Call the context's start_span callback when changing line spans.
	* diagnostic.c (diagnostic_initialize): Initialize start_span.
	(diagnostic_build_prefix): Break out the building of the location
	part of the string into...
	(diagnostic_get_location_text): ...this new function, rewriting
	it from nested ternary expressions to a sequence of "if"
	statements.
	(default_diagnostic_start_span_fn): New function.
	* diagnostic.h (diagnostic_start_span_fn): New typedef.
	(diagnostic_context::start_span): New field.
	(default_diagnostic_start_span_fn): New prototype.

gcc/fortran/ChangeLog:
	PR other/69554
	* error.c (gfc_diagnostic_start_span): New function.
	(gfc_diagnostics_init): Initialize global_dc's start_span.

gcc/testsuite/ChangeLog:
	PR other/69554
	* gcc.dg/pr69554-1.c: New test.
	* gfortran.dg/pr69554-1.F90: New test.
	* gfortran.dg/pr69554-2.F90: New test.
	* lib/gcc-dg.exp (proc dg-locus): New function.
	* lib/gfortran-dg.exp (proc gfortran-dg-test): Update comment to
	distinguish between the caret-printing and non-caret-printing
	cases.  If caret-printing has been explicitly enabled, bail out
	without attempting to fix up the output.

From-SVN: r233386

12 files changed, 571 insertions, 41 deletions

diff --git a/gcc/ChangeLog b/gcc/ChangeLog
index e783da7..c486023 100644
--- a/gcc/ChangeLog
+++ b/gcc/ChangeLog
@@ -1,5 +1,38 @@
 2016-02-12  David Malcolm  <dmalcolm@redhat.com>
 
+	PR other/69554
+	* diagnostic-show-locus.c (struct line_span): New struct.
+	(layout::get_first_line): Delete.
+	(layout::get_last_line): Delete.
+	(layout::get_num_line_spans): New member function.
+	(layout::get_line_span): Likewise.
+	(layout::print_heading_for_line_span_index_p): Likewise.
+	(layout::get_expanded_location): Likewise.
+	(layout::calculate_line_spans): Likewise.
+	(layout::m_first_line): Delete.
+	(layout::m_last_line): Delete.
+	(layout::m_line_spans): New field.
+	(layout::layout): Update comment.  Replace m_first_line and
+	m_last_line with m_line_spans, replacing their initialization
+	with a call to calculate_line_spans.
+	(diagnostic_show_locus): When printing source lines and
+	annotations, rather than looping over a single span
+	of lines, instead loop over each line_span within
+	the layout, with an inner loop over the lines within them.
+	Call the context's start_span callback when changing line spans.
+	* diagnostic.c (diagnostic_initialize): Initialize start_span.
+	(diagnostic_build_prefix): Break out the building of the location
+	part of the string into...
+	(diagnostic_get_location_text): ...this new function, rewriting
+	it from nested ternary expressions to a sequence of "if"
+	statements.
+	(default_diagnostic_start_span_fn): New function.
+	* diagnostic.h (diagnostic_start_span_fn): New typedef.
+	(diagnostic_context::start_span): New field.
+	(default_diagnostic_start_span_fn): New prototype.
+
+2016-02-12  David Malcolm  <dmalcolm@redhat.com>
+
 	PR driver/69779
 	* gcc.c (driver::finalize): Fix cleanup of "specs".
 
diff --git a/gcc/diagnostic-show-locus.c b/gcc/diagnostic-show-locus.c
index 3959a1d..3acdb32 100644
--- a/gcc/diagnostic-show-locus.c
+++ b/gcc/diagnostic-show-locus.c
@@ -137,6 +137,40 @@ struct line_bounds
   int m_last_non_ws;
 };
 
+/* A range of contiguous source lines within a layout (e.g. "lines 5-10"
+   or "line 23").  During the layout ctor, layout::calculate_line_spans
+   splits the pertinent source lines into a list of disjoint line_span
+   instances (e.g. lines 5-10, lines 15-20, line 23).  */
+
+struct line_span
+{
+  line_span (linenum_type first_line, linenum_type last_line)
+    : m_first_line (first_line), m_last_line (last_line)
+  {
+    gcc_assert (first_line <= last_line);
+  }
+  linenum_type get_first_line () const { return m_first_line; }
+  linenum_type get_last_line () const { return m_last_line; }
+
+  bool contains_line_p (linenum_type line) const
+  {
+    return line >= m_first_line && line <= m_last_line;
+  }
+
+  static int comparator (const void *p1, const void *p2)
+  {
+    const line_span *ls1 = (const line_span *)p1;
+    const line_span *ls2 = (const line_span *)p2;
+    int first_line_diff = (int)ls1->m_first_line - (int)ls2->m_first_line;
+    if (first_line_diff)
+      return first_line_diff;
+    return (int)ls1->m_last_line - (int)ls2->m_last_line;
+  }
+
+  linenum_type m_first_line;
+  linenum_type m_last_line;
+};
+
 /* A class to control the overall layout when printing a diagnostic.
 
    The layout is determined within the constructor.
@@ -151,14 +185,20 @@ class layout
   layout (diagnostic_context *context,
 	  const diagnostic_info *diagnostic);
 
-  int get_first_line () const { return m_first_line; }
-  int get_last_line () const { return m_last_line; }
+  int get_num_line_spans () const { return m_line_spans.length (); }
+  const line_span *get_line_span (int idx) const { return &m_line_spans[idx]; }
+
+  bool print_heading_for_line_span_index_p (int line_span_idx) const;
+
+  expanded_location get_expanded_location (const line_span *) const;
 
   bool print_source_line (int row, line_bounds *lbounds_out);
   void print_annotation_line (int row, const line_bounds lbounds);
   void print_any_fixits (int row, const rich_location *richloc);
 
  private:
+  void calculate_line_spans ();
+
   void print_newline ();
 
   bool
@@ -183,8 +223,7 @@ class layout
   colorizer m_colorizer;
   bool m_colorize_source_p;
   auto_vec <layout_range> m_layout_ranges;
-  int m_first_line;
-  int m_last_line;
+  auto_vec <line_span> m_line_spans;
   int m_x_offset;
 };
 
@@ -424,7 +463,8 @@ get_line_width_without_trailing_whitespace (const char *line, int line_width)
 
    Filter the ranges from the rich_location to those that we can
    sanely print, populating m_layout_ranges.
-   Determine the range of lines that we will print.
+   Determine the range of lines that we will print, splitting them
+   up into an ordered list of disjoint spans of contiguous line numbers.
    Determine m_x_offset, to ensure that the primary caret
    will fit within the max_width provided by the diagnostic_context.  */
 
@@ -437,8 +477,7 @@ layout::layout (diagnostic_context * context,
   m_colorizer (context, diagnostic),
   m_colorize_source_p (context->colorize_source_p),
   m_layout_ranges (rich_location::MAX_RANGES),
-  m_first_line (m_exploc.line),
-  m_last_line  (m_exploc.line),
+  m_line_spans (1 + rich_location::MAX_RANGES),
   m_x_offset (0)
 {
   rich_location *richloc = diagnostic->richloc;
@@ -484,14 +523,11 @@ layout::layout (diagnostic_context * context,
       /* Passed all the tests; add the range to m_layout_ranges so that
 	 it will be printed.  */
       m_layout_ranges.safe_push (ri);
-
-      /* Update m_first_line/m_last_line if necessary.  */
-      if (ri.m_start.m_line < m_first_line)
-	m_first_line = ri.m_start.m_line;
-      if (ri.m_finish.m_line > m_last_line)
-	m_last_line = ri.m_finish.m_line;
     }
 
+  /* Populate m_line_spans.  */
+  calculate_line_spans ();
+
   /* Adjust m_x_offset.
      Center the primary caret to fit in max_width; all columns
      will be adjusted accordingly.  */
@@ -511,6 +547,142 @@ layout::layout (diagnostic_context * context,
     }
 }
 
+/* Return true iff we should print a heading when starting the
+   line span with the given index.  */
+
+bool
+layout::print_heading_for_line_span_index_p (int line_span_idx) const
+{
+  /* We print a heading for every change of line span, hence for every
+     line span after the initial one.  */
+  if (line_span_idx > 0)
+    return true;
+
+  /* We also do it for the initial span if the primary location of the
+     diagnostic is in a different span.  */
+  if (m_exploc.line > (int)get_line_span (0)->m_last_line)
+    return true;
+
+  return false;
+}
+
+/* Get an expanded_location for the first location of interest within
+   the given line_span.
+   Used when printing a heading to indicate a new line span.  */
+
+expanded_location
+layout::get_expanded_location (const line_span *line_span) const
+{
+  /* Whenever possible, use the caret location.  */
+  if (line_span->contains_line_p (m_exploc.line))
+    return m_exploc;
+
+  /* Otherwise, use the start of the first range that's present
+     within the line_span.  */
+  for (unsigned int i = 0; i < m_layout_ranges.length (); i++)
+    {
+      const layout_range *lr = &m_layout_ranges[i];
+      if (line_span->contains_line_p (lr->m_start.m_line))
+	{
+	  expanded_location exploc = m_exploc;
+	  exploc.line = lr->m_start.m_line;
+	  exploc.column = lr->m_start.m_column;
+	  return exploc;
+	}
+    }
+
+  /* It should not be possible to have a line span that didn't
+     contain any of the layout_range instances.  */
+  gcc_unreachable ();
+  return m_exploc;
+}
+
+/* We want to print the pertinent source code at a diagnostic.  The
+   rich_location can contain multiple locations.  This will have been
+   filtered into m_exploc (the caret for the primary location) and
+   m_layout_ranges, for those ranges within the same source file.
+
+   We will print a subset of the lines within the source file in question,
+   as a collection of "spans" of lines.
+
+   This function populates m_line_spans with an ordered, disjoint list of
+   the line spans of interest.
+
+   For example, if the primary caret location is on line 7, with ranges
+   covering lines 5-6 and lines 9-12:
+
+     004
+     005                   |RANGE 0
+     006                   |RANGE 0
+     007  |PRIMARY CARET
+     008
+     009                                |RANGE 1
+     010                                |RANGE 1
+     011                                |RANGE 1
+     012                                |RANGE 1
+     013
+
+   then we want two spans: lines 5-7 and lines 9-12.  */
+
+void
+layout::calculate_line_spans ()
+{
+  /* This should only be called once, by the ctor.  */
+  gcc_assert (m_line_spans.length () == 0);
+
+  /* Populate tmp_spans with individual spans, for each of
+     m_exploc, and for m_layout_ranges.  */
+  auto_vec<line_span> tmp_spans (1 + rich_location::MAX_RANGES);
+  tmp_spans.safe_push (line_span (m_exploc.line, m_exploc.line));
+  for (unsigned int i = 0; i < m_layout_ranges.length (); i++)
+    {
+      const layout_range *lr = &m_layout_ranges[i];
+      gcc_assert (lr->m_start.m_line <= lr->m_finish.m_line);
+      tmp_spans.safe_push (line_span (lr->m_start.m_line,
+				      lr->m_finish.m_line));
+    }
+
+  /* Sort them.  */
+  tmp_spans.qsort(line_span::comparator);
+
+  /* Now iterate through tmp_spans, copying into m_line_spans, and
+     combining where possible.  */
+  gcc_assert (tmp_spans.length () > 0);
+  m_line_spans.safe_push (tmp_spans[0]);
+  for (unsigned int i = 1; i < tmp_spans.length (); i++)
+    {
+      line_span *current = &m_line_spans[m_line_spans.length () - 1];
+      const line_span *next = &tmp_spans[i];
+      gcc_assert (next->m_first_line >= current->m_first_line);
+      if (next->m_first_line <= current->m_last_line + 1)
+	{
+	  /* We can merge them. */
+	  if (next->m_last_line > current->m_last_line)
+	    current->m_last_line = next->m_last_line;
+	}
+      else
+	{
+	  /* No merger possible.  */
+	  m_line_spans.safe_push (*next);
+	}
+    }
+
+  /* Verify the result, in m_line_spans.  */
+  gcc_assert (m_line_spans.length () > 0);
+  for (unsigned int i = 1; i < m_line_spans.length (); i++)
+    {
+      const line_span *prev = &m_line_spans[i - 1];
+      const line_span *next = &m_line_spans[i];
+      /* The individual spans must be sane.  */
+      gcc_assert (prev->m_first_line <= prev->m_last_line);
+      gcc_assert (next->m_first_line <= next->m_last_line);
+      /* The spans must be ordered.  */
+      gcc_assert (prev->m_first_line < next->m_first_line);
+      /* There must be a gap of at least one line between separate spans.  */
+      gcc_assert ((prev->m_last_line + 1) < next->m_first_line);
+    }
+}
+
 /* Attempt to print line ROW of source code, potentially colorized at any
    ranges.
    Return true if the line was printed, populating *LBOUNDS_OUT.
@@ -826,17 +998,27 @@ diagnostic_show_locus (diagnostic_context * context,
   pp_set_prefix (context->printer, NULL);
 
   layout layout (context, diagnostic);
-  int last_line = layout.get_last_line ();
-  for (int row = layout.get_first_line (); row <= last_line; row++)
+  for (int line_span_idx = 0; line_span_idx < layout.get_num_line_spans ();
+       line_span_idx++)
     {
-      /* Print the source line, followed by an annotation line
-	 consisting of any caret/underlines, then any fixits.
-	 If the source line can't be read, print nothing.  */
-      line_bounds lbounds;
-      if (layout.print_source_line (row, &lbounds))
+      const line_span *line_span = layout.get_line_span (line_span_idx);
+      if (layout.print_heading_for_line_span_index_p (line_span_idx))
+	{
+	  expanded_location exploc = layout.get_expanded_location (line_span);
+	  context->start_span (context, exploc);
+	}
+      int last_line = line_span->get_last_line ();
+      for (int row = line_span->get_first_line (); row <= last_line; row++)
 	{
-	  layout.print_annotation_line (row, lbounds);
-	  layout.print_any_fixits (row, diagnostic->richloc);
+	  /* Print the source line, followed by an annotation line
+	     consisting of any caret/underlines, then any fixits.
+	     If the source line can't be read, print nothing.  */
+	  line_bounds lbounds;
+	  if (layout.print_source_line (row, &lbounds))
+	    {
+	      layout.print_annotation_line (row, lbounds);
+	      layout.print_any_fixits (row, diagnostic->richloc);
+	    }
 	}
     }
 
diff --git a/gcc/diagnostic.c b/gcc/diagnostic.c
index f661b57..322f2d9 100644
--- a/gcc/diagnostic.c
+++ b/gcc/diagnostic.c
@@ -158,6 +158,7 @@ diagnostic_initialize (diagnostic_context *context, int n_opts)
   context->max_errors = 0;
   context->internal_error = NULL;
   diagnostic_starter (context) = default_diagnostic_starter;
+  context->start_span = default_diagnostic_start_span_fn;
   diagnostic_finalizer (context) = default_diagnostic_finalizer;
   context->option_enabled = NULL;
   context->option_state = NULL;
@@ -274,8 +275,34 @@ diagnostic_get_color_for_kind (diagnostic_t kind)
   return diagnostic_kind_color[kind];
 }
 
-/* Return a malloc'd string describing a location.  The caller is
-   responsible for freeing the memory.  */
+/* Return a malloc'd string describing a location e.g. "foo.c:42:10".
+   The caller is responsible for freeing the memory.  */
+
+static char *
+diagnostic_get_location_text (diagnostic_context *context,
+			      expanded_location s)
+{
+  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));
+
+  if (s.file == NULL)
+    return build_message_string ("%s%s:%s", locus_cs, progname, locus_ce);
+
+  if (!strcmp (s.file, N_("<built-in>")))
+    return build_message_string ("%s%s:%s", locus_cs, s.file, locus_ce);
+
+  if (context->show_column)
+    return build_message_string ("%s%s:%d:%d:%s", locus_cs, s.file, s.line,
+				 s.column, locus_ce);
+  else
+    return build_message_string ("%s%s:%d:%s", locus_cs, s.file, s.line,
+				 locus_ce);
+}
+
+/* Return a malloc'd string describing a location and the severity of the
+   diagnostic, e.g. "foo.c:42:10: error: ".  The caller is responsible for
+   freeing the memory.  */
 char *
 diagnostic_build_prefix (diagnostic_context *context,
 			 const diagnostic_info *diagnostic)
@@ -290,7 +317,6 @@ diagnostic_build_prefix (diagnostic_context *context,
 
   const char *text = _(diagnostic_kind_text[diagnostic->kind]);
   const char *text_cs = "", *text_ce = "";
-  const char *locus_cs, *locus_ce;
   pretty_printer *pp = context->printer;
 
   if (diagnostic_kind_color[diagnostic->kind])
@@ -299,22 +325,14 @@ diagnostic_build_prefix (diagnostic_context *context,
 				diagnostic_kind_color[diagnostic->kind]);
       text_ce = colorize_stop (pp_show_color (pp));
     }
-  locus_cs = colorize_start (pp_show_color (pp), "locus");
-  locus_ce = colorize_stop (pp_show_color (pp));
 
   expanded_location s = diagnostic_expand_location (diagnostic);
-  return
-    (s.file == NULL
-     ? build_message_string ("%s%s:%s %s%s%s", locus_cs, progname, locus_ce,
-			     text_cs, text, text_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)
-     : 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));
+  char *location_text = diagnostic_get_location_text (context, s);
+
+  char *result = build_message_string ("%s %s%s%s", location_text,
+				       text_cs, text, text_ce);
+  free (location_text);
+  return result;
 }
 
 /* Functions at which to stop the backtrace print.  It's not
@@ -541,6 +559,16 @@ default_diagnostic_starter (diagnostic_context *context,
 }
 
 void
+default_diagnostic_start_span_fn (diagnostic_context *context,
+				  expanded_location exploc)
+{
+  pp_set_prefix (context->printer,
+		 diagnostic_get_location_text (context, exploc));
+  pp_string (context->printer, "");
+  pp_newline (context->printer);
+}
+
+void
 default_diagnostic_finalizer (diagnostic_context *context,
 			      diagnostic_info *diagnostic)
 {
diff --git a/gcc/diagnostic.h b/gcc/diagnostic.h
index 7cc5cff..017ddca 100644
--- a/gcc/diagnostic.h
+++ b/gcc/diagnostic.h
@@ -56,6 +56,10 @@ struct diagnostic_classification_change_t
 /*  Forward declarations.  */
 typedef void (*diagnostic_starter_fn) (diagnostic_context *,
 				       diagnostic_info *);
+
+typedef void (*diagnostic_start_span_fn) (diagnostic_context *,
+					  expanded_location);
+
 typedef diagnostic_starter_fn diagnostic_finalizer_fn;
 
 /* This data structure bundles altogether any information relevant to
@@ -148,6 +152,11 @@ struct diagnostic_context
   */
   diagnostic_starter_fn begin_diagnostic;
 
+  /* This function is called by diagnostic_show_locus in between
+     disjoint spans of source code, so that the context can print
+     something to indicate that a new span of source code has begun.  */
+  diagnostic_start_span_fn start_span;
+
   /* This function is called after the diagnostic message is printed.  */
   diagnostic_finalizer_fn end_diagnostic;
 
@@ -296,6 +305,8 @@ extern void diagnostic_append_note (diagnostic_context *, location_t,
 #endif
 extern char *diagnostic_build_prefix (diagnostic_context *, const diagnostic_info *);
 void default_diagnostic_starter (diagnostic_context *, diagnostic_info *);
+void default_diagnostic_start_span_fn (diagnostic_context *,
+				       expanded_location);
 void default_diagnostic_finalizer (diagnostic_context *, diagnostic_info *);
 void diagnostic_set_caret_max_width (diagnostic_context *context, int value);
 void diagnostic_action_after_output (diagnostic_context *, diagnostic_t);
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 77a08c4..de669e0 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2016-02-12  David Malcolm  <dmalcolm@redhat.com>
+
+	PR other/69554
+	* error.c (gfc_diagnostic_start_span): New function.
+	(gfc_diagnostics_init): Initialize global_dc's start_span.
+
 2016-02-11  Andre Vehreschild  <vehre@gcc.gnu.org>
 
 	PR fortran/69296
diff --git a/gcc/fortran/error.c b/gcc/fortran/error.c
index e7f4ba7..003702b 100644
--- a/gcc/fortran/error.c
+++ b/gcc/fortran/error.c
@@ -1103,6 +1103,20 @@ gfc_diagnostic_starter (diagnostic_context *context,
 }
 
 static void
+gfc_diagnostic_start_span (diagnostic_context *context,
+			   expanded_location exploc)
+{
+  char *locus_prefix;
+  locus_prefix = gfc_diagnostic_build_locus_prefix (context, exploc);
+  pp_verbatim (context->printer, locus_prefix);
+  free (locus_prefix);
+  pp_newline (context->printer);
+  /* Fortran uses an empty line between locus and caret line.  */
+  pp_newline (context->printer);
+}
+
+
+static void
 gfc_diagnostic_finalizer (diagnostic_context *context,
 			  diagnostic_info *diagnostic ATTRIBUTE_UNUSED)
 {
@@ -1426,6 +1440,7 @@ void
 gfc_diagnostics_init (void)
 {
   diagnostic_starter (global_dc) = gfc_diagnostic_starter;
+  global_dc->start_span = gfc_diagnostic_start_span;
   diagnostic_finalizer (global_dc) = gfc_diagnostic_finalizer;
   diagnostic_format_decoder (global_dc) = gfc_format_decoder;
   global_dc->caret_chars[0] = '1';
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index ffe2f2a2..6d01ca3 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,5 +1,17 @@
 2016-02-12  David Malcolm  <dmalcolm@redhat.com>
 
+	PR other/69554
+	* gcc.dg/pr69554-1.c: New test.
+	* gfortran.dg/pr69554-1.F90: New test.
+	* gfortran.dg/pr69554-2.F90: New test.
+	* lib/gcc-dg.exp (proc dg-locus): New function.
+	* lib/gfortran-dg.exp (proc gfortran-dg-test): Update comment to
+	distinguish between the caret-printing and non-caret-printing
+	cases.  If caret-printing has been explicitly enabled, bail out
+	without attempting to fix up the output.
+
+2016-02-12  David Malcolm  <dmalcolm@redhat.com>
+
 	PR driver/69265
 	PR driver/69453
 	* gcc.dg/spellcheck-options-3.c: New test case.
diff --git a/gcc/testsuite/gcc.dg/pr69554-1.c b/gcc/testsuite/gcc.dg/pr69554-1.c
new file mode 100644
index 0000000..07ad0db
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/pr69554-1.c
@@ -0,0 +1,152 @@
+/* { dg-options "-fdiagnostics-show-caret" } */
+
+/* Various versions of the same C error, with a variety of line spacing,
+   and of columns, to exercise the line-span handling in
+   diagnostic-show-locus.c (PR other/69554).  */
+
+/* All on one line.  */
+
+int test_1 (const char *p, const char *q)
+{
+  return (p + 1) + (q + 1); /* { dg-error "invalid operands" } */
+/* { dg-begin-multiline-output "" }
+   return (p + 1) + (q + 1);
+          ~~~~~~~ ^ ~~~~~~~
+   { dg-end-multiline-output "" } */
+}
+
+/* On separate lines, but without intervening lines.
+   This can be printed as a single span of lines.  */
+
+int test_2 (const char *p, const char *q)
+{
+  return (p + 1)
+           +  /* { dg-error "invalid operands" } */
+            (q + 1);
+/* { dg-begin-multiline-output "" }
+   return (p + 1)
+          ~~~~~~~
+            +
+            ^
+             (q + 1);
+             ~~~~~~~
+   { dg-end-multiline-output "" } */
+}
+
+/* On separate lines, with an intervening line between lines 1 and 2.
+   This is printed as 2 "spans" of lines, broken up by the intervening
+   line.  */
+
+int test_3 (const char *p, const char *q)
+{
+  return (p + 1) /* { dg-locus "10" } */
+
+           +  /* { dg-error "invalid operands" } */
+             (q + 1);
+/* { dg-locus "12" "" { target *-*-* } "44" } */
+/* { dg-begin-multiline-output "" }
+   return (p + 1)
+          ~~~~~~~
+   { dg-end-multiline-output "" } */
+/* { dg-begin-multiline-output "" }
+            +
+            ^
+              (q + 1);
+              ~~~~~~~
+   { dg-end-multiline-output "" } */
+}
+
+/* As above, but the intervening line is between lines 2 and 3,
+   so that the 2 spans are grouped the other way.  */
+
+int test_4 (const char *p, const char *q)
+{
+  return (p + 1)
+           +  /* { dg-error "invalid operands" } */
+
+             (q + 1); /* { dg-locus "14" } */
+/* { dg-begin-multiline-output "" }
+   return (p + 1)
+          ~~~~~~~
+            +
+            ^
+   { dg-end-multiline-output "" } */
+/* { dg-begin-multiline-output "" }
+              (q + 1);
+              ~~~~~~~
+   { dg-end-multiline-output "" } */
+}
+
+/* On separate lines, with intervening lines.
+   This is printed as 3 "spans" of lines, each span being an
+   individual line.  */
+
+int test_5 (const char *p, const char *q)
+{
+  return (p + 1) /* { dg-locus "10" } */
+
+           +  /* { dg-error "invalid operands" } */
+
+             (q + 1); /* { dg-locus "14" } */
+/* { dg-locus "12" "" { target *-*-* } "88" } */
+/* { dg-begin-multiline-output "" }
+   return (p + 1)
+          ~~~~~~~
+   { dg-end-multiline-output "" } */
+/* { dg-begin-multiline-output "" }
+            +
+            ^
+   { dg-end-multiline-output "" } */
+/* { dg-begin-multiline-output "" }
+              (q + 1);
+              ~~~~~~~
+   { dg-end-multiline-output "" } */
+}
+
+/* On separate lines, with numerous intervening lines.
+   This is printed as 3 "spans" of lines, each span being an
+   individual line.  */
+
+int test_6 (const char *p, const char *q)
+{
+  return (p + 1) /* { dg-locus "10" } */
+	  /* Lorem ipsum dolor sit amet, consectetur adipiscing elit.
+	     Maecenas nisl sapien, rutrum non euismod et, rutrum ac felis.
+	     Morbi nec nisi ipsum. Quisque pulvinar ante nec urna rhoncus,
+	     a cursus nisi commodo. Praesent euismod neque lectus, at
+	     dapibus ipsum gravida in. Pellentesque tempor massa eu viverra
+	     feugiat. Proin eleifend pulvinar urna, ut dapibus metus vehicula
+	     ac. Suspendisse rutrum finibus quam, ac dignissim diam blandit
+	     maximus. In blandit viverra pulvinar. Praesent vel tellus
+	     elementum, placerat lacus quis, ornare lectus. Donec ac
+	     eleifend nulla, sit amet condimentum risus. Vestibulum aliquam
+	     maximus ante non pellentesque. Praesent mollis ante in risus
+	     feugiat hendrerit. Praesent feugiat maximus urna nec blandit. */
+           +  /* { dg-error "invalid operands" } */
+	  /* Vestibulum ac nunc eget enim tempor tristique. Suspendisse
+	     potenti. Nam et sollicitudin enim. Morbi sed tincidunt lectus.
+	     Sed facilisis velit at ante maximus feugiat. Sed vestibulum mi
+	     id leo tempor, sed ullamcorper sapien efficitur. Vestibulum purus
+	     lacus, dignissim non magna at, tincidunt luctus nisl. Cum sociis
+	     natoque penatibus et magnis dis parturient montes, nascetur
+	     ridiculus mus. Donec elit elit, laoreet a dolor quis, eleifend
+	     dapibus metus. Proin lectus turpis, eleifend nec pharetra eu,
+	     fermentum in lacus. Morbi sit amet mauris orci. Nam sagittis,
+	     nibh vel fermentum dictum, purus ex hendrerit odio, feugiat
+	     fringilla sapien elit vitae nisl. Fusce mattis commodo risus
+	     nec convallis. */
+             (q + 1); /* { dg-locus "14" } */
+/* { dg-locus "12" "" { target *-*-* } "125" } */
+/* { dg-begin-multiline-output "" }
+   return (p + 1)
+          ~~~~~~~
+   { dg-end-multiline-output "" } */
+/* { dg-begin-multiline-output "" }
+            +
+            ^
+   { dg-end-multiline-output "" } */
+/* { dg-begin-multiline-output "" }
+              (q + 1);
+              ~~~~~~~
+   { dg-end-multiline-output "" } */
+}
diff --git a/gcc/testsuite/gfortran.dg/pr69554-1.F90 b/gcc/testsuite/gfortran.dg/pr69554-1.F90
new file mode 100644
index 0000000..38a3c88
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr69554-1.F90
@@ -0,0 +1,28 @@
+! { dg-do compile }
+! { dg-options "-fdiagnostics-show-caret" }
+! { dg-allow-blank-lines-in-output 1 }
+
+program main
+  goto 1000
+1000 continue ! first instance
+  a = a
+  a = a
+  a = a
+1000 continue ! second instance
+end
+
+#if 0
+! { dg-locus "4" "" { target *-*-* } "7" }
+! { dg-begin-multiline-output "" }
+
+ 1000 continue ! first instance
+    1
+! { dg-end-multiline-output "" }
+! { dg-locus "4" "" { target *-*-* } "11" }
+! { dg-begin-multiline-output "" }
+
+ 1000 continue ! second instance
+    2
+Error: Duplicate statement label 1000 at (1) and (2)
+! { dg-end-multiline-output "" }
+#endif
diff --git a/gcc/testsuite/gfortran.dg/pr69554-2.F90 b/gcc/testsuite/gfortran.dg/pr69554-2.F90
new file mode 100644
index 0000000..0a25e58
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr69554-2.F90
@@ -0,0 +1,21 @@
+! { dg-do compile }
+! { dg-options "-fdiagnostics-show-caret" }
+! { dg-allow-blank-lines-in-output 1 }
+
+program main
+  goto 1000
+1000 continue ! first instance
+1000 continue ! second instance
+end
+
+#if 0
+! { dg-locus "4" "" { target *-*-* } "7" }
+! { dg-begin-multiline-output "" }
+
+ 1000 continue ! first instance
+    1
+ 1000 continue ! second instance
+    2
+Error: Duplicate statement label 1000 at (1) and (2)
+! { dg-end-multiline-output "" }
+#endif
diff --git a/gcc/testsuite/lib/gcc-dg.exp b/gcc/testsuite/lib/gcc-dg.exp
index 3dd8564..b732b54 100644
--- a/gcc/testsuite/lib/gcc-dg.exp
+++ b/gcc/testsuite/lib/gcc-dg.exp
@@ -988,6 +988,33 @@ proc dg-message { args } {
     process-message saved-dg-warning "" $args
 }
 
+# Look for a location marker of the form
+#   file:line:column:
+# with no extra text (e.g. a line-span separator).
+
+proc dg-locus { args } {
+    upvar dg-messages dg-messages
+
+    # Process the dg- directive, including adding the regular expression
+    # to the new message entry in dg-messages.
+    set msgcnt [llength ${dg-messages}]
+    eval saved-dg-warning $args
+
+    # If the target expression wasn't satisfied there is no new message.
+    if { [llength ${dg-messages}] == $msgcnt } {
+	return;
+    }
+
+    # Get the entry for the new message.  Prepend the message prefix to
+    # the regular expression and make it match a single line.
+    set newentry [lindex ${dg-messages} end]
+    set expmsg [lindex $newentry 2]
+
+    set newentry [lreplace $newentry 2 2 $expmsg]
+    set dg-messages [lreplace ${dg-messages} end end $newentry]
+    verbose "process-message:\n${dg-messages}" 2
+}
+
 # Check the existence of a gdb in the path, and return true if there
 # is one.
 #
diff --git a/gcc/testsuite/lib/gfortran-dg.exp b/gcc/testsuite/lib/gfortran-dg.exp
index 52bb341..6b7f98b 100644
--- a/gcc/testsuite/lib/gfortran-dg.exp
+++ b/gcc/testsuite/lib/gfortran-dg.exp
@@ -26,7 +26,15 @@ proc gfortran-dg-test { prog do_what extra_tool_flags } {
     set comp_output [lindex $result 0]
     set output_file [lindex $result 1]
 
-    # gfortran error messages look like this:
+    # gcc's default is to print the caret and source code, but
+    # most test cases implicitly use the flag -fno-diagnostics-show-caret
+    # to disable caret (and source code) printing.
+    #
+    # However, a few test cases override this back to the default by
+    # explicily supplying "-fdiagnostics-show-caret", so that we can have
+    # test coverage for caret/source code printing.
+    #
+    # gfortran error messages with caret-printing look like this:
     #     [name]:[locus]:
     #
     #        some code
@@ -49,7 +57,14 @@ proc gfortran-dg-test { prog do_what extra_tool_flags } {
     #              1       2
     #     Error: Some error at (1) and (2)
     #
-    # or
+    # If this is such a test case, skip the rest of this function, so
+    # that the test case can explicitly verify the output that it expects.
+    if {[string first "-fdiagnostics-show-caret" $extra_tool_flags] >= 0} {
+	return [list $comp_output $output_file]
+    }
+
+    # Otherwise, caret-printing is disabled.
+    # gfortran errors with caret-printing disabled look like this:
     #     [name]:[locus]: Error: Some error
     # or
     #     [name]:[locus]: Error: (1)