diff mbox

[diagnostics/fortran] Handle two locations for the same diagnostic. Convert all gfc_warning_1 and gfc_notify_std_1 calls

Message ID CAESRpQDdrOwNZd74JO5u-7nVOH5_n1h+KsMwvtkhaPTQ6d9UxQ@mail.gmail.com
State New
Headers show

Commit Message

Manuel López-Ibáñez May 8, 2015, 10:12 p.m. UTC 
Hi Dodji,

Thanks for the review. I followed all your suggestions. For the
accessor functions, I was not sure what type you would prefer, so I
implemented them as C++ methods and made use of 'private' to be sure
they are the only way to access the locations array. If you want me to
change it, just tell me what you prefer. I also replaced
diagnostic_same_locus with diagnostic_same_line.

Bootstrapped & regression tested on x86_64-linux-gnu.

OK?

Manuel.


gcc/fortran/ChangeLog:

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

    PR fortran/44054

    Replace all calls to gfc_notify_std_1 with gfc_notify_std and
    gfc_warning_1 with gfc_warning.
    * decl.c (gfc_verify_c_interop_param): Here.
    * resolve.c (resolve_branch): Here.
    (resolve_fl_derived): Here.
    * dependency.c (gfc_check_argument_var_dependency):
    * scanner.c (preprocessor_line): Use gfc_warning_now_at. Fix line
    counter and locations before and after warning.
    * gfortran.h (gfc_warning_1, gfc_warning_now_1, gfc_notify_std_1):
    Delete.
    (gfc_warning_now_at): Declare.
    * error.c (gfc_warning_1): Delete.
    (gfc_notify_std_1): Delete.
    (gfc_warning_now_1): Delete.
    (gfc_format_decoder): Handle two locations.
    (gfc_diagnostic_build_prefix): Rename as
    gfc_diagnostic_build_kind_prefix.
    (gfc_diagnostic_build_locus_prefix): Take an expanded_location
    instead of diagnostic_info.
    (gfc_diagnostic_build_locus_prefix): Add overload that takes two
    expanded_location.
    (gfc_diagnostic_starter): Handle two locations.
    (gfc_warning_now_at): New.
    (gfc_diagnostics_init): Initialize caret_chars array.
    (gfc_diagnostics_finish): Reset caret_chars array to default.

gcc/cp/ChangeLog:

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

    * error.c (cp_diagnostic_starter): Use diagnostic_location
    function.
    (cp_print_error_function): Likewise.
    (cp_printer): Replace locus pointer with accessor function.

gcc/c/ChangeLog:

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

    * c-objc-common.c (c_tree_printer): Replace locus pointer with
    accessor function.

gcc/ChangeLog:

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

    * tree-pretty-print.c (percent_K_format): Replace locus pointer
    with accessor function.
    * tree-diagnostic.c (diagnostic_report_current_function): Use
    diagnostic_location function.
    (maybe_unwind_expanded_macro_loc): Likewise.
    (virt_loc_aware_diagnostic_finalizer): Likewise.
    (default_tree_printer): Replace locus pointer with accessor function.
    * diagnostic.c (diagnostic_initialize): Initialize caret_chars array.
    (diagnostic_set_info_translated): Initialize second location.
    (diagnostic_build_prefix): Use CARET_LINE_MARGIN.
    (diagnostic_show_locus): Handle two locations. Call
    diagnostic_print_caret_line.
    (diagnostic_print_caret_line): New.
    (default_diagnostic_starter): Use diagnostic_location function.
    (diagnostic_report_diagnostic): Use diagnostic_location function.
    (verbatim): Do not set text.locus.
    * diagnostic.h (struct diagnostic_info): Remove location field.
    (struct diagnostic_context): Make caret_chars an array of two.
    (diagnostic_location): New inline.
    (diagnostic_expand_location): Handle two locations.
    (diagnostic_same_line): New inline.
    (diagnostic_print_caret_line): Declare.
    (CARET_LINE_MARGIN): New constant.
    * pretty-print.c (pp_printf): Do not set text.locus.
    (pp_verbatim): Do not set text.locus.
    * pretty-print.h (MAX_LOCATIONS_PER_MESSAGE): New constant.
    (struct text_info): Replace locus pointer with locations
    array. Add accessor functions.

gcc/testsuite/ChangeLog:

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

    PR fortran/44054
    * lib/gfortran-dg.exp: Update regex to handle two locations for
    the same diagnostic without caret.
    * gfortran.dg/badline.f: Test also that line numbers are correct
    before and after "left but not entered" warning.

Comments

Dodji Seketeli May 15, 2015, 8:39 a.m. UTC | #1 
Manuel López-Ibáñez <lopezibanez@gmail.com> writes:

> Thanks for the review. I followed all your suggestions. For the
> accessor functions, I was not sure what type you would prefer, so I
> implemented them as C++ methods and made use of 'private' to be sure
> they are the only way to access the locations array. If you want me to
> change it, just tell me what you prefer. I also replaced
> diagnostic_same_locus with diagnostic_same_line.

Great, thank you.

>
> Bootstrapped & regression tested on x86_64-linux-gnu.
>
> OK?

Yes, but with the slight changes below.  Sorry I spotted them just now,
but they are quick to fix, I believe.

>
> Manuel.
>

[...]

> -/* Expand the location of this diagnostic. Use this function for consistency. */
> +/* Return the location associated to this diagnostic. WHICH specifies

Here, I think only the 'W' (in WHICH) should be uppercase.


[...]


>  /* The type of a text to be formatted according a format specification
>     along with a list of things.  */
>  struct text_info
>  {
> +public:

As this is a struct, the 'public' here is not necessary, as the members
are public by default.

>    const char *format_spec;
>    va_list *args_ptr;
>    int err_no;  /* for %m */
> -  location_t *locus;
>    void **x_data;
> +
> +  inline location_t & set_location (unsigned int index_of_location)

I think it's less surprising to have the this function take two
parameters:  The index_of_location and the new new location.

So that it's used by doing: set_location (0, the_new_location);

> +  {
> +    gcc_checking_assert (index_of_location < MAX_LOCATIONS_PER_MESSAGE);
> +    return this->locations[index_of_location];
> +  }
> +
> +  inline location_t get_location (unsigned int index_of_location) const
> +  {
> +    gcc_checking_assert (index_of_location < MAX_LOCATIONS_PER_MESSAGE);
> +    return this->locations[index_of_location];
> +  }
> +
> +private:
> +  location_t locations[MAX_LOCATIONS_PER_MESSAGE];
>  };
>  

[...]

OK to commit with the changes above.

Thanks a lot!
Manuel López-Ibáñez May 15, 2015, 11:47 a.m. UTC | #2 
On 15 May 2015 at 10:39, Dodji Seketeli <dodji@redhat.com> wrote:
> Manuel López-Ibáñez <lopezibanez@gmail.com> writes:
>> -/* Expand the location of this diagnostic. Use this function for consistency. */
>> +/* Return the location associated to this diagnostic. WHICH specifies
>
> Here, I think only the 'W' (in WHICH) should be uppercase.

I'm following the convention that parameter names are uppercase in the
description of functions. I can also say "Parameter WHICH specifies"
to be more explicit.


>>  /* The type of a text to be formatted according a format specification
>>     along with a list of things.  */
>>  struct text_info
>>  {
>> +public:
>
> As this is a struct, the 'public' here is not necessary, as the members
> are public by default.

I have a very poor memory for such details ;), since we are using
'private:' already, does it really hurt to be explicit and use
'public:' here?

>>    const char *format_spec;
>>    va_list *args_ptr;
>>    int err_no;  /* for %m */
>> -  location_t *locus;
>>    void **x_data;
>> +
>> +  inline location_t & set_location (unsigned int index_of_location)
>
> I think it's less surprising to have the this function take two
> parameters:  The index_of_location and the new new location.

OK.

> OK to commit with the changes above.

Thanks. If you insist on the two first changes, I'll do them, I just
want to confirm those.

Cheers,

Manuel.
Dodji Seketeli May 18, 2015, 7:35 a.m. UTC | #3 
Manuel López-Ibáñez <lopezibanez@gmail.com> writes:

> On 15 May 2015 at 10:39, Dodji Seketeli <dodji@redhat.com> wrote:
>> Manuel López-Ibáñez <lopezibanez@gmail.com> writes:
>>> -/* Expand the location of this diagnostic. Use this function for consistency. */
>>> +/* Return the location associated to this diagnostic. WHICH specifies
>>
>> Here, I think only the 'W' (in WHICH) should be uppercase.
>
> I'm following the convention that parameter names are uppercase in the
> description of functions.

Oh, okay then.  My bad.  Sorry.

>>>  /* The type of a text to be formatted according a format specification
>>>     along with a list of things.  */
>>>  struct text_info
>>>  {
>>> +public:
>>
>> As this is a struct, the 'public' here is not necessary, as the members
>> are public by default.
>
> I have a very poor memory for such details ;), since we are using
> 'private:' already, does it really hurt to be explicit and use
> 'public:' here?

It doesn't hurt, per se.  But I think it's a very common style to avoid
specifying the 'public' in this case, so I'd rather just remove it, yes.

[...]

OK to commit with this change then.

Cheers,
diff mbox

Patch

Index: gcc/c/c-objc-common.c
===================================================================
--- gcc/c/c-objc-common.c	(revision 222903)
+++ gcc/c/c-objc-common.c	(working copy)
@@ -106,12 +106,12 @@  c_tree_printer (pretty_printer *pp, text
     }
 
   if (*spec != 'v')
     {
       t = va_arg (*text->args_ptr, tree);
-      if (set_locus && text->locus)
-	*text->locus = DECL_SOURCE_LOCATION (t);
+      if (set_locus)
+	text->set_location (0) = DECL_SOURCE_LOCATION (t);
     }
 
   switch (*spec)
     {
     case 'D':
Index: gcc/tree-pretty-print.c
===================================================================
--- gcc/tree-pretty-print.c	(revision 222903)
+++ gcc/tree-pretty-print.c	(working copy)
@@ -3618,12 +3618,11 @@  newline_and_indent (pretty_printer *pp, 
 
 void
 percent_K_format (text_info *text)
 {
   tree t = va_arg (*text->args_ptr, tree), block;
-  gcc_assert (text->locus != NULL);
-  *text->locus = EXPR_LOCATION (t);
+  text->set_location (0) = EXPR_LOCATION (t);
   gcc_assert (pp_ti_abstract_origin (text) != NULL);
   block = TREE_BLOCK (t);
   *pp_ti_abstract_origin (text) = NULL;
 
   if (in_lto_p)
Index: gcc/tree-diagnostic.c
===================================================================
--- gcc/tree-diagnostic.c	(revision 222903)
+++ gcc/tree-diagnostic.c	(working copy)
@@ -46,11 +46,11 @@  along with GCC; see the file COPYING3.  
    that caused an error.  Called from all error and warning functions.  */
 void
 diagnostic_report_current_function (diagnostic_context *context,
 				    diagnostic_info *diagnostic)
 {
-  diagnostic_report_current_module (context, diagnostic->location);
+  diagnostic_report_current_module (context, diagnostic_location (diagnostic));
   lang_hooks.print_error_function (context, LOCATION_FILE (input_location),
 				   diagnostic);
 }
 
 static void
@@ -151,11 +151,11 @@  maybe_unwind_expanded_macro_loc (diagnos
 
   /* Walk LOC_VEC and print the macro expansion trace, unless the
      first macro which expansion triggered this trace was expanded
      inside a system header.  */
   int saved_location_line =
-    expand_location_to_spelling_point (diagnostic->location).line;
+    expand_location_to_spelling_point (diagnostic_location (diagnostic)).line;
 
   if (!LINEMAP_SYSP (map))
     FOR_EACH_VEC_ELT (loc_vec, ix, iter)
       {
 	/* Sometimes, in the unwound macro expansion trace, we want to
@@ -250,11 +250,11 @@  maybe_unwind_expanded_macro_loc (diagnos
 void
 virt_loc_aware_diagnostic_finalizer (diagnostic_context *context,
 				     diagnostic_info *diagnostic)
 {
   maybe_unwind_expanded_macro_loc (context, diagnostic,
-				   diagnostic->location);
+				   diagnostic_location (diagnostic));
 }
 
 /* Default tree printer.   Handles declarations only.  */
 static bool
 default_tree_printer (pretty_printer *pp, text_info *text, const char *spec,
@@ -294,12 +294,12 @@  default_tree_printer (pretty_printer *pp
 
     default:
       return false;
     }
 
-  if (set_locus && text->locus)
-    *text->locus = DECL_SOURCE_LOCATION (t);
+  if (set_locus)
+    text->set_location (0) = DECL_SOURCE_LOCATION (t);
 
   if (DECL_P (t))
     {
       const char *n = DECL_NAME (t)
         ? identifier_to_locale (lang_hooks.decl_printable_name (t, 2))
Index: gcc/diagnostic.c
===================================================================
--- gcc/diagnostic.c	(revision 222903)
+++ gcc/diagnostic.c	(working copy)
@@ -144,11 +144,12 @@  diagnostic_initialize (diagnostic_contex
   context->classify_diagnostic = XNEWVEC (diagnostic_t, n_opts);
   for (i = 0; i < n_opts; i++)
     context->classify_diagnostic[i] = DK_UNSPECIFIED;
   context->show_caret = false;
   diagnostic_set_caret_max_width (context, pp_line_cutoff (context->printer));
-  context->caret_char = '^';
+  for (i = 0; i < MAX_LOCATIONS_PER_MESSAGE; i++)
+    context->caret_chars[i] = '^';
   context->show_option_requested = false;
   context->abort_on_error = false;
   context->show_column = false;
   context->pedantic_errors = false;
   context->permissive = false;
@@ -239,11 +240,13 @@  diagnostic_set_info_translated (diagnost
 				diagnostic_t kind)
 {
   diagnostic->message.err_no = errno;
   diagnostic->message.args_ptr = args;
   diagnostic->message.format_spec = msg;
-  diagnostic->location = location;
+  diagnostic->message.set_location (0) = location;
+  for (int i = 1; i < MAX_LOCATIONS_PER_MESSAGE; i++)
+    diagnostic->message.set_location (i) = UNKNOWN_LOCATION;
   diagnostic->override_column = 0;
   diagnostic->kind = kind;
   diagnostic->option_index = 0;
 }
 
@@ -307,18 +310,18 @@  diagnostic_build_prefix (diagnostic_cont
 }
 
 /* If LINE is longer than MAX_WIDTH, and COLUMN is not smaller than
    MAX_WIDTH by some margin, then adjust the start of the line such
    that the COLUMN is smaller than MAX_WIDTH minus the margin.  The
-   margin is either 10 characters or the difference between the column
-   and the length of the line, whatever is smaller.  The length of
-   LINE is given by LINE_WIDTH.  */
+   margin is either CARET_LINE_MARGIN characters or the difference 
+   between the column and the length of the line, whatever is smaller.
+   The length of LINE is given by LINE_WIDTH.  */
 static const char *
 adjust_line (const char *line, int line_width,
 	     int max_width, int *column_p)
 {
-  int right_margin = 10;
+  int right_margin = CARET_LINE_MARGIN;
   int column = *column_p;
 
   gcc_checking_assert (line_width >= column);
   right_margin = MIN (line_width - column, right_margin);
   right_margin = max_width - right_margin;
@@ -329,39 +332,72 @@  adjust_line (const char *line, int line_
     }
   return line;
 }
 
 /* Print the physical source line corresponding to the location of
-   this diagnostic, and a caret indicating the precise column.  */
+   this diagnostic, and a caret indicating the precise column.  This
+   function only prints two caret characters if the two locations
+   given by DIAGNOSTIC are on the same line according to
+   diagnostic_same_line().  */
 void
 diagnostic_show_locus (diagnostic_context * context,
 		       const diagnostic_info *diagnostic)
 {
-  const char *line;
-  int line_width;
-  char *buffer;
-  expanded_location s;
-  int max_width;
-  const char *saved_prefix;
-  const char *caret_cs, *caret_ce;
-
   if (!context->show_caret
-      || diagnostic->location <= BUILTINS_LOCATION
-      || diagnostic->location == context->last_location)
+      || diagnostic_location (diagnostic, 0) <= BUILTINS_LOCATION
+      || diagnostic_location (diagnostic, 0) == context->last_location)
     return;
 
-  context->last_location = diagnostic->location;
-  s = diagnostic_expand_location (diagnostic);
-  line = location_get_source_line (s, &line_width);
-  if (line == NULL || s.column > line_width)
+  context->last_location = diagnostic_location (diagnostic, 0);
+  expanded_location s0 = diagnostic_expand_location (diagnostic, 0);
+  expanded_location s1 = { }; 
+  /* Zero-initialized. This is checked later by diagnostic_print_caret_line.  */
+
+  if (diagnostic_location (diagnostic, 1) > BUILTINS_LOCATION)
+    s1 = diagnostic_expand_location (diagnostic, 1);
+
+  diagnostic_print_caret_line (context, s0, s1,
+			       context->caret_chars[0], context->caret_chars[1]);
+}
+
+/* Print (part) of the source line given by xloc1 with caret1 pointing
+   at the column.  If xloc2.column != 0 and it fits within the same
+   line as xloc1 according to diagnostic_same_line (), then caret2 is
+   printed at xloc2.colum.  Otherwise, the caller has to set up things
+   to print a second caret line for xloc2.  */
+void
+diagnostic_print_caret_line (diagnostic_context * context,
+			     expanded_location xloc1,
+			     expanded_location xloc2,
+			     char caret1, char caret2)
+{
+  if (!diagnostic_same_line (context, xloc1, xloc2))
+    /* This will mean ignore xloc2.  */
+    xloc2.column = 0;
+  else if (xloc1.column == xloc2.column)
+    xloc2.column++;
+  
+  int cmax = MAX (xloc1.column, xloc2.column);
+  int line_width;
+  const char *line = location_get_source_line (xloc1, &line_width);
+  if (line == NULL || cmax > line_width)
     return;
 
-  max_width = context->caret_max_width;
-  line = adjust_line (line, line_width, max_width, &(s.column));
+  /* Center the interesting part of the source line to fit in
+     max_width, and adjust all columns accordingly.  */
+  int max_width = context->caret_max_width;
+  int offset = (int) cmax;
+  line = adjust_line (line, line_width, max_width, &offset);
+  offset -= cmax;
+  cmax += offset;
+  xloc1.column += offset;
+  if (xloc2.column)
+    xloc2.column += offset;
 
+  /* Print the source line.  */
   pp_newline (context->printer);
-  saved_prefix = pp_get_prefix (context->printer);
+  const char *saved_prefix = pp_get_prefix (context->printer);
   pp_set_prefix (context->printer, NULL);
   pp_space (context->printer);
   while (max_width > 0 && line_width > 0)
     {
       char c = *line == '\t' ? ' ' : *line;
@@ -371,19 +407,32 @@  diagnostic_show_locus (diagnostic_contex
       max_width--;
       line_width--;
       line++;
     }
   pp_newline (context->printer);
+
+  /* Print the caret under the line.  */
+  const char *caret_cs, *caret_ce;
   caret_cs = colorize_start (pp_show_color (context->printer), "caret");
   caret_ce = colorize_stop (pp_show_color (context->printer));
+  int cmin = xloc2.column 
+    ? MIN (xloc1.column, xloc2.column) : xloc1.column;
+  int caret_min = cmin == xloc1.column ? caret1 : caret2;
+  int caret_max = cmin == xloc1.column ? caret2 : caret1;
+
+  pp_space (context->printer);
+  int i;
+  for (i = 0; i < cmin; i++)
+    pp_space (context->printer);
+  pp_printf (context->printer, "%s%c%s", caret_cs, caret_min, caret_ce);
 
-  /* 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, context->caret_char,
-	    caret_ce);
-  pp_string (context->printer, buffer);
+  if (xloc2.column)
+    {
+      for (i++; i < cmax; i++)
+	pp_space (context->printer);
+      pp_printf (context->printer, "%s%c%s", caret_cs, caret_max, caret_ce);
+    }
   pp_set_prefix (context->printer, saved_prefix);
   pp_needs_newline (context->printer) = true;
 }
 
 /* Functions at which to stop the backtrace print.  It's not
@@ -602,11 +651,11 @@  diagnostic_report_current_module (diagno
 
 void
 default_diagnostic_starter (diagnostic_context *context,
 			    diagnostic_info *diagnostic)
 {
-  diagnostic_report_current_module (context, diagnostic->location);
+  diagnostic_report_current_module (context, diagnostic_location (diagnostic));
   pp_set_prefix (context->printer, diagnostic_build_prefix (context,
 							    diagnostic));
 }
 
 void
@@ -714,11 +763,11 @@  diagnostic_pop_diagnostics (diagnostic_c
 
 bool
 diagnostic_report_diagnostic (diagnostic_context *context,
 			      diagnostic_info *diagnostic)
 {
-  location_t location = diagnostic->location;
+  location_t location = diagnostic_location (diagnostic);
   diagnostic_t orig_diag_kind = diagnostic->kind;
   const char *saved_format_spec;
 
   /* Give preference to being able to inhibit warnings, before they
      get reclassified to something else.  */
@@ -823,11 +872,12 @@  diagnostic_report_diagnostic (diagnostic
 	 abort_on_error.  */
       if ((diagnostic_kind_count (context, DK_ERROR) > 0
 	   || diagnostic_kind_count (context, DK_SORRY) > 0)
 	  && !context->abort_on_error)
 	{
-	  expanded_location s = expand_location (diagnostic->location);
+	  expanded_location s 
+	    = expand_location (diagnostic_location (diagnostic));
 	  fnotice (stderr, "%s:%d: confused by earlier errors, bailing out\n",
 		   s.file, s.line);
 	  exit (ICE_EXIT_CODE);
 	}
 #endif
@@ -857,11 +907,10 @@  diagnostic_report_diagnostic (diagnostic
 			"[", option_text, "]",
 			NULL));
 	  free (option_text);
 	}
     }
-  diagnostic->message.locus = &diagnostic->location;
   diagnostic->message.x_data = &diagnostic->x_data;
   diagnostic->x_data = NULL;
   pp_format (context->printer, &diagnostic->message);
   (*diagnostic_starter (context)) (context, diagnostic);
   pp_output_formatted_text (context->printer);
@@ -918,11 +967,10 @@  verbatim (const char *gmsgid, ...)
 
   va_start (ap, gmsgid);
   text.err_no = errno;
   text.args_ptr = &ap;
   text.format_spec = _(gmsgid);
-  text.locus = NULL;
   text.x_data = NULL;
   pp_format_verbatim (global_dc->printer, &text);
   pp_newline_and_flush (global_dc->printer);
   va_end (ap);
 }
Index: gcc/diagnostic.h
===================================================================
--- gcc/diagnostic.h	(revision 222903)
+++ gcc/diagnostic.h	(working copy)
@@ -27,12 +27,13 @@  along with GCC; see the file COPYING3.  
 /* A diagnostic is described by the MESSAGE to send, the FILE and LINE of
    its context and its KIND (ice, error, warning, note, ...)  See complete
    list in diagnostic.def.  */
 struct diagnostic_info
 {
+  /* Text to be formatted. It also contains the location(s) for this
+     diagnostic.  */
   text_info message;
-  location_t location;
   unsigned int override_column;
   /* Auxiliary data for client.  */
   void *x_data;
   /* The kind of diagnostic it is about.  */
   diagnostic_t kind;
@@ -103,12 +104,12 @@  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;
+  /* Characters used for caret diagnostics.  */
+  char caret_chars[MAX_LOCATIONS_PER_MESSAGE];
 
   /* True if we should print the command line option which controls
      each diagnostic, if known.  */
   bool show_option_requested;
 
@@ -298,22 +299,56 @@  void diagnostic_action_after_output (dia
 
 void diagnostic_file_cache_fini (void);
 
 int get_terminal_width (void);
 
-/* Expand the location of this diagnostic. Use this function for consistency. */
+/* Return the location associated to this diagnostic. WHICH specifies
+   which location. By default, expand the first one.  */
+
+static inline location_t
+diagnostic_location (const diagnostic_info * diagnostic, int which = 0)
+{
+  return diagnostic->message.get_location (which);
+}
+
+/* Expand the location of this diagnostic. Use this function for consistency.
+   WHICH specifies which location. By default, expand the first one.  */
 
 static inline expanded_location
-diagnostic_expand_location (const diagnostic_info * diagnostic)
+diagnostic_expand_location (const diagnostic_info * diagnostic, int which = 0)
 {
   expanded_location s
-    = expand_location_to_spelling_point (diagnostic->location);
-  if (diagnostic->override_column)
+    = expand_location_to_spelling_point (diagnostic_location (diagnostic,
+							      which));
+  if (which == 0 && diagnostic->override_column)
     s.column = diagnostic->override_column;
   return s;
 }
 
+/* This is somehow the right-side margin of a caret line, that is, we
+   print at least these many characters after the position pointed at
+   by the caret.  */
+#define CARET_LINE_MARGIN 10
+
+/* Return true if the two locations can be represented within the same
+   caret line.  This is used to build a prefix and also to determine
+   whether to print one or two caret lines.  */
+
+static inline bool
+diagnostic_same_line (const diagnostic_context *context,
+		       expanded_location s1, expanded_location s2)
+{
+  return s2.column && s1.line == s2.line 
+    && context->caret_max_width - CARET_LINE_MARGIN > abs (s1.column - s2.column);
+}
+
+void
+diagnostic_print_caret_line (diagnostic_context * context,
+			     expanded_location xloc1,
+			     expanded_location xloc2,
+			     char caret1, char caret2);
+
 /* Pure text formatting support functions.  */
 extern char *file_name_as_prefix (diagnostic_context *, const char *);
 
 extern char *build_message_string (const char *, ...) ATTRIBUTE_PRINTF_1;
 
Index: gcc/pretty-print.c
===================================================================
--- gcc/pretty-print.c	(revision 222903)
+++ gcc/pretty-print.c	(working copy)
@@ -851,11 +851,10 @@  pp_printf (pretty_printer *pp, const cha
 
   va_start (ap, msg);
   text.err_no = errno;
   text.args_ptr = &ap;
   text.format_spec = msg;
-  text.locus = NULL;
   pp_format (pp, &text);
   pp_output_formatted_text (pp);
   va_end (ap);
 }
 
@@ -869,11 +868,10 @@  pp_verbatim (pretty_printer *pp, const c
 
   va_start (ap, msg);
   text.err_no = errno;
   text.args_ptr = &ap;
   text.format_spec = msg;
-  text.locus = NULL;
   pp_format_verbatim (pp, &text);
   va_end (ap);
 }
 
 
Index: gcc/pretty-print.h
===================================================================
--- gcc/pretty-print.h	(revision 222903)
+++ gcc/pretty-print.h	(working copy)
@@ -26,19 +26,39 @@  along with GCC; see the file COPYING3.  
 #include "wide-int-print.h"
 
 /* Maximum number of format string arguments.  */
 #define PP_NL_ARGMAX   30
 
+/* Maximum number of locations associated to each message.  If
+   location 'i' is UNKNOWN_LOCATION, then location 'i+1' is not
+   valid.  */
+#define MAX_LOCATIONS_PER_MESSAGE 2
+
 /* The type of a text to be formatted according a format specification
    along with a list of things.  */
 struct text_info
 {
+public:
   const char *format_spec;
   va_list *args_ptr;
   int err_no;  /* for %m */
-  location_t *locus;
   void **x_data;
+
+  inline location_t & set_location (unsigned int index_of_location)
+  {
+    gcc_checking_assert (index_of_location < MAX_LOCATIONS_PER_MESSAGE);
+    return this->locations[index_of_location];
+  }
+
+  inline location_t get_location (unsigned int index_of_location) const
+  {
+    gcc_checking_assert (index_of_location < MAX_LOCATIONS_PER_MESSAGE);
+    return this->locations[index_of_location];
+  }
+
+private:
+  location_t locations[MAX_LOCATIONS_PER_MESSAGE];
 };
 
 /* How often diagnostics are prefixed by their locations:
    o DIAGNOSTICS_SHOW_PREFIX_NEVER: never - not yet supported;
    o DIAGNOSTICS_SHOW_PREFIX_ONCE: emit only once;
Index: gcc/testsuite/lib/gfortran-dg.exp
===================================================================
--- gcc/testsuite/lib/gfortran-dg.exp	(revision 222903)
+++ gcc/testsuite/lib/gfortran-dg.exp	(working copy)
@@ -49,10 +49,13 @@  proc gfortran-dg-test { prog do_what ext
     #              1       2
     #     Error: Some error at (1) and (2)
     #
     # or
     #     [name]:[locus]: Error: Some error
+    # or
+    #     [name]:[locus]: Error: (1)
+    #     [name]:[locus2]: Error: Some error at (1) and (2)
     #
     # Where [locus] is either [line] or [line].[column] or
     # [line].[column]-[column] .
     #
     # We collapse these to look like:
@@ -78,18 +81,23 @@  proc gfortran-dg-test { prog do_what ext
     # 2. We deal with the form with two different locus lines,
     set two_loci "(^|\n)$locus_regexp$locus_regexp$diag_regexp"
     regsub -all $two_loci $comp_output "\\1\\2:\\3: \\8\n\\5\:\\6: \\8\n" comp_output
     verbose "comput_output1:\n$comp_output"
 
+    set locus_prefix "(\[^:\n\]+:\[0-9\]+:\[0-9\]+: )(Warning: |Error: )"
+    set two_loci2 "(^|\n)$locus_prefix\\(1\\)\n$locus_prefix$diag_regexp"
+    regsub -all $two_loci2 $comp_output "\\1\\2\\3\\6\n\\4\\5\\6\n" comp_output
+    verbose "comput_output2:\n$comp_output"
+
     # 3. then with the form with only one locus line.
     set single_locus "(^|\n)$locus_regexp$diag_regexp"
     regsub -all $single_locus $comp_output "\\1\\2:\\3: \\5\n" comp_output
-    verbose "comput_output2:\n$comp_output"
+    verbose "comput_output3:\n$comp_output"
 
     # 4. Add a line number if none exists
     regsub -all "(^|\n)(Warning: |Error: )" $comp_output "\\1:0:0: \\2" comp_output
-    verbose "comput_output3:\n$comp_output"
+    verbose "comput_output4:\n$comp_output"
     return [list $comp_output $output_file]
 }
 
 proc gfortran-dg-prune { system text } {
     return [gcc-dg-prune $system $text]
Index: gcc/testsuite/gfortran.dg/badline.f
===================================================================
--- gcc/testsuite/gfortran.dg/badline.f	(revision 222903)
+++ gcc/testsuite/gfortran.dg/badline.f	(working copy)
@@ -1,4 +1,8 @@ 
         subroutine foo 
+# illegal
 # 18 "src/badline.F" 2
+# illegal
         end
-! { dg-warning "left but not entered" "" { target *-*-* } 2 }
+! { dg-warning "Illegal" "" { target *-*-* } 2 }
+! { dg-warning "left but not entered" "" { target *-*-* } 3 }
+! { dg-warning "Illegal" "" { target *-*-* } 4 }
Index: gcc/cp/error.c
===================================================================
--- gcc/cp/error.c	(revision 222903)
+++ gcc/cp/error.c	(working copy)
@@ -3102,11 +3102,11 @@  cxx_print_error_function (diagnostic_con
 
 static void
 cp_diagnostic_starter (diagnostic_context *context,
 		       diagnostic_info *diagnostic)
 {
-  diagnostic_report_current_module (context, diagnostic->location);
+  diagnostic_report_current_module (context, diagnostic_location (diagnostic));
   cp_print_error_function (context, diagnostic);
   maybe_print_instantiation_context (context);
   maybe_print_constexpr_context (context);
   pp_set_prefix (context->printer, diagnostic_build_prefix (context,
 								 diagnostic));
@@ -3123,11 +3123,11 @@  cp_print_error_function (diagnostic_cont
   if (current_instantiation ())
     return;
   if (diagnostic_last_function_changed (context, diagnostic))
     {
       const char *old_prefix = context->printer->prefix;
-      const char *file = LOCATION_FILE (diagnostic->location);
+      const char *file = LOCATION_FILE (diagnostic_location (diagnostic));
       tree abstract_origin = diagnostic_abstract_origin (diagnostic);
       char *new_prefix = (file && abstract_origin == NULL)
 			 ? file_name_as_prefix (context, file) : NULL;
 
       pp_set_prefix (context->printer, new_prefix);
@@ -3469,13 +3469,10 @@  cp_printer (pretty_printer *pp, text_inf
 #define next_int     va_arg (*text->args_ptr, int)
 
   if (precision != 0 || wide)
     return false;
 
-  if (text->locus == NULL)
-    set_locus = false;
-
   switch (*spec)
     {
     case 'A': result = args_to_string (next_tree, verbose);	break;
     case 'C': result = code_to_string (next_tcode);		break;
     case 'D':
@@ -3513,11 +3510,11 @@  cp_printer (pretty_printer *pp, text_inf
       return false;
     }
 
   pp_string (pp, result);
   if (set_locus && t != NULL)
-    *text->locus = location_of (t);
+    text->set_location (0) = location_of (t);
   return true;
 #undef next_tree
 #undef next_tcode
 #undef next_lang
 #undef next_int
Index: gcc/fortran/decl.c
===================================================================
--- gcc/fortran/decl.c	(revision 222903)
+++ gcc/fortran/decl.c	(working copy)
@@ -1124,11 +1124,11 @@  gfc_verify_c_interop_param (gfc_symbol *
 
           /* Make sure that if it has the dimension attribute, that it is
 	     either assumed size or explicit shape. Deferred shape is already
 	     covered by the pointer/allocatable attribute.  */
 	  if (sym->as != NULL && sym->as->type == AS_ASSUMED_SHAPE
-	      && !gfc_notify_std_1 (GFC_STD_F2008_TS, "Assumed-shape array '%s' "
+	      && !gfc_notify_std (GFC_STD_F2008_TS, "Assumed-shape array %qs "
 				  "at %L as dummy argument to the BIND(C) "
 				  "procedure '%s' at %L", sym->name, 
 				  &(sym->declared_at), 
 				  sym->ns->proc_name->name, 
 				  &(sym->ns->proc_name->declared_at)))
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h	(revision 222903)
+++ gcc/fortran/gfortran.h	(working copy)
@@ -2656,14 +2656,14 @@  void gfc_diagnostics_init (void);
 void gfc_diagnostics_finish (void);
 void gfc_buffer_error (bool);
 
 const char *gfc_print_wide_char (gfc_char_t);
 
-void gfc_warning_1 (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
 bool gfc_warning (int opt, const char *, ...) ATTRIBUTE_GCC_GFC(2,3);
-void gfc_warning_now_1 (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
 bool gfc_warning_now (int opt, const char *, ...) ATTRIBUTE_GCC_GFC(2,3);
+bool gfc_warning_now_at (location_t loc, int opt, const char *gmsgid, ...)
+  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);
@@ -2675,11 +2675,10 @@  void gfc_internal_error (const char *, .
 void gfc_clear_error (void);
 bool gfc_error_check (void);
 bool gfc_error_flag_test (void);
 
 notification gfc_notification_std (int);
-bool gfc_notify_std_1 (int, const char *, ...) ATTRIBUTE_GCC_GFC(2,3);
 bool gfc_notify_std (int, const char *, ...) ATTRIBUTE_GCC_GFC(2,3);
 
 /* A general purpose syntax error.  */
 #define gfc_syntax_error(ST)	\
   gfc_error ("Syntax error in %s statement at %C", gfc_ascii_statement (ST));
Index: gcc/fortran/error.c
===================================================================
--- gcc/fortran/error.c	(revision 222903)
+++ gcc/fortran/error.c	(working copy)
@@ -805,41 +805,10 @@  gfc_clear_pp_buffer (output_buffer *this
   pp_clear_output_area (pp);
   pp->buffer = tmp_buffer;
 }
 
 
-/* Issue a warning.  */
-/* Use gfc_warning instead, unless two locations are used in the same
-   warning or for scanner.c, if the location is not properly set up.  */
-
-void
-gfc_warning_1 (const char *gmsgid, ...)
-{
-  va_list argp;
-
-  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();
-  }
-}
-
-
 /* This is just a helper function to avoid duplicating the logic of
    gfc_warning.  */
 
 static bool
 gfc_warning (int opt, const char *gmsgid, va_list ap)
@@ -887,13 +856,10 @@  gfc_warning (int opt, const char *gmsgid
   va_end (argp);
   return ret;
 }
 
 /* Issue a warning.  */
-/* 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_warning_1.   */
 
 bool
 gfc_warning (int opt, const char *gmsgid, ...)
 {
   va_list argp;
@@ -925,88 +891,10 @@  gfc_notification_std (int std)
    feature.  An error/warning will be issued if the currently selected
    standard does not contain the requested bits.  Return false if
    an error is generated.  */
 
 bool
-gfc_notify_std_1 (int std, const char *gmsgid, ...)
-{
-  va_list argp;
-  bool warning;
-  const char *msg1, *msg2;
-  char *buffer;
-
-  warning = ((gfc_option.warn_std & std) != 0) && !inhibit_warnings;
-  if ((gfc_option.allow_std & std) != 0 && !warning)
-    return true;
-
-  if (suppress_errors)
-    return warning ? true : false;
-
-  cur_error_buffer = warning ? &warning_buffer : &error_buffer;
-  cur_error_buffer->flag = 1;
-  cur_error_buffer->index = 0;
-
-  if (warning)
-    msg1 = _("Warning:");
-  else
-    msg1 = _("Error:");
-  
-  switch (std)
-  {
-    case GFC_STD_F2008_TS:
-      msg2 = "TS 29113/TS 18508:";
-      break;
-    case GFC_STD_F2008_OBS:
-      msg2 = _("Fortran 2008 obsolescent feature:");
-      break;
-    case GFC_STD_F2008:
-      msg2 = "Fortran 2008:";
-      break;
-    case GFC_STD_F2003:
-      msg2 = "Fortran 2003:";
-      break;
-    case GFC_STD_GNU:
-      msg2 = _("GNU Extension:");
-      break;
-    case GFC_STD_LEGACY:
-      msg2 = _("Legacy Extension:");
-      break;
-    case GFC_STD_F95_OBS:
-      msg2 = _("Obsolescent feature:");
-      break;
-    case GFC_STD_F95_DEL:
-      msg2 = _("Deleted feature:");
-      break;
-    default:
-      gcc_unreachable ();
-  }
-
-  buffer = (char *) alloca (strlen (msg1) + strlen (msg2) + 2);
-  strcpy (buffer, msg1);
-  strcat (buffer, " ");
-  strcat (buffer, msg2);
-
-  va_start (argp, gmsgid);
-  error_print (buffer, _(gmsgid), argp);
-  va_end (argp);
-
-  error_char ('\0');
-
-  if (!buffered_p)
-    {
-      if (warning && !warnings_are_errors)
-	warnings++;
-      else
-	gfc_increment_error_count();
-      cur_error_buffer->flag = 0;
-    }
-
-  return (warning && !warnings_are_errors) ? true : false;
-}
-
-
-bool
 gfc_notify_std (int std, const char *gmsgid, ...)
 {
   va_list argp;
   bool warning;
   const char *msg, *msg2;
@@ -1064,39 +952,10 @@  gfc_notify_std (int std, const char *gms
 
   return (warning && !warnings_are_errors) ? true : false;
 }
 
 
-/* Immediate warning (i.e. do not buffer the warning).  */
-/* Use gfc_warning_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_warning_now_1 (const char *gmsgid, ...)
-{
-  va_list argp;
-  bool buffered_p_saved;
-
-  if (inhibit_warnings)
-    return;
-
-  buffered_p_saved = buffered_p;
-  buffered_p = false;
-  warnings++;
-
-  va_start (argp, gmsgid);
-  error_print (_("Warning:"), _(gmsgid), argp);
-  va_end (argp);
-
-  error_char ('\0');
-
-  if (warnings_are_errors)
-    gfc_increment_error_count();
-
-  buffered_p = buffered_p_saved;
-}
-
 /* Called from output_format -- during diagnostic message processing
    to handle Fortran specific format specifiers with the following meanings:
 
    %C  Current locus (no argument)
    %L  Takes locus argument
@@ -1110,37 +969,38 @@  gfc_format_decoder (pretty_printer *pp,
   switch (*spec)
     {
     case 'C':
     case 'L':
       {
-	static const char *result = "(1)";
+	static const char *result[2] = { "(1)", "(2)" };
 	locus *loc;
 	if (*spec == 'C')
 	  loc = &gfc_current_locus;
 	else
 	  loc = va_arg (*text->args_ptr, locus *);
 	gcc_assert (loc->nextc - loc->lb->line >= 0);
 	unsigned int offset = loc->nextc - loc->lb->line;
-	gcc_assert (text->locus);
-	*text->locus
+	/* If location[0] != UNKNOWN_LOCATION means that we already
+	   processed one of %C/%L.  */
+	int loc_num = text->get_location (0) == UNKNOWN_LOCATION ? 0 : 1;
+	text->set_location (loc_num)
 	  = linemap_position_for_loc_and_offset (line_table,
 						 loc->lb->location,
 						 offset);
-	global_dc->caret_char = '1';
-	pp_string (pp, result);
+	pp_string (pp, result[loc_num]);
 	return true;
       }
     default:
       return false;
     }
 }
 
-/* Return a malloc'd string describing a location.  The caller is
-   responsible for freeing the memory.  */
+/* Return a malloc'd string describing the kind of diagnostic.  The
+   caller is responsible for freeing the memory.  */
 static char *
-gfc_diagnostic_build_prefix (diagnostic_context *context,
-			     const diagnostic_info *diagnostic)
+gfc_diagnostic_build_kind_prefix (diagnostic_context *context,
+				  const diagnostic_info *diagnostic)
 {
   static const char *const diagnostic_kind_text[] = {
 #define DEFINE_DIAGNOSTIC_KIND(K, T, C) (T),
 #include "gfc-diagnostic.def"
 #undef DEFINE_DIAGNOSTIC_KIND
@@ -1168,69 +1028,208 @@  gfc_diagnostic_build_prefix (diagnostic_
 
 /* 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)
+				   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));
-  expanded_location s = diagnostic_expand_location (diagnostic);
   return (s.file == NULL
 	  ? build_message_string ("%s%s:%s", locus_cs, progname, locus_ce )
 	  : !strcmp (s.file, N_("<built-in>"))
 	  ? build_message_string ("%s%s:%s", locus_cs, s.file, locus_ce)
 	  : context->show_column
 	  ? 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
+/* Return a malloc'd string describing two locations.  The caller is
+   responsible for freeing the memory.  */
+static char *
+gfc_diagnostic_build_locus_prefix (diagnostic_context *context,
+				   expanded_location s, expanded_location s2)
+{
+  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));
+
+  return (s.file == NULL
+	  ? build_message_string ("%s%s:%s", locus_cs, progname, locus_ce )
+	  : !strcmp (s.file, N_("<built-in>"))
+	  ? build_message_string ("%s%s:%s", locus_cs, s.file, locus_ce)
+	  : context->show_column
+	  ? build_message_string ("%s%s:%d:%d-%d:%s", locus_cs, s.file, s.line,
+				  MIN (s.column, s2.column),
+				  MAX (s.column, s2.column), locus_ce)
+	  : build_message_string ("%s%s:%d:%s", locus_cs, s.file, s.line,
+				  locus_ce));
+}
+
+/* This function prints the locus (file:line:column), the diagnostic kind
+   (Error, Warning) and (optionally) the caret line (a source line
+   with '1' and/or '2' below it).
+
+   With -fdiagnostic-show-caret (the default) and for valid locations,
+   it prints for one location:
+
+       [locus]:
+       
+          some code
+                 1
+       Error: Some error at (1)
+        
+   for two locations that fit in the same locus line:
+
+       [locus]:
+       
+         some code and some more code
+                1       2
+       Error: Some error at (1) and (2)
+
+   and for two locations that do not fit in the same locus line:
+
+       [locus]:
+       
+         some code
+                1
+       [locus2]:
+       
+         some other code
+           2
+       Error: Some error at (1) and (2)
+       
+  With -fno-diagnostic-show-caret or if one of the locations is not
+  valid, it prints for one location (or for two locations that fit in
+  the same locus line):
+
+       [locus]: Error: Some error at (1) and (2)
+
+   and for two locations that do not fit in the same locus line:
+
+       [name]:[locus]: Error: (1)
+       [name]:[locus2]: Error: Some error at (1) and (2)
+*/
+static void 
 gfc_diagnostic_starter (diagnostic_context *context,
 			diagnostic_info *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))
+  char * kind_prefix = gfc_diagnostic_build_kind_prefix (context, diagnostic);
+
+  expanded_location s1 = diagnostic_expand_location (diagnostic);
+  expanded_location s2;
+  bool one_locus = diagnostic_location (diagnostic, 1) == UNKNOWN_LOCATION;
+  bool same_locus = false;
+
+  if (!one_locus) 
     {
+      s2 = diagnostic_expand_location (diagnostic, 1);
+      same_locus = diagnostic_same_line (context, s1, s2);
+    }
+
+  char * locus_prefix = (one_locus || !same_locus)
+    ? gfc_diagnostic_build_locus_prefix (context, s1)
+    : gfc_diagnostic_build_locus_prefix (context, s1, s2);
+
+  if (!context->show_caret
+      || diagnostic_location (diagnostic, 0) <= BUILTINS_LOCATION
+      || diagnostic_location (diagnostic, 0) == context->last_location)
+    {
+      pp_set_prefix (context->printer,
+		     concat (locus_prefix, " ", kind_prefix, NULL));
+      free (locus_prefix);
+
+      if (one_locus || same_locus)
+	{
+	  free (kind_prefix);
+	  return;
+	}
+      /* In this case, we print the previous locus and prefix as:
+
+	  [locus]:[prefix]: (1)
+
+	 and we flush with a new line before setting the new prefix.  */
+      pp_string (context->printer, "(1)");
       pp_newline (context->printer);
-      /* If the caret line was shown, the prefix does not contain the
-	 locus.  */
-      pp_set_prefix (context->printer, prefix);
+      locus_prefix = gfc_diagnostic_build_locus_prefix (context, s2);
+      pp_set_prefix (context->printer,
+		     concat (locus_prefix, " ", kind_prefix, NULL));
+      free (kind_prefix);
+      free (locus_prefix);
     }
-  else 
+  else
     {
-      /* Otherwise, start again.  */
-      pp_clear_output_area(context->printer);
-      pp_set_prefix (context->printer, concat (locus_prefix, " ", prefix, NULL));
-      free (prefix);
+      pp_verbatim (context->printer, locus_prefix);
+      free (locus_prefix);
+      /* Fortran uses an empty line between locus and caret line.  */
+      pp_newline (context->printer);
+      diagnostic_show_locus (context, diagnostic);
+      pp_newline (context->printer);
+      /* If the caret line was shown, the prefix does not contain the
+	 locus.  */
+      pp_set_prefix (context->printer, kind_prefix);
+
+      if (one_locus || same_locus)
+	  return;
+
+      locus_prefix = gfc_diagnostic_build_locus_prefix (context, s2);
+      if (diagnostic_location (diagnostic, 1) <= BUILTINS_LOCATION)
+	{
+	  /* No caret line for the second location. Override the previous
+	     prefix with [locus2]:[prefix].  */
+	  pp_set_prefix (context->printer,
+			 concat (locus_prefix, " ", kind_prefix, NULL));
+	  free (kind_prefix);
+	  free (locus_prefix);
+	}
+      else
+	{
+	  /* We print the caret for the second location.  */
+	  pp_verbatim (context->printer, locus_prefix);
+	  free (locus_prefix);
+	  /* Fortran uses an empty line between locus and caret line.  */
+	  pp_newline (context->printer);
+	  s1.column = 0; /* Print only a caret line for s2.  */
+	  diagnostic_print_caret_line (context, s2, s1,
+				       context->caret_chars[1], '\0');
+	  pp_newline (context->printer);
+	  /* If the caret line was shown, the prefix does not contain the
+	     locus.  */
+	  pp_set_prefix (context->printer, kind_prefix);
+	}
     }
-  free (locus_prefix);
 }
 
 static void
 gfc_diagnostic_finalizer (diagnostic_context *context,
 			  diagnostic_info *diagnostic ATTRIBUTE_UNUSED)
 {
   pp_destroy_prefix (context->printer);
   pp_newline_and_flush (context->printer);
 }
 
+/* Immediate warning (i.e. do not buffer the warning) with an explicit
+   location.  */
+
+bool
+gfc_warning_now_at (location_t loc, int opt, const char *gmsgid, ...)
+{
+  va_list argp;
+  diagnostic_info diagnostic;
+  bool ret;
+
+  va_start (argp, gmsgid);
+  diagnostic_set_info (&diagnostic, gmsgid, &argp, loc, DK_WARNING);
+  diagnostic.option_index = opt;
+  ret = report_diagnostic (&diagnostic);
+  va_end (argp);
+  return ret;
+}
+
 /* Immediate warning (i.e. do not buffer the warning).  */
-/* 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_warning_now_1.   */
 
 bool
 gfc_warning_now (int opt, const char *gmsgid, ...)
 {
   va_list argp;
@@ -1637,11 +1636,12 @@  void
 gfc_diagnostics_init (void)
 {
   diagnostic_starter (global_dc) = gfc_diagnostic_starter;
   diagnostic_finalizer (global_dc) = gfc_diagnostic_finalizer;
   diagnostic_format_decoder (global_dc) = gfc_format_decoder;
-  global_dc->caret_char = '^';
+  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->flush_p = false;
 }
@@ -1652,7 +1652,8 @@  gfc_diagnostics_finish (void)
   tree_diagnostics_defaults (global_dc);
   /* We still want to use the gfc starter and finalizer, not the tree
      defaults.  */
   diagnostic_starter (global_dc) = gfc_diagnostic_starter;
   diagnostic_finalizer (global_dc) = gfc_diagnostic_finalizer;
-  global_dc->caret_char = '^';
+  global_dc->caret_chars[0] = '^';
+  global_dc->caret_chars[1] = '^';
 }
Index: gcc/fortran/scanner.c
===================================================================
--- gcc/fortran/scanner.c	(revision 222903)
+++ gcc/fortran/scanner.c	(working copy)
@@ -2012,13 +2012,17 @@  preprocessor_line (gfc_char_t *c)
   if (flag[2]) /* Ending current file.  */
     {
       if (!current_file->up
 	  || filename_cmp (current_file->up->filename, filename) != 0)
 	{
-	  gfc_warning_now_1 ("%s:%d: file %s left but not entered",
-			     current_file->filename, current_file->line,
-			     filename);
+	  linemap_line_start (line_table, current_file->line, 80);
+	  /* ??? One could compute the exact column where the filename
+	     starts and compute the exact location here.  */
+	  gfc_warning_now_at (linemap_position_for_column (line_table, 1),
+			      0, "file %qs left but not entered",
+			      filename);
+	  current_file->line++;
 	  if (unescape)
 	    free (wide_filename);
 	  free (filename);
 	  return;
 	}
@@ -2046,12 +2050,15 @@  preprocessor_line (gfc_char_t *c)
     free (wide_filename);
   free (filename);
   return;
 
  bad_cpp_line:
-  gfc_warning_now_1 ("%s:%d: Illegal preprocessor directive",
-		   current_file->filename, current_file->line);
+  linemap_line_start (line_table, current_file->line, 80);
+  /* ??? One could compute the exact column where the directive
+     starts and compute the exact location here.  */
+  gfc_warning_now_at (linemap_position_for_column (line_table, 2), 0,
+		      "Illegal preprocessor directive");
   current_file->line++;
 }
 
 
 static bool load_file (const char *, const char *, bool);
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(revision 222903)
+++ gcc/fortran/resolve.c	(working copy)
@@ -8777,11 +8777,11 @@  resolve_branch (gfc_st_label *label, gfc
     }
 
   /* The label is not in an enclosing block, so illegal.  This was
      allowed in Fortran 66, so we allow it as extension.  No
      further checks are necessary in this case.  */
-  gfc_notify_std_1 (GFC_STD_LEGACY, "Label at %L is not in the same block "
+  gfc_notify_std (GFC_STD_LEGACY, "Label at %L is not in the same block "
 		  "as the GOTO statement at %L", &label->where,
 		  &code->loc);
   return;
 }
 
@@ -12918,12 +12918,12 @@  resolve_fl_derived (gfc_symbol *sym)
   if (!sym->attr.is_class)
     gfc_find_symbol (sym->name, sym->ns, 0, &gen_dt);
   if (gen_dt && gen_dt->generic && gen_dt->generic->next
       && (!gen_dt->generic->sym->attr.use_assoc
 	  || gen_dt->generic->sym->module != gen_dt->generic->next->sym->module)
-      && !gfc_notify_std_1 (GFC_STD_F2003, "Generic name '%s' of function "
-			  "'%s' at %L being the same name as derived "
+      && !gfc_notify_std (GFC_STD_F2003, "Generic name %qs of function "
+			  "%qs at %L being the same name as derived "
 			  "type at %L", sym->name,
 			  gen_dt->generic->sym == sym
 			  ? gen_dt->generic->next->sym->name
 			  : gen_dt->generic->sym->name,
 			  gen_dt->generic->sym == sym
Index: gcc/fortran/dependency.c
===================================================================
--- gcc/fortran/dependency.c	(revision 222903)
+++ gcc/fortran/dependency.c	(working copy)
@@ -954,11 +954,11 @@  gfc_check_argument_var_dependency (gfc_e
 		  /* We are told not to check dependencies.
 		     We do it, however, and issue a warning in case we find one.
 		     If a dependency is found in the case
 		     elemental == ELEM_CHECK_VARIABLE, we will generate
 		     a temporary, so we don't need to bother the user.  */
-		  gfc_warning_1 ("INTENT(%s) actual argument at %L might "
+		  gfc_warning (0, "INTENT(%s) actual argument at %L might "
 			       "interfere with actual argument at %L.",
 		   	       intent == INTENT_OUT ? "OUT" : "INOUT",
 		   	       &var->where, &expr->where);
 		}
 	      return 0;