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

gcc/fortran/ChangeLog:

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

	PR fortran/44054

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

gcc/cp/ChangeLog:

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

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

gcc/c/ChangeLog:

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

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

gcc/ChangeLog:

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

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

gcc/testsuite/ChangeLog:

2015-05-16  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.

From-SVN: r223237

16 files changed, 375 insertions, 258 deletions

diff --git a/gcc/c/c-objc-common.c b/gcc/c/c-objc-common.c
index 344d4e2..2730565 100644
--- a/gcc/c/c-objc-common.c
+++ b/gcc/c/c-objc-common.c
@@ -108,8 +108,8 @@ c_tree_printer (pretty_printer *pp, text_info *text, const char *spec,
   if (*spec != 'v')
     {
       t = va_arg (*text->args_ptr, tree);
-      if (set_locus && text->locus)
-	*text->locus = DECL_SOURCE_LOCATION (t);
+      if (set_locus)
+	text->set_location (0, DECL_SOURCE_LOCATION (t));
     }
 
   switch (*spec)
diff --git a/gcc/cp/error.c b/gcc/cp/error.c
index ce43f86..ea03f7d 100644
--- a/gcc/cp/error.c
+++ b/gcc/cp/error.c
@@ -3104,7 +3104,7 @@ 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);
@@ -3125,7 +3125,7 @@ cp_print_error_function (diagnostic_context *context,
   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;
@@ -3471,9 +3471,6 @@ cp_printer (pretty_printer *pp, text_info *text, const char *spec,
   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;
@@ -3515,7 +3512,7 @@ cp_printer (pretty_printer *pp, text_info *text, const char *spec,
 
   pp_string (pp, result);
   if (set_locus && t != NULL)
-    *text->locus = location_of (t);
+    text->set_location (0, location_of (t));
   return true;
 #undef next_tree
 #undef next_tcode
diff --git a/gcc/diagnostic.c b/gcc/diagnostic.c
index 2196406..54e3fcf 100644
--- a/gcc/diagnostic.c
+++ b/gcc/diagnostic.c
@@ -146,7 +146,8 @@ diagnostic_initialize (diagnostic_context *context, int n_opts)
     context->classify_diagnostic[i] = DK_UNSPECIFIED;
   context->show_caret = false;
   diagnostic_set_caret_max_width (context, pp_line_cutoff (context->printer));
-  context->caret_char = '^';
+  for (i = 0; i < MAX_LOCATIONS_PER_MESSAGE; i++)
+    context->caret_chars[i] = '^';
   context->show_option_requested = false;
   context->abort_on_error = false;
   context->show_column = false;
@@ -241,7 +242,9 @@ diagnostic_set_info_translated (diagnostic_info *diagnostic, const char *msg,
   diagnostic->message.err_no = errno;
   diagnostic->message.args_ptr = args;
   diagnostic->message.format_spec = msg;
-  diagnostic->location = location;
+  diagnostic->message.set_location (0, location);
+  for (int i = 1; i < MAX_LOCATIONS_PER_MESSAGE; i++)
+    diagnostic->message.set_location (i, UNKNOWN_LOCATION);
   diagnostic->override_column = 0;
   diagnostic->kind = kind;
   diagnostic->option_index = 0;
@@ -309,14 +312,14 @@ diagnostic_build_prefix (diagnostic_context *context,
 /* If LINE is longer than MAX_WIDTH, and COLUMN is not smaller than
    MAX_WIDTH by some margin, then adjust the start of the line such
    that the COLUMN is smaller than MAX_WIDTH minus the margin.  The
-   margin is either 10 characters or the difference between the column
-   and the length of the line, whatever is smaller.  The length of
-   LINE is given by LINE_WIDTH.  */
+   margin is either CARET_LINE_MARGIN characters or the difference
+   between the column and the length of the line, whatever is smaller.
+   The length of LINE is given by LINE_WIDTH.  */
 static const char *
 adjust_line (const char *line, int line_width,
 	     int max_width, int *column_p)
 {
-  int right_margin = 10;
+  int right_margin = CARET_LINE_MARGIN;
   int column = *column_p;
 
   gcc_checking_assert (line_width >= column);
@@ -331,35 +334,69 @@ adjust_line (const char *line, int line_width,
 }
 
 /* Print the physical source line corresponding to the location of
-   this diagnostic, and a caret indicating the precise column.  */
+   this diagnostic, and a caret indicating the precise column.  This
+   function only prints two caret characters if the two locations
+   given by DIAGNOSTIC are on the same line according to
+   diagnostic_same_line().  */
 void
 diagnostic_show_locus (diagnostic_context * context,
 		       const diagnostic_info *diagnostic)
 {
-  const char *line;
-  int line_width;
-  char *buffer;
-  expanded_location s;
-  int max_width;
-  const char *saved_prefix;
-  const char *caret_cs, *caret_ce;
-
   if (!context->show_caret
-      || diagnostic->location <= BUILTINS_LOCATION
-      || diagnostic->location == context->last_location)
+      || diagnostic_location (diagnostic, 0) <= BUILTINS_LOCATION
+      || diagnostic_location (diagnostic, 0) == context->last_location)
     return;
 
-  context->last_location = diagnostic->location;
-  s = diagnostic_expand_location (diagnostic);
-  line = location_get_source_line (s, &line_width);
-  if (line == NULL || s.column > line_width)
-    return;
+  context->last_location = diagnostic_location (diagnostic, 0);
+  expanded_location s0 = diagnostic_expand_location (diagnostic, 0);
+  expanded_location s1 = { }; 
+  /* Zero-initialized. This is checked later by diagnostic_print_caret_line.  */
 
-  max_width = context->caret_max_width;
-  line = adjust_line (line, line_width, max_width, &(s.column));
+  if (diagnostic_location (diagnostic, 1) > BUILTINS_LOCATION)
+    s1 = diagnostic_expand_location (diagnostic, 1);
 
+  diagnostic_print_caret_line (context, s0, s1,
+			       context->caret_chars[0],
+			       context->caret_chars[1]);
+}
+
+/* Print (part) of the source line given by xloc1 with caret1 pointing
+   at the column.  If xloc2.column != 0 and it fits within the same
+   line as xloc1 according to diagnostic_same_line (), then caret2 is
+   printed at xloc2.colum.  Otherwise, the caller has to set up things
+   to print a second caret line for xloc2.  */
+void
+diagnostic_print_caret_line (diagnostic_context * context,
+			     expanded_location xloc1,
+			     expanded_location xloc2,
+			     char caret1, char caret2)
+{
+  if (!diagnostic_same_line (context, xloc1, xloc2))
+    /* This will mean ignore xloc2.  */
+    xloc2.column = 0;
+  else if (xloc1.column == xloc2.column)
+    xloc2.column++;
+  
+  int cmax = MAX (xloc1.column, xloc2.column);
+  int line_width;
+  const char *line = location_get_source_line (xloc1, &line_width);
+  if (line == NULL || cmax > line_width)
+    return;
+
+  /* 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)
@@ -373,15 +410,28 @@ diagnostic_show_locus (diagnostic_context * context,
       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_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);
+  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);
+
+  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;
 }
@@ -604,7 +654,7 @@ 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));
 }
@@ -716,7 +766,7 @@ 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;
 
@@ -825,7 +875,8 @@ diagnostic_report_diagnostic (diagnostic_context *context,
 	   || 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);
@@ -859,7 +910,6 @@ diagnostic_report_diagnostic (diagnostic_context *context,
 	  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);
@@ -920,7 +970,6 @@ verbatim (const char *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);
diff --git a/gcc/diagnostic.h b/gcc/diagnostic.h
index 02434d8..1b9b7d4 100644
--- a/gcc/diagnostic.h
+++ b/gcc/diagnostic.h
@@ -29,8 +29,9 @@ along with GCC; see the file COPYING3.  If not see
    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;
@@ -105,8 +106,8 @@ struct diagnostic_context
   /* Maximum width of the source line printed.  */
   int caret_max_width;
 
-  /* Character used for caret diagnostics.  */
-  char caret_char;
+  /* Characters used for caret diagnostics.  */
+  char caret_chars[MAX_LOCATIONS_PER_MESSAGE];
 
   /* True if we should print the command line option which controls
      each diagnostic, if known.  */
@@ -300,18 +301,53 @@ void diagnostic_file_cache_fini (void);
 
 int get_terminal_width (void);
 
-/* Expand the location of this diagnostic. Use this function for consistency. */
+/* Return the location associated to this diagnostic. Parameter WHICH
+   specifies which location. By default, expand the first one.  */
+
+static inline location_t
+diagnostic_location (const diagnostic_info * diagnostic, int which = 0)
+{
+  return diagnostic->message.get_location (which);
+}
+
+/* Expand the location of this diagnostic. Use this function for
+   consistency.  Parameter WHICH specifies which location. By default,
+   expand the first one.  */
 
 static inline expanded_location
-diagnostic_expand_location (const diagnostic_info * diagnostic)
+diagnostic_expand_location (const diagnostic_info * diagnostic, int which = 0)
 {
   expanded_location s
-    = expand_location_to_spelling_point (diagnostic->location);
-  if (diagnostic->override_column)
+    = expand_location_to_spelling_point (diagnostic_location (diagnostic,
+							      which));
+  if (which == 0 && diagnostic->override_column)
     s.column = diagnostic->override_column;
   return s;
 }
 
+/* This is somehow the right-side margin of a caret line, that is, we
+   print at least these many characters after the position pointed at
+   by the caret.  */
+#define CARET_LINE_MARGIN 10
+
+/* Return true if the two locations can be represented within the same
+   caret line.  This is used to build a prefix and also to determine
+   whether to print one or two caret lines.  */
+
+static inline bool
+diagnostic_same_line (const diagnostic_context *context,
+		       expanded_location s1, expanded_location s2)
+{
+  return s2.column && s1.line == s2.line 
+    && context->caret_max_width - CARET_LINE_MARGIN > abs (s1.column - s2.column);
+}
+
+void
+diagnostic_print_caret_line (diagnostic_context * context,
+			     expanded_location xloc1,
+			     expanded_location xloc2,
+			     char caret1, char caret2);
+
 /* Pure text formatting support functions.  */
 extern char *file_name_as_prefix (diagnostic_context *, const char *);
 
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 0c15fb9..13002d4 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -1126,7 +1126,7 @@ gfc_verify_c_interop_param (gfc_symbol *sym)
 	     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), 
diff --git a/gcc/fortran/dependency.c b/gcc/fortran/dependency.c
index 63c6630..8b07f59 100644
--- a/gcc/fortran/dependency.c
+++ b/gcc/fortran/dependency.c
@@ -956,7 +956,7 @@ gfc_check_argument_var_dependency (gfc_expr *var, sym_intent intent,
 		     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);
diff --git a/gcc/fortran/error.c b/gcc/fortran/error.c
index da0eb8f..23308b6 100644
--- a/gcc/fortran/error.c
+++ b/gcc/fortran/error.c
@@ -807,37 +807,6 @@ gfc_clear_pp_buffer (output_buffer *this_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.  */
 
@@ -889,9 +858,6 @@ gfc_warning (int opt, const char *gmsgid, va_list ap)
 }
 
 /* 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, ...)
@@ -927,84 +893,6 @@ gfc_notification_std (int std)
    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;
@@ -1066,35 +954,6 @@ gfc_notify_std (int std, const char *gmsgid, ...)
 }
 
 
-/* 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:
 
@@ -1112,7 +971,7 @@ gfc_format_decoder (pretty_printer *pp,
     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;
@@ -1120,13 +979,14 @@ gfc_format_decoder (pretty_printer *pp,
 	  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
-	  = linemap_position_for_loc_and_offset (line_table,
-						 loc->lb->location,
-						 offset);
-	global_dc->caret_char = '1';
-	pp_string (pp, result);
+	/* If location[0] != UNKNOWN_LOCATION means that we already
+	   processed one of %C/%L.  */
+	int loc_num = text->get_location (0) == UNKNOWN_LOCATION ? 0 : 1;
+	text->set_location (loc_num,
+			    linemap_position_for_loc_and_offset (line_table,
+								 loc->lb->location,
+								 offset));
+	pp_string (pp, result[loc_num]);
 	return true;
       }
     default:
@@ -1134,11 +994,11 @@ gfc_format_decoder (pretty_printer *pp,
     }
 }
 
-/* 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),
@@ -1170,12 +1030,11 @@ gfc_diagnostic_build_prefix (diagnostic_context *context,
    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>"))
@@ -1186,35 +1045,160 @@ gfc_diagnostic_build_locus_prefix (diagnostic_context *context,
 	  : build_message_string ("%s%s:%d:%s", locus_cs, s.file, s.line, locus_ce));
 }
 
-static void
+/* Return a malloc'd string describing two locations.  The caller is
+   responsible for freeing the memory.  */
+static char *
+gfc_diagnostic_build_locus_prefix (diagnostic_context *context,
+				   expanded_location s, expanded_location s2)
+{
+  pretty_printer *pp = context->printer;
+  const char *locus_cs = colorize_start (pp_show_color (pp), "locus");
+  const char *locus_ce = colorize_stop (pp_show_color (pp));
+
+  return (s.file == NULL
+	  ? build_message_string ("%s%s:%s", locus_cs, progname, locus_ce )
+	  : !strcmp (s.file, N_("<built-in>"))
+	  ? build_message_string ("%s%s:%s", locus_cs, s.file, locus_ce)
+	  : context->show_column
+	  ? build_message_string ("%s%s:%d:%d-%d:%s", locus_cs, s.file, s.line,
+				  MIN (s.column, s2.column),
+				  MAX (s.column, s2.column), locus_ce)
+	  : build_message_string ("%s%s:%d:%s", locus_cs, s.file, s.line,
+				  locus_ce));
+}
+
+/* This function prints the locus (file:line:column), the diagnostic kind
+   (Error, Warning) and (optionally) the caret line (a source line
+   with '1' and/or '2' below it).
+
+   With -fdiagnostic-show-caret (the default) and for valid locations,
+   it prints for one location:
+
+       [locus]:
+       
+          some code
+                 1
+       Error: Some error at (1)
+        
+   for two locations that fit in the same locus line:
+
+       [locus]:
+       
+         some code and some more code
+                1       2
+       Error: Some error at (1) and (2)
+
+   and for two locations that do not fit in the same locus line:
+
+       [locus]:
+       
+         some code
+                1
+       [locus2]:
+       
+         some other code
+           2
+       Error: Some error at (1) and (2)
+       
+  With -fno-diagnostic-show-caret or if one of the locations is not
+  valid, it prints for one location (or for two locations that fit in
+  the same locus line):
+
+       [locus]: Error: Some error at (1) and (2)
+
+   and for two locations that do not fit in the same locus line:
+
+       [name]:[locus]: Error: (1)
+       [name]:[locus2]: Error: Some error at (1) and (2)
+*/
+static void 
 gfc_diagnostic_starter (diagnostic_context *context,
 			diagnostic_info *diagnostic)
 {
-  char * locus_prefix = gfc_diagnostic_build_locus_prefix (context, diagnostic);
-  char * prefix = gfc_diagnostic_build_prefix (context, diagnostic);
-  /* First we assume there is a caret line.  */
-  pp_set_prefix (context->printer, NULL);
-  if (pp_needs_newline (context->printer))
-    pp_newline (context->printer);
-  pp_verbatim (context->printer, locus_prefix);
-  /* Fortran uses an empty line between locus and caret line.  */
-  pp_newline (context->printer);
-  diagnostic_show_locus (context, diagnostic);
-  if (pp_needs_newline (context->printer))
+  char * kind_prefix = gfc_diagnostic_build_kind_prefix (context, diagnostic);
+
+  expanded_location s1 = diagnostic_expand_location (diagnostic);
+  expanded_location s2;
+  bool one_locus = diagnostic_location (diagnostic, 1) == UNKNOWN_LOCATION;
+  bool same_locus = false;
+
+  if (!one_locus) 
+    {
+      s2 = diagnostic_expand_location (diagnostic, 1);
+      same_locus = diagnostic_same_line (context, s1, s2);
+    }
+
+  char * locus_prefix = (one_locus || !same_locus)
+    ? gfc_diagnostic_build_locus_prefix (context, s1)
+    : gfc_diagnostic_build_locus_prefix (context, s1, s2);
+
+  if (!context->show_caret
+      || diagnostic_location (diagnostic, 0) <= BUILTINS_LOCATION
+      || diagnostic_location (diagnostic, 0) == context->last_location)
+    {
+      pp_set_prefix (context->printer,
+		     concat (locus_prefix, " ", kind_prefix, NULL));
+      free (locus_prefix);
+
+      if (one_locus || same_locus)
+	{
+	  free (kind_prefix);
+	  return;
+	}
+      /* In this case, we print the previous locus and prefix as:
+
+	  [locus]:[prefix]: (1)
+
+	 and we flush with a new line before setting the new prefix.  */
+      pp_string (context->printer, "(1)");
+      pp_newline (context->printer);
+      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
     {
+      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, prefix);
-    }
-  else 
-    {
-      /* Otherwise, start again.  */
-      pp_clear_output_area(context->printer);
-      pp_set_prefix (context->printer, concat (locus_prefix, " ", prefix, NULL));
-      free (prefix);
+      pp_set_prefix (context->printer, kind_prefix);
+
+      if (one_locus || same_locus)
+	  return;
+
+      locus_prefix = gfc_diagnostic_build_locus_prefix (context, s2);
+      if (diagnostic_location (diagnostic, 1) <= BUILTINS_LOCATION)
+	{
+	  /* No caret line for the second location. Override the previous
+	     prefix with [locus2]:[prefix].  */
+	  pp_set_prefix (context->printer,
+			 concat (locus_prefix, " ", kind_prefix, NULL));
+	  free (kind_prefix);
+	  free (locus_prefix);
+	}
+      else
+	{
+	  /* We print the caret for the second location.  */
+	  pp_verbatim (context->printer, locus_prefix);
+	  free (locus_prefix);
+	  /* Fortran uses an empty line between locus and caret line.  */
+	  pp_newline (context->printer);
+	  s1.column = 0; /* Print only a caret line for s2.  */
+	  diagnostic_print_caret_line (context, s2, s1,
+				       context->caret_chars[1], '\0');
+	  pp_newline (context->printer);
+	  /* If the caret line was shown, the prefix does not contain the
+	     locus.  */
+	  pp_set_prefix (context->printer, kind_prefix);
+	}
     }
-  free (locus_prefix);
 }
 
 static void
@@ -1225,10 +1209,25 @@ gfc_diagnostic_finalizer (diagnostic_context *context,
   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, ...)
@@ -1639,7 +1638,8 @@ gfc_diagnostics_init (void)
   diagnostic_starter (global_dc) = gfc_diagnostic_starter;
   diagnostic_finalizer (global_dc) = gfc_diagnostic_finalizer;
   diagnostic_format_decoder (global_dc) = gfc_format_decoder;
-  global_dc->caret_char = '^';
+  global_dc->caret_chars[0] = '1';
+  global_dc->caret_chars[1] = '2';
   pp_warning_buffer = new (XNEW (output_buffer)) output_buffer ();
   pp_warning_buffer->flush_p = false;
   pp_error_buffer = new (XNEW (output_buffer)) output_buffer ();
@@ -1654,5 +1654,6 @@ gfc_diagnostics_finish (void)
      defaults.  */
   diagnostic_starter (global_dc) = gfc_diagnostic_starter;
   diagnostic_finalizer (global_dc) = gfc_diagnostic_finalizer;
-  global_dc->caret_char = '^';
+  global_dc->caret_chars[0] = '^';
+  global_dc->caret_chars[1] = '^';
 }
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 514e93f..aaa4e89 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2660,10 +2660,10 @@ 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);
@@ -2679,7 +2679,6 @@ 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.  */
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 316b413..fbf260f 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -8779,7 +8779,7 @@ resolve_branch (gfc_st_label *label, gfc_code *code)
   /* 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;
@@ -12920,8 +12920,8 @@ resolve_fl_derived (gfc_symbol *sym)
   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
diff --git a/gcc/fortran/scanner.c b/gcc/fortran/scanner.c
index f0e6404..55b3625 100644
--- a/gcc/fortran/scanner.c
+++ b/gcc/fortran/scanner.c
@@ -2014,9 +2014,13 @@ preprocessor_line (gfc_char_t *c)
       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);
@@ -2048,8 +2052,11 @@ preprocessor_line (gfc_char_t *c)
   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++;
 }
 
diff --git a/gcc/pretty-print.c b/gcc/pretty-print.c
index 78d334e..fdc7b4d 100644
--- a/gcc/pretty-print.c
+++ b/gcc/pretty-print.c
@@ -853,7 +853,6 @@ pp_printf (pretty_printer *pp, const char *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);
@@ -871,7 +870,6 @@ pp_verbatim (pretty_printer *pp, const char *msg, ...)
   text.err_no = errno;
   text.args_ptr = &ap;
   text.format_spec = msg;
-  text.locus = NULL;
   pp_format_verbatim (pp, &text);
   va_end (ap);
 }
diff --git a/gcc/pretty-print.h b/gcc/pretty-print.h
index e443098..6143423 100644
--- a/gcc/pretty-print.h
+++ b/gcc/pretty-print.h
@@ -28,6 +28,11 @@ along with GCC; see the file COPYING3.  If not see
 /* Maximum number of format string arguments.  */
 #define PP_NL_ARGMAX   30
 
+/* Maximum number of locations associated to each message.  If
+   location 'i' is UNKNOWN_LOCATION, then location 'i+1' is not
+   valid.  */
+#define MAX_LOCATIONS_PER_MESSAGE 2
+
 /* The type of a text to be formatted according a format specification
    along with a list of things.  */
 struct text_info
@@ -35,8 +40,22 @@ struct text_info
   const char *format_spec;
   va_list *args_ptr;
   int err_no;  /* for %m */
-  location_t *locus;
   void **x_data;
+
+  inline void set_location (unsigned int index_of_location, location_t loc)
+  {
+    gcc_checking_assert (index_of_location < MAX_LOCATIONS_PER_MESSAGE);
+    this->locations[index_of_location] = loc;
+  }
+
+  inline location_t get_location (unsigned int index_of_location) const
+  {
+    gcc_checking_assert (index_of_location < MAX_LOCATIONS_PER_MESSAGE);
+    return this->locations[index_of_location];
+  }
+
+private:
+  location_t locations[MAX_LOCATIONS_PER_MESSAGE];
 };
 
 /* How often diagnostics are prefixed by their locations:
diff --git a/gcc/testsuite/gfortran.dg/badline.f b/gcc/testsuite/gfortran.dg/badline.f
index 59f22e7..250b06f 100644
--- a/gcc/testsuite/gfortran.dg/badline.f
+++ b/gcc/testsuite/gfortran.dg/badline.f
@@ -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 }
diff --git a/gcc/testsuite/lib/gfortran-dg.exp b/gcc/testsuite/lib/gfortran-dg.exp
index 225b5d0..ddf8f22 100644
--- a/gcc/testsuite/lib/gfortran-dg.exp
+++ b/gcc/testsuite/lib/gfortran-dg.exp
@@ -51,6 +51,9 @@ proc gfortran-dg-test { prog do_what extra_tool_flags } {
     #
     # 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] .
@@ -80,14 +83,19 @@ proc gfortran-dg-test { prog do_what extra_tool_flags } {
     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]
 }
 
diff --git a/gcc/tree-diagnostic.c b/gcc/tree-diagnostic.c
index 99d47cb..a3b73b2 100644
--- a/gcc/tree-diagnostic.c
+++ b/gcc/tree-diagnostic.c
@@ -48,7 +48,7 @@ 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);
 }
@@ -153,7 +153,7 @@ maybe_unwind_expanded_macro_loc (diagnostic_context *context,
      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)
@@ -252,7 +252,7 @@ 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.  */
@@ -296,8 +296,8 @@ default_tree_printer (pretty_printer *pp, text_info *text, const char *spec,
       return false;
     }
 
-  if (set_locus && text->locus)
-    *text->locus = DECL_SOURCE_LOCATION (t);
+  if (set_locus)
+    text->set_location (0, DECL_SOURCE_LOCATION (t));
 
   if (DECL_P (t))
     {
diff --git a/gcc/tree-pretty-print.c b/gcc/tree-pretty-print.c
index d7c049f..cf875c8 100644
--- a/gcc/tree-pretty-print.c
+++ b/gcc/tree-pretty-print.c
@@ -3620,8 +3620,7 @@ void
 percent_K_format (text_info *text)
 {
   tree t = va_arg (*text->args_ptr, tree), block;
-  gcc_assert (text->locus != NULL);
-  *text->locus = EXPR_LOCATION (t);
+  text->set_location (0, EXPR_LOCATION (t));
   gcc_assert (pp_ti_abstract_origin (text) != NULL);
   block = TREE_BLOCK (t);
   *pp_ti_abstract_origin (text) = NULL;