[diagnostics/fortran] dynamically generate locations from offset + handle %C (try 2)
diff mbox

Message ID CAESRpQB_y0GGpmVQpgH3ZcwF6DMzNxGdXXOef_6J51g6hxooYg@mail.gmail.com
State New
Headers show

Commit Message

Manuel López-Ibáñez Nov. 1, 2014, 2:01 a.m. UTC
Dear Jason or Tom,

Only the libcpp parts are pending review.

This is an updated version of
https://gcc.gnu.org/ml/gcc-patches/2014-10/msg01621.html

The only changes are more uses of gfc_warning_now_2 to increase
testing, which required updating gfortran.dg/warnings_are_errors_1.f,
and implementing the linemap_assert() calls as Dodji asked here:
https://gcc.gnu.org/ml/gcc-patches/2014-10/msg02379.html

I'm wondering whether it would be more robust and user-friendly to
simply return "loc" if the assert condition is false, instead of
calling linemap_assert. My ideal preference would be to call
linemap_assert when --enable-checking=yes and simply return "loc" when
--enable-checking=release, but I don't see how to do this in libcpp.

Boot&regtested on x86_64-linux-gnu.

OK?


libcpp/ChangeLog:

2014-11-01  Manuel López-Ibáñez  <manu@gcc.gnu.org>

    PR fortran/44054
    * include/line-map.h (linemap_position_for_loc_and_offset):
    Declare.
    * line-map.c (linemap_position_for_loc_and_offset): New.


gcc/fortran/ChangeLog:

2014-11-01  Manuel López-Ibáñez  <manu@gcc.gnu.org>

    PR fortran/44054
    * gfortran.h (warn_use_without_only): Remove.
    (gfc_diagnostics_finish): Declare.
    * error.c: Include tree-diagnostics.h
    (gfc_format_decoder): New.
    (gfc_diagnostics_init): Use gfc_format_decoder. Set default caret
    char.
    (gfc_diagnostics_finish): Restore tree diagnostics defaults, but
    keep gfc_diagnostics_starter and finalizer. Restore default caret.
    * options.c: Remove all uses of warn_use_without_only.
    * lang.opt (Wuse-without-only): Add Var.
    * f95-lang.c (gfc_be_parse_file): Call gfc_diagnostics_finish.
    * module.c (gfc_use_module): Use gfc_warning_now_2.
    * parse.c (decode_statement): Likewise.
    (decode_gcc_attribute): Likewise.
    (next_free): Likewise.
    (next_fixed): Likewise.


gcc/testsuite/ChangeLog:

2014-11-01  Manuel López-Ibáñez  <manu@gcc.gnu.org>

    PR fortran/44054
    * lib/gfortran-dg.exp: Update regexp to match locus and message
    without caret.
    * gfortran.dg/use_without_only_1.f90: Add column numbers.
        * gfortran.dg/warnings_are_errors_1.f: Update.

Comments

Jason Merrill Nov. 11, 2014, 4:10 p.m. UTC | #1
On 10/31/2014 10:01 PM, Manuel López-Ibáñez wrote:
> +	 sense.  So let's live the location intact in that case.  */

s/live/leave/

> +  /* If MAP is not the last line map of its set, then the new location
> +     (loc + offset) should be less than the first location encoded by
> +     the next line map of the set.  */

> +    linemap_assert (MAP_START_LOCATION (&map[1]) < loc + offset);

This comparison looks backwards from the comment.

Jason
Manuel López-Ibáñez Nov. 11, 2014, 10:54 p.m. UTC | #2
On 11 November 2014 17:10, Jason Merrill <jason@redhat.com> wrote:
> On 10/31/2014 10:01 PM, Manuel López-Ibáñez wrote:
>>
>> +        sense.  So let's live the location intact in that case.  */
>
>
> s/live/leave/
>
>> +  /* If MAP is not the last line map of its set, then the new location
>> +     (loc + offset) should be less than the first location encoded by
>> +     the next line map of the set.  */
>
>
>> +    linemap_assert (MAP_START_LOCATION (&map[1]) < loc + offset);
>
>
> This comparison looks backwards from the comment.

