diff mbox

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

Message ID CAESRpQA7jAeZWuAen36bX2kHoag3RgngUwFTAa+Q+tfHB+oFhg@mail.gmail.com
State New
Headers show

Commit Message

Manuel López-Ibáñez April 20, 2015, 8 p.m. UTC 
The Fortran FE allows diagnostics with two different locations.
Depending on whether these locations are on the same line or not, this
may produce one or two caret lines. This is the last remaining issue
left to make Fortran diagnostics use the common code.

In the common diagnostics:

I added support for this in the common diagnostics, although Fortran
is the only user for now. The new common code should be flexible
enough to support the Clang style (which I guess is likely to be what
C/C++ FEs end up supporting sooner or later) while still supporting
the Fortran style.

Supporting this in the common diagnostics code requires having two
locations in struct diagnostic_info and two pointers in struct
text_info. That seems a waste and overtly complex. Thus, I moved the
new location array directly to struct text_info and added an accessor
function diagnostic_location().

In addition, this patch factors out the logic to determine whether two
locations should be shown in the same caret/locus line and the ability
to just print a caret line in diagnostic_print_caret_line(). These
functions are used by the common code and the Fortran FE.

In the Fortran FE:

These changes allow me to convert all Fortran FE diagnostic functions
to use the common code. For simplicity, this patch just converts
gfc_warning and gfc_notify_std. A follow-up Fortran-only patch will
convert gfc_error and remove a lot of unused code.

While checking that the new code was working correctly, I noticed that
the locations (as tracked by line-map) before and after the warning
given in badline.f were wrong. I fixed this and added two tests to
check that they are right from now on.

In addition, I added a new function gfc_warning_at to pass an explicit
location. I think this is better than having another %-code in
gfc_format_decoder. As you can see in that function, we are now doing
a lot of work just to print (1) and (2), when the location_t could
simply be passed explicitly to the diagnostic functions and replace
all %L and %C with explicit (1) and (2) in the calls. This will remove
completely gfc_format_decoder. But I'll leave that to Fortran devs if
they are interested in going that route.

I had to decide what to print for -fno-diagnostics-show-caret and
multiple locations. It has to be something that can be distinguished
from a duplicate diagnostic, such that the testsuite can parse it as
such. I chose to print:

file1:line1:col1: Error: (1)
file2:line2:col2: Error: message that mentions (1) and (2)

I could print something else if it pleases you, but the above should
only be seen if someone uses -fno-diagnostics-show-caret explicitly.

Bootstrapped and regression tested on x86_64-linux-gnu.

OK?


gcc/fortran/ChangeLog:

2015-04-19  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_char array.
    (gfc_diagnostics_finish): Reset caret_char array to default.


gcc/cp/ChangeLog:

2015-04-19  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 location array.

gcc/c/ChangeLog:

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

    * c-objc-common.c (c_tree_printer): Replace locus pointer with
    location array.

gcc/ChangeLog:

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

    * tree-pretty-print.c (percent_K_format): Replace locus pointer
    with location array.
    * 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 location array.
    * diagnostic.c (diagnostic_initialize): Initialize caret_char array.
    (diagnostic_set_info_translated): Initialize second location.
    (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_char an array of two.
    (diagnostic_location): New inline.
    (diagnostic_expand_location): Handle two locations.
    (diagnostic_same_locus): New inline.
    (diagnostic_print_caret_line): Declare.
    * pretty-print.c (pp_printf): Do not set text.locus.
    (pp_verbatim): Do not set text.locus.
    * pretty-print.h (struct text_info): Replace locus pointer with
    location array.

gcc/testsuite/ChangeLog:

2015-04-19  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

Manuel López-Ibáñez May 3, 2015, 10:30 p.m. UTC | #1 
Ping: https://gcc.gnu.org/ml/gcc-patches/2015-04/msg01093.html

On 20 April 2015 at 22:00, Manuel López-Ibáñez <lopezibanez@gmail.com> wrote:
> The Fortran FE allows diagnostics with two different locations.
> Depending on whether these locations are on the same line or not, this
> may produce one or two caret lines. This is the last remaining issue
> left to make Fortran diagnostics use the common code.
>
> In the common diagnostics:
>
> I added support for this in the common diagnostics, although Fortran
> is the only user for now. The new common code should be flexible
> enough to support the Clang style (which I guess is likely to be what
> C/C++ FEs end up supporting sooner or later) while still supporting
> the Fortran style.
>
> Supporting this in the common diagnostics code requires having two
> locations in struct diagnostic_info and two pointers in struct
> text_info. That seems a waste and overtly complex. Thus, I moved the
> new location array directly to struct text_info and added an accessor
> function diagnostic_location().
>
> In addition, this patch factors out the logic to determine whether two
> locations should be shown in the same caret/locus line and the ability
> to just print a caret line in diagnostic_print_caret_line(). These
> functions are used by the common code and the Fortran FE.
>
> In the Fortran FE:
>
> These changes allow me to convert all Fortran FE diagnostic functions
> to use the common code. For simplicity, this patch just converts
> gfc_warning and gfc_notify_std. A follow-up Fortran-only patch will
> convert gfc_error and remove a lot of unused code.
>
> While checking that the new code was working correctly, I noticed that
> the locations (as tracked by line-map) before and after the warning
> given in badline.f were wrong. I fixed this and added two tests to
> check that they are right from now on.
>
> In addition, I added a new function gfc_warning_at to pass an explicit
> location. I think this is better than having another %-code in
> gfc_format_decoder. As you can see in that function, we are now doing
> a lot of work just to print (1) and (2), when the location_t could
> simply be passed explicitly to the diagnostic functions and replace
> all %L and %C with explicit (1) and (2) in the calls. This will remove
> completely gfc_format_decoder. But I'll leave that to Fortran devs if
> they are interested in going that route.
>
> I had to decide what to print for -fno-diagnostics-show-caret and
> multiple locations. It has to be something that can be distinguished
> from a duplicate diagnostic, such that the testsuite can parse it as
> such. I chose to print:
>
> file1:line1:col1: Error: (1)
> file2:line2:col2: Error: message that mentions (1) and (2)
>
> I could print something else if it pleases you, but the above should
> only be seen if someone uses -fno-diagnostics-show-caret explicitly.
>
> Bootstrapped and regression tested on x86_64-linux-gnu.
>
> OK?
>
>
> gcc/fortran/ChangeLog:
>
> 2015-04-19  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_char array.
>     (gfc_diagnostics_finish): Reset caret_char array to default.
>
>
> gcc/cp/ChangeLog:
>
> 2015-04-19  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 location array.
>
> gcc/c/ChangeLog:
>
> 2015-04-19  Manuel López-Ibáñez  <manu@gcc.gnu.org>
>
>     * c-objc-common.c (c_tree_printer): Replace locus pointer with
>     location array.
>
> gcc/ChangeLog:
>
> 2015-04-19  Manuel López-Ibáñez  <manu@gcc.gnu.org>
>
>     * tree-pretty-print.c (percent_K_format): Replace locus pointer
>     with location array.
>     * 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 location array.
>     * diagnostic.c (diagnostic_initialize): Initialize caret_char array.
>     (diagnostic_set_info_translated): Initialize second location.
>     (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_char an array of two.
>     (diagnostic_location): New inline.
>     (diagnostic_expand_location): Handle two locations.
>     (diagnostic_same_locus): New inline.
>     (diagnostic_print_caret_line): Declare.
>     * pretty-print.c (pp_printf): Do not set text.locus.
>     (pp_verbatim): Do not set text.locus.
>     * pretty-print.h (struct text_info): Replace locus pointer with
>     location array.
>
> gcc/testsuite/ChangeLog:
>
> 2015-04-19  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.
Dodji Seketeli May 7, 2015, 8:16 p.m. UTC | #2 
Hello Manuel,

Sorry for my late reply, and thank you very much for working on this.

I have looked at the patch and I like it!

I guess I just have some few lateral nits to pick.

> The Fortran FE allows diagnostics with two different locations.
> Depending on whether these locations are on the same line or not, this
> may produce one or two caret lines. This is the last remaining issue
> left to make Fortran diagnostics use the common code.

Yes, I remember.

[...]

> I added support for this in the common diagnostics, although Fortran
> is the only user for now. The new common code should be flexible
> enough to support the Clang style (which I guess is likely to be what
> C/C++ FEs end up supporting sooner or later) while still supporting
> the Fortran style.

Good.

> Supporting this in the common diagnostics code requires having two
> locations in struct diagnostic_info and two pointers in struct
> text_info. That seems a waste and overtly complex. Thus, I moved the
> new location array directly to struct text_info and added an accessor
> function diagnostic_location().

Agreed.

[...]


> Index: gcc/pretty-print.h

[...]

> --- gcc/pretty-print.h	(revision 222087)
> +++ gcc/pretty-print.h	(working copy)
> @@ -33,11 +33,13 @@ along with GCC; see the file COPYING3.  
>  struct text_info
>  {
>    const char *format_spec;
>    va_list *args_ptr;
>    int err_no;  /* for %m */
> -  location_t *locus;
> +  /* This message can have associated two locations at most.  If the
> +     first location is UNKNOWN_LOCATION, the second is not valid.  */
> +  location_t location[2];

Here, I would call the data member locations (note the 's' at the
end).

Also, I'd define a constant (a macro, sigh) named like e.g,
MAX_LOCATIONS_PER_MESSAGE that is set to '2', rather than carrying
forcing users of these locations to know that there are specifically
two locations here.

[...]

>    void **x_data;
>  };
>  


> Index: gcc/diagnostic.h

[..]

>  /* 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;

[...]

>  
> -  /* Character used for caret diagnostics.  */
> -  char caret_char;
> +  /* Characters used for caret diagnostics.  */
> +  char caret_char[2];
>  

Here, I'd call the data member caret_chars (with an 's' at the end)
and I'd use the same MAX_LOCATIONS_PER_MESSAGE constant as above,
rather that the '2' literal.

[...]

> --- gcc/tree-pretty-print.c	(revision 222087)
> +++ 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->location[0] = EXPR_LOCATION (t);

I guess I'd prefer to have an accessor (e.g,
source_location text_info_location(text_info, int index_of_location))
that returns the location and checks that we are accessing a location
that is below the MAX_LOCATIONS_PER_MESSAGE maximum, rather than just
doing text->locations[0] here.

And, likewise for the other similar spots that access
text_info::locations.

[...]

> --- gcc/diagnostic.c	(revision 222087)
> +++ gcc/diagnostic.c	(working copy)
> @@ -144,11 +144,12 @@ diagnostic_initialize (diagnostic_contex

[...]

>    context->show_caret = false;
>    diagnostic_set_caret_max_width (context, pp_line_cutoff (context->printer));
> -  context->caret_char = '^';
> +  context->caret_char[0] = '^';
> +  context->caret_char[1] = '^';

I'd use a loop from O to MAX_LOCATIONS_PER_MESSAGE to initialize
this.  Or maybe rather a dedicated little function for this even; as
you see fit.

[...]

> @@ -239,11 +240,12 @@ 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.location[0] = location;
> +  diagnostic->message.location[1] = UNKNOWN_LOCATION;

I'd use a loop from 1 to to MAX_LOCATIONS_PER_MESSAGE to set the
UNKNOWN_LOCATION.  I understand that the loop will step only one
iteration, but the goal is to be ready for when a front end is going
to need three or more locations per messages.  We'd then just need to
to adjust MAX_LOCATIONS_PER_MESSAGE and the whole thing would "almost"
Just Work ™.

[...]

>  /* 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 locus according to

I am confused by what you mean by "same locus" here.  Do you mean the
"same line" ?  If yes, then maybe the other spots where you talk about
"same locus" should be updated too.  More on this later below.

> +   diagnostic_same_locus().  */
>  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;
> +  expanded_location s1, s2;

Here, I'd initialize s1 and s2.  Well, at least s2.  So that ...

>    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);
> +  s1 = diagnostic_expand_location (diagnostic, 0);
> +  if (diagnostic_location (diagnostic, 1) > BUILTINS_LOCATION)
> +    s2 = diagnostic_expand_location (diagnostic, 1);
> +  else
> +    s2.column = 0;

... we can do away with the else branch here.

[...]

I would add a comment to this new function here:

> -/* Expand the location of this diagnostic. Use this function for consistency. */
> +static inline location_t
> +diagnostic_location (const diagnostic_info * diagnostic, int which = 0)
> +{
> +  return diagnostic->message.location[which];
> +}
> +
> +
> +/* Expand the location of this diagnostic. Use this function for consistency.
> +   WHICH specifies which location. By default, expand the first one.  */

[...]

>  
> +/* Return true if the two locations can be represented within the same
> +   locus.  This is used not only for the prefix but also to determine
> +   whether to print one or two caret lines.  */
> +
> +static inline bool
> +diagnostic_same_locus (const diagnostic_context *context,
> +		       expanded_location s1, expanded_location s2)
> +{
> +  return s2.column && s1.line == s2.line 
> +    && context->caret_max_width - 10 > abs (s1.column - s2.column);
> +}

My understanding is that this function checks that the two locations s1
and s2 are on the same line and are "close enough"; that is, they fit
into the maximum "display width" that the diagnostic machinery allows
for a line.  That display width is, from I see in adjust_line(),
diagnostic_context::caret_max_width minus a margin; and the margin is
10.

If I am right, then I think the name diagnostic_same_locus() should be
changed to something more meaningful.  The 'locus' here seems
confusing and makes the code hard to understand, IMHO.  Especially
given that we are talking about 'locations' as well.  What do you
think?

I would also change the 10 literal into a named constant and use it at
the other spots where we use the 10 today.  Because otherwise, seeing
that 10 literal magically appear in this function like this is
... surprising.  Is it not?

[...]

> Bootstrapped and regression tested on x86_64-linux-gnu.

Thanks!

> 
> OK?
> 

It's mostly OK to me, barring the points I have raised and for which I
need input from you.  Sorry again for taking so much time in reviewing
this.

Thanks!
diff mbox

Patch

Index: gcc/tree-pretty-print.c
===================================================================
--- gcc/tree-pretty-print.c	(revision 222087)
+++ 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->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/c/c-objc-common.c
===================================================================
--- gcc/c/c-objc-common.c	(revision 222087)
+++ 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->location[0] = DECL_SOURCE_LOCATION (t);
     }
 
   switch (*spec)
     {
     case 'D':
Index: gcc/tree-diagnostic.c
===================================================================
--- gcc/tree-diagnostic.c	(revision 222087)
+++ 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->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 222087)
+++ 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 = '^';
+  context->caret_char[0] = '^';
+  context->caret_char[1] = '^';
   context->show_option_requested = false;
   context->abort_on_error = false;
   context->show_column = false;
   context->pedantic_errors = false;
   context->permissive = false;
@@ -239,11 +240,12 @@  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.location[0] = location;
+  diagnostic->message.location[1] = UNKNOWN_LOCATION;
   diagnostic->override_column = 0;
   diagnostic->kind = kind;
   diagnostic->option_index = 0;
 }
 
@@ -329,39 +331,73 @@  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 locus according to
+   diagnostic_same_locus().  */
 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;
+  expanded_location s1, s2;
 
   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);
+  s1 = diagnostic_expand_location (diagnostic, 0);
+  if (diagnostic_location (diagnostic, 1) > BUILTINS_LOCATION)
+    s2 = diagnostic_expand_location (diagnostic, 1);
+  else
+    s2.column = 0;
+
+  diagnostic_print_caret_line (context, s1, s2,
+			       context->caret_char[0], context->caret_char[1]);
+}
+
+/* Print (part) of the source line given by xloc1 with caret1 pointing
+   at the column.  If xloc2.column != 0 and within the same locus as xloc1
+   according to diagnostic_same_locus(), 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_locus (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 222087)
+++ 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_char[2];
 
   /* True if we should print the command line option which controls
      each diagnostic, if known.  */
   bool show_option_requested;
 
@@ -298,22 +299,49 @@  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. */
+static inline location_t
+diagnostic_location (const diagnostic_info * diagnostic, int which = 0)
+{
+  return diagnostic->message.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;
 }
 
+/* Return true if the two locations can be represented within the same
+   locus.  This is used not only for the prefix but also to determine
+   whether to print one or two caret lines.  */
+
+static inline bool
+diagnostic_same_locus (const diagnostic_context *context,
+		       expanded_location s1, expanded_location s2)
+{
+  return s2.column && s1.line == s2.line 
+    && context->caret_max_width - 10 > 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 222087)
+++ 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 222087)
+++ gcc/pretty-print.h	(working copy)
@@ -33,11 +33,13 @@  along with GCC; see the file COPYING3.  
 struct text_info
 {
   const char *format_spec;
   va_list *args_ptr;
   int err_no;  /* for %m */
-  location_t *locus;
+  /* This message can have associated two locations at most.  If the
+     first location is UNKNOWN_LOCATION, the second is not valid.  */
+  location_t location[2];
   void **x_data;
 };
 
 /* How often diagnostics are prefixed by their locations:
    o DIAGNOSTICS_SHOW_PREFIX_NEVER: never - not yet supported;
Index: gcc/testsuite/lib/gfortran-dg.exp
===================================================================
--- gcc/testsuite/lib/gfortran-dg.exp	(revision 222087)
+++ 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 222087)
+++ 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 222087)
+++ 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->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 222087)
+++ 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 222087)
+++ 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 222087)
+++ 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->location[0] == UNKNOWN_LOCATION ? 0 : 1;
+	text->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_locus (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_char[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_char[0] = '1';
+  global_dc->caret_char[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_char[0] = '^';
+  global_dc->caret_char[1] = '^';
 }
Index: gcc/fortran/scanner.c
===================================================================
--- gcc/fortran/scanner.c	(revision 222087)
+++ 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 222087)
+++ 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 222087)
+++ 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;