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;