Copy-paste error. In any case, this check is currently pointless,
since Fortran only has one map per set. I fixed this and tested
Fortran again just in case. No failures, thus I committed the whole
thing as http://gcc.gnu.org/r217383.

Cheers,

Manuel.

Patch
diff mbox

Index: gcc/testsuite/lib/gfortran-dg.exp
===================================================================
--- gcc/testsuite/lib/gfortran-dg.exp	(revision 216812)
+++ gcc/testsuite/lib/gfortran-dg.exp	(working copy)
@@ -47,38 +47,49 @@  proc gfortran-dg-test { prog do_what ext
     #
     #       some code and some more code
     #              1       2
     #     Error: Some error at (1) and (2)
     #
-    # Where [locus] is either [line] or [line].[columns] .
+    # or
+    #     [name]:[locus]: Error: Some error
+    #
+    # Where [locus] is either [line] or [line].[column] or
+    # [line].[column]-[column] .
     #
     # We collapse these to look like:
     #  [name]:[line]:[column]: Error: Some error at (1) and (2)
     # or
     #  [name]:[line]:[column]: Error: Some error at (1) and (2)
     #  [name]:[line2]:[column]: Error: Some error at (1) and (2)
-    # We proceed in two steps: first we deal with the form with two
-    # different locus lines, then with the form with only one locus line.
     #
     # Note that these regexps only make sense in the combinations used below.
     # Note also that is imperative that we first deal with the form with
     # two loci.
-    set locus_regexp "(\[^\n\]*):(\[0-9\]+)\[\.:\](\[0-9\]*)(-\[0-9\]*)?:\n\n\[^\n\]*\n\[^\n\]*\n"
-    set diag_regexp "(\[^\n\]*)\n"
+    set locus_regexp "(\[^\n\]+:\[0-9\]+)\[\.:\](\[0-9\]+)(-\[0-9\]+)?:\n\n\[^\n\]+\n\[^\n\]+\n"
+    set diag_regexp "(\[^\n\]+)\n"
 
-    # Add column number if none exists
-    set colnum_regexp "(Warning: |Error: )?(\[^\n\]*):(\[0-9\]+):(\[ \n\])"
-    regsub -all $colnum_regexp $comp_output "\\2:\\3:0:\\4\\1" comp_output
-
-    set two_loci "$locus_regexp$locus_regexp$diag_regexp"
-    set single_locus "$locus_regexp$diag_regexp"
-    regsub -all $two_loci $comp_output "\\1:\\2:\\3: \\9\n\\5:\\6:\\7: \\9\n" comp_output
-    regsub -all $single_locus $comp_output "\\1:\\2:\\3: \\5\n" comp_output
+    # We proceed in steps:
 
-    # Add a line number if none exists
-    regsub -all "(^|\n)(Warning: |Error: )" $comp_output "\\1:0:0: \\2" comp_output
+    # 1. We add first a column number if none exists.
+    # (Some Fortran diagnostics have the locus after Warning|Error)
+    set colnum_regexp "(^|\n)(Warning: |Error: )?(\[^:\n\]+:\[0-9\]+):(\[ \n\])"
+    regsub -all $colnum_regexp $comp_output "\\1\\3:0:\\4\\2" comp_output
+    verbose "comput_output0:\n$comp_output"
 
+    # 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"
+
+    # 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"
+
+    # 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"
     return [list $comp_output $output_file]
 }
 
 proc gfortran-dg-prune { system text } {
     return [gcc-dg-prune $system $text]
Index: gcc/testsuite/gfortran.dg/warnings_are_errors_1.f
===================================================================
--- gcc/testsuite/gfortran.dg/warnings_are_errors_1.f	(revision 216812)
+++ gcc/testsuite/gfortran.dg/warnings_are_errors_1.f	(working copy)
@@ -1,16 +1,17 @@ 
 ! { dg-do compile }
 ! { dg-options " -Werror" }
+! { dg-message "warnings being treated as errors" "" { target *-*-* } 0 }
 ! PR fortran/21061
 ! gfortran ignores -Werror
 ! fixed-form tests
        program warnings_are_errors_1
        implicit none
        integer(kind=1) :: i
        real :: r1, r2(3)
 ! gfc_warning_now:
-0      r1 = 0 ! { dg-warning "Zero is not a valid statement label" }
+0      r1 = 0 ! { dg-error "Zero is not a valid statement label" }
 !
 34 5   i=0 
 ! gfc_notify_std(GFC_STD_F95_DEL):
        do r1 = 1, 2 ! { dg-warning "Deleted feature: Loop variable" }
          i = i+1
Index: gcc/testsuite/gfortran.dg/use_without_only_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/use_without_only_1.f90	(revision 216812)
+++ gcc/testsuite/gfortran.dg/use_without_only_1.f90	(working copy)
@@ -4,19 +4,19 @@ 
 MODULE foo
   INTEGER :: bar
 END MODULE
 
 MODULE testmod
-  USE foo ! { dg-warning "has no ONLY qualifier" }
+  USE foo ! { dg-warning "6:has no ONLY qualifier" }
   IMPLICIT NONE
 CONTAINS
   SUBROUTINE S1
-     USE foo ! { dg-warning "has no ONLY qualifier" }
+     USE foo ! { dg-warning "9:has no ONLY qualifier" }
   END SUBROUTINE S1
   SUBROUTINE S2
      USE foo, ONLY: bar 
   END SUBROUTINE
   SUBROUTINE S3
-     USE ISO_C_BINDING ! { dg-warning "has no ONLY qualifier" }
+     USE ISO_C_BINDING ! { dg-warning "9:has no ONLY qualifier" }
   END SUBROUTINE S3
 END MODULE
 ! { dg-final { cleanup-modules "foo testmod" } }
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h	(revision 216812)
+++ gcc/fortran/gfortran.h	(working copy)
@@ -2453,11 +2453,10 @@  typedef struct
   int warn_line_truncation;
   int warn_surprising;
   int warn_tabs;
   int warn_underflow;
   int warn_intrinsic_shadow;
-  int warn_use_without_only;
   int warn_intrinsics_std;
   int warn_character_truncation;
   int warn_array_temp;
   int warn_align_commons;
   int warn_real_q_constant;
@@ -2689,11 +2688,12 @@  typedef struct gfc_error_buf
   size_t allocated, index;
   char *message;
 } gfc_error_buf;
 
 void gfc_error_init_1 (void);
-void gfc_diagnostics_init(void);
+void gfc_diagnostics_init (void);
+void gfc_diagnostics_finish (void);
 void gfc_buffer_error (int);
 
 const char *gfc_print_wide_char (gfc_char_t);
 
 void gfc_warning (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
Index: gcc/fortran/error.c
===================================================================
--- gcc/fortran/error.c	(revision 216812)
+++ gcc/fortran/error.c	(working copy)
@@ -38,10 +38,11 @@  along with GCC; see the file COPYING3.
 # include <sys/ioctl.h>
 #endif
 
 #include "diagnostic.h"
 #include "diagnostic-color.h"
+#include "tree-diagnostic.h" /* tree_diagnostics_defaults */
 
 static int suppress_errors = 0;
 
 static int warnings_not_errors = 0; 
 
@@ -956,10 +957,42 @@  gfc_warning_now (const char *gmsgid, ...
     gfc_increment_error_count();
 
   buffer_flag = i;
 }
 
+/* Called from output_format -- during diagnostic message processing
+   to handle Fortran specific format specifiers with the following meanings:
+
+   %C  Current locus (no argument)
+*/
+static bool
+gfc_format_decoder (pretty_printer *pp,
+		    text_info *text, const char *spec,
+		    int precision ATTRIBUTE_UNUSED, bool wide ATTRIBUTE_UNUSED,
+		    bool plus ATTRIBUTE_UNUSED, bool hash ATTRIBUTE_UNUSED)
+{
+  switch (*spec)
+    {
+    case 'C':
+      {
+	static const char *result = "(1)";
+	gcc_assert (gfc_current_locus.nextc - gfc_current_locus.lb->line >= 0);
+	unsigned int c1 = gfc_current_locus.nextc - gfc_current_locus.lb->line;
+	gcc_assert (text->locus);
+	*text->locus
+	  = linemap_position_for_loc_and_offset (line_table,
+						 gfc_current_locus.lb->location,
+						 c1);
+	global_dc->caret_char = '1';
+	pp_string (pp, result);
+	return true;
+      }
+    default:
+      return false;
+    }
+}
+
 /* Return a malloc'd string describing a location.  The caller is
    responsible for freeing the memory.  */
 static char *
 gfc_diagnostic_build_prefix (diagnostic_context *context,
 			     const diagnostic_info *diagnostic)
@@ -1354,7 +1387,19 @@  gfc_errors_to_warnings (int f)
 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 = '^';
+}
+
+void
+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 = '^';
 }
Index: gcc/fortran/lang.opt
===================================================================
--- gcc/fortran/lang.opt	(revision 216812)
+++ gcc/fortran/lang.opt	(working copy)
@@ -260,11 +260,11 @@  Warn on intrinsics not part of the selec
 Wmissing-include-dirs
 Fortran
 ; Documented in C/C++
 
 Wuse-without-only
-Fortran Warning
+Fortran Var(warn_use_without_only) Warning
 Warn about USE statements that have no ONLY qualifier
 
 Wopenmp-simd
 Fortran
 ; Documented in C
Index: gcc/fortran/module.c
===================================================================
--- gcc/fortran/module.c	(revision 216812)
+++ gcc/fortran/module.c	(working copy)
@@ -6742,12 +6742,13 @@  gfc_use_module (gfc_use_list *module)
   module_name = module->module_name;
   gfc_rename_list = module->rename;
   only_flag = module->only_flag;
   current_intmod = INTMOD_NONE;
 
-  if (!only_flag && gfc_option.warn_use_without_only) 
-    gfc_warning_now ("USE statement at %C has no ONLY qualifier");
+  if (!only_flag)
+    gfc_warning_now_2 (OPT_Wuse_without_only,
+		       "USE statement at %C has no ONLY qualifier");
 
   filename = XALLOCAVEC (char, strlen (module_name) + strlen (MODULE_EXTENSION)
 			       + 1);
   strcpy (filename, module_name);
   strcat (filename, MODULE_EXTENSION);
Index: gcc/fortran/f95-lang.c
===================================================================
--- gcc/fortran/f95-lang.c	(revision 216812)
+++ gcc/fortran/f95-lang.c	(working copy)
@@ -228,10 +228,14 @@  gfc_be_parse_file (void)
   warningcount += warnings;
 
   /* Clear the binding level stack.  */
   while (!global_bindings_p ())
     poplevel (0, 0);
+
+  /* Switch to the default tree diagnostics here, because there may be
+     diagnostics before gfc_finish().  */
+  gfc_diagnostics_finish ();
 }
 
 
 /* Initialize everything.  */
 
Index: gcc/fortran/parse.c
===================================================================
--- gcc/fortran/parse.c	(revision 216812)
+++ gcc/fortran/parse.c	(working copy)
@@ -548,11 +548,11 @@  decode_statement (void)
 
   /* All else has failed, so give up.  See if any of the matchers has
      stored an error message of some sort.  */
 
   if (gfc_error_check () == 0)
-    gfc_error_now ("Unclassifiable statement at %C");
+    gfc_error_now_2 ("Unclassifiable statement at %C");
 
   reject_statement ();
 
   gfc_error_recovery ();
 
@@ -795,11 +795,11 @@  decode_gcc_attribute (void)
 
   /* All else has failed, so give up.  See if any of the matchers has
      stored an error message of some sort.  */
 
   if (gfc_error_check () == 0)
-    gfc_error_now ("Unclassifiable GCC directive at %C");
+    gfc_error_now_2 ("Unclassifiable GCC directive at %C");
 
   reject_statement ();
 
   gfc_error_recovery ();
 
@@ -834,21 +834,21 @@  next_free (void)
       if (m != MATCH_YES || !gfc_is_whitespace (d))
 	{
 	  gfc_match_small_literal_int (&i, &cnt);
 
 	  if (cnt > 5)
-	    gfc_error_now ("Too many digits in statement label at %C");
+	    gfc_error_now_2 ("Too many digits in statement label at %C");
 
 	  if (i == 0)
-	    gfc_error_now ("Zero is not a valid statement label at %C");
+	    gfc_error_now_2 ("Zero is not a valid statement label at %C");
 
 	  do
 	    c = gfc_next_ascii_char ();
 	  while (ISDIGIT(c));
 
 	  if (!gfc_is_whitespace (c))
-	    gfc_error_now ("Non-numeric character in statement label at %C");
+	    gfc_error_now_2 ("Non-numeric character in statement label at %C");
 
 	  return ST_NONE;
 	}
       else
 	{
@@ -856,11 +856,11 @@  next_free (void)
 
 	  gfc_gobble_whitespace ();
 
 	  if (at_bol && gfc_peek_ascii_char () == ';')
 	    {
-	      gfc_error_now ("Semicolon at %C needs to be preceded by "
+	      gfc_error_now_2 ("Semicolon at %C needs to be preceded by "
 			     "statement");
 	      gfc_next_ascii_char (); /* Eat up the semicolon.  */
 	      return ST_NONE;
 	    }
 
@@ -915,12 +915,12 @@  next_free (void)
     }
  
   if (at_bol && c == ';')
     {
       if (!(gfc_option.allow_std & GFC_STD_F2008))
-	gfc_error_now ("Fortran 2008: Semicolon at %C without preceding "
-		       "statement");
+	gfc_error_now_2 ("Fortran 2008: Semicolon at %C without preceding "
+			 "statement");
       gfc_next_ascii_char (); /* Eat up the semicolon.  */
       return ST_NONE;
     }
 
   return decode_statement ();
@@ -1015,11 +1015,11 @@  next_fixed (void)
     }
 
   if (digit_flag)
     {
       if (label == 0)
-	gfc_warning_now ("Zero is not a valid statement label at %C");
+	gfc_warning_now_2 ("Zero is not a valid statement label at %C");
       else
 	{
 	  /* We've found a valid statement label.  */
 	  gfc_statement_label = gfc_get_st_label (label);
 	}
Index: gcc/fortran/options.c
===================================================================
--- gcc/fortran/options.c	(revision 216812)
+++ gcc/fortran/options.c	(working copy)
@@ -105,11 +105,10 @@  gfc_init_options (unsigned int decoded_o
   gfc_option.warn_line_truncation = 0;
   gfc_option.warn_surprising = 0;
   gfc_option.warn_tabs = 1;
   gfc_option.warn_underflow = 1;
   gfc_option.warn_intrinsic_shadow = 0;
-  gfc_option.warn_use_without_only = 0;
   gfc_option.warn_intrinsics_std = 0;
   gfc_option.warn_align_commons = 1;
   gfc_option.warn_real_q_constant = 0;
   gfc_option.warn_unused_dummy_argument = 0;
   gfc_option.warn_zerotrip = 0;
@@ -735,14 +734,10 @@  gfc_handle_option (size_t scode, const c
 
     case OPT_Wintrinsic_shadow:
       gfc_option.warn_intrinsic_shadow = value;
       break;
 
-    case OPT_Wuse_without_only:
-      gfc_option.warn_use_without_only = value;
-      break;
-
     case OPT_Walign_commons:
       gfc_option.warn_align_commons = value;
       break;
 
     case OPT_Wreal_q_constant:
Index: libcpp/include/line-map.h
===================================================================
--- libcpp/include/line-map.h	(revision 216812)
+++ libcpp/include/line-map.h	(working copy)
@@ -601,10 +601,18 @@  linemap_position_for_column (struct line
    column.  */
 source_location
 linemap_position_for_line_and_column (const struct line_map *,
 				      linenum_type, unsigned int);
 
+/* Encode and return a source_location starting from location LOC and
+   shifting it by OFFSET columns.  This function does not support
+   virtual locations.  */
+source_location
+linemap_position_for_loc_and_offset (struct line_maps *set,
+				     source_location loc,
+				     unsigned int offset);
+
 /* Return the file this map is for.  */
 #define LINEMAP_FILE(MAP)					\
   (linemap_check_ordinary (MAP)->d.ordinary.to_file)
 
 /* Return the line number this map started encoding location from.  */
Index: libcpp/line-map.c
===================================================================
--- libcpp/line-map.c	(revision 216812)
+++ libcpp/line-map.c	(working copy)
@@ -631,10 +631,54 @@  linemap_position_for_line_and_column (co
 	  + ((line - ORDINARY_MAP_STARTING_LINE_NUMBER (map))
 	     << ORDINARY_MAP_NUMBER_OF_COLUMN_BITS (map))
 	  + (column & ((1 << ORDINARY_MAP_NUMBER_OF_COLUMN_BITS (map)) - 1)));
 }
 
+/* Encode and return a source_location starting from location LOC and
+   shifting it by OFFSET columns.  This function does not support
+   virtual locations.  */
+
+source_location
+linemap_position_for_loc_and_offset (struct line_maps *set,
+				     source_location loc,
+				     unsigned int offset)
+{
+  const struct line_map * map = NULL;
+
+  /* This function does not support virtual locations yet.  */
+  linemap_assert (!linemap_location_from_macro_expansion_p (set, loc));
+
+  if (offset == 0
+      /* Adding an offset to a reserved location (like
+	 UNKNOWN_LOCATION for the C/C++ FEs) does not really make
+	 sense.  So let's live the location intact in that case.  */
+      || loc < RESERVED_LOCATION_COUNT)
+    return loc;
+
+  /* First, we find the real location and shift it.  */
+  loc = linemap_resolve_location (set, loc, LRK_SPELLING_LOCATION, &map);
+  /* The new location (loc + offset) should be higher than the first
+     location encoded by MAP.  */
+  linemap_assert (MAP_START_LOCATION (map) < loc + offset);
+
+  /* If MAP is not the last line map of its set, then the new location
+     (loc + offset) should be less than the first location encoded by
+     the next line map of the set.  */
+  if (map < LINEMAPS_LAST_ORDINARY_MAP (set))
+    linemap_assert (MAP_START_LOCATION (&map[1]) < loc + offset);
+
+  offset += SOURCE_COLUMN (map, loc);
+  linemap_assert (offset < (1u << map->d.ordinary.column_bits));
+
+  source_location r = 
+    linemap_position_for_line_and_column (map,
+					  SOURCE_LINE (map, loc),
+					  offset);
+  linemap_assert (map == linemap_lookup (set, r));
+  return r;
+}
+
 /* Given a virtual source location yielded by a map (either an
    ordinary or a macro map), returns that map.  */
 
 const struct line_map*
 linemap_lookup (struct line_maps *set, source_location line)