This is just a RFC so no Changelog yet. It bootstraps and passes the
testsuite. I have three major questions:

* Dodji: Do the common diagnostics part look reasonable? I tried to be
as least invasive as possible. If you have comments or suggestions
they are very welcome.

* Fortran devs: Is this approach acceptable? The main idea is to have
an output_buffer called pp_warning_buffer with the flush_p bit unset
if we are buffering. When printing buffered warnings, use this
output_buffer in the global_dc->printer instead of the (unbuffered
one) used by the *_now variants. In principle this could support
several buffered diagnostics, but Fortran only seems to buffer at most
one.

The ugliest part is how to handle warningcount and werrorcount. I
could handle this in the common machinery in a better way by storing
DK_WERROR in the diagnostic->kind and checking it after printing. This
way we can first decrease both counters, then increase back the one
not changed and store the kind somewhere. then if the diagnostic is
canceled nothing is done, if it is flushed, then increase the
appropriate counter (perhaps calling into the common part for any post
action due to Wfatal-errors or -fmax-errors=).

I can also hide the output_buffer switching inside two helper
functions, but the helper function would need to use either a static
variable or a global one to save and restore the tmp_buffer. I'm not
sure that is better or worse (the current code uses a global pointer
&cur_error_buffer, so perhaps I should have used a similar approach).

* Fortran devs #2: The testsuite is testing that the warning is
eventually printed. However, I'm not sure it is testing when the
warning is buffered and then discarded, is it? If not, how can I
produce such a test?

Thanks,

Manuel.
Index: gcc/pretty-print.c
===================================================================
--- gcc/pretty-print.c  (revision 218090)
+++ gcc/pretty-print.c  (working copy)
@@ -40,7 +40,8 @@
     cur_chunk_array (),
     stream (stderr),
     line_length (),
-    digit_buffer ()
+    digit_buffer (),
+    flush_p (true)
 {
   obstack_init (&formatted_obstack);
   obstack_init (&chunk_obstack);
@@ -679,12 +680,25 @@
   pp_wrapping_mode (pp) = oldmode;
 }
 
-/* Flush the content of BUFFER onto the attached stream.  */
+/* Flush the content of BUFFER onto the attached stream.  This
+   function does nothing unless pp->output_buffer->flush_p.  */
 void
 pp_flush (pretty_printer *pp)
 {
+  pp_clear_state (pp);
+  if (!pp->buffer->flush_p)
+    return;
   pp_write_text_to_stream (pp);
+  fflush (pp_buffer (pp)->stream);
+}
+
+/* Flush the content of BUFFER onto the attached stream independently
+   of the value of pp->output_buffer->flush_p.  */
+void
+pp_really_flush (pretty_printer *pp)
+{
   pp_clear_state (pp);
+  pp_write_text_to_stream (pp);
   fflush (pp_buffer (pp)->stream);
 }
 
Index: gcc/pretty-print.h
===================================================================
--- gcc/pretty-print.h  (revision 218090)
+++ gcc/pretty-print.h  (working copy)
@@ -100,6 +100,11 @@
   /* This must be large enough to hold any printed integer or
      floating-point value.  */
   char digit_buffer[128];
+
+  /* Nonzero means that text should be flushed when
+     appropriate. Otherwise, text is buffered until either
+     pp_pp_really_flush or pp_clear_output_area are called. */
+  bool flush_p;
 };
 
 /* The type of pretty-printer flags passed to clients.  */
@@ -314,6 +319,7 @@
 extern void pp_verbatim (pretty_printer *, const char *, ...)
      ATTRIBUTE_GCC_PPDIAG(2,3);
 extern void pp_flush (pretty_printer *);
+extern void pp_really_flush (pretty_printer *);
 extern void pp_format (pretty_printer *, text_info *);
 extern void pp_output_formatted_text (pretty_printer *);
 extern void pp_format_verbatim (pretty_printer *, text_info *);
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h      (revision 218090)
+++ gcc/fortran/gfortran.h      (working copy)
@@ -2443,7 +2443,6 @@
   int dump_fortran_optimized;
 
   int warn_aliasing;
-  int warn_ampersand;
   int warn_function_elimination;
   int warn_implicit_interface;
   int warn_implicit_procedure;
@@ -2691,6 +2690,7 @@
 const char *gfc_print_wide_char (gfc_char_t);
 
 void gfc_warning (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
+bool gfc_warning_1 (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 (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
 bool gfc_warning_now (int opt, const char *, ...) ATTRIBUTE_GCC_GFC(2,3);
@@ -2719,7 +2719,7 @@
 void gfc_free_error (gfc_error_buf *);
 
 void gfc_get_errors (int *, int *);
-void gfc_errors_to_warnings (int);
+void gfc_errors_to_warnings (bool);
 
 /* arith.c */
 void gfc_arith_init_1 (void);
Index: gcc/fortran/error.c
===================================================================
--- gcc/fortran/error.c (revision 218090)
+++ gcc/fortran/error.c (working copy)
@@ -50,7 +50,11 @@
 
 static gfc_error_buf error_buffer, warning_buffer, *cur_error_buffer;
 
+static output_buffer pp_warning_buffer;
+static int warningcount_buffered, werrorcount_buffered;
 
+#include <new> /* For placement-new */
+
 /* Go one level deeper suppressing errors.  */
 
 void
@@ -122,6 +126,7 @@
 gfc_buffer_error (int flag)
 {
   buffer_flag = flag;
+  pp_warning_buffer.flush_p = !flag;
 }
 
 
@@ -833,6 +838,52 @@
 }
 
 
+/* Issue a warning.  */
+
+bool
+gfc_warning_1 (int opt, const char *gmsgid, ...)
+{
+  va_list argp;
+  diagnostic_info diagnostic;
+  bool ret;
+  bool fatal_errors = global_dc->fatal_errors;
+  pretty_printer *pp = global_dc->printer;
+  output_buffer *tmp_buffer = pp->buffer;
+  int warningcount_saved = 0;
+  int werrorcount_saved = 0;
+
+  if (!pp_warning_buffer.flush_p)
+    {
+      warningcount_saved = warningcount;
+      werrorcount_saved = werrorcount;
+      /* To prevent -fmax-errors= triggering.  */
+      werrorcount--;
+      pp->buffer = &pp_warning_buffer;
+      global_dc->fatal_errors = false;
+    }
+
+  va_start (argp, gmsgid);
+  diagnostic_set_info (&diagnostic, gmsgid, &argp, UNKNOWN_LOCATION,
+                      DK_WARNING);
+  diagnostic.option_index = opt;
+  ret = report_diagnostic (&diagnostic);
+
+  if (!pp_warning_buffer.flush_p)
+    {
+      warningcount_buffered = warningcount - warningcount_saved;
+      warningcount = warningcount_saved;
+      werrorcount++; /* Undo the above werrorcount-- */
+      werrorcount_buffered = werrorcount - werrorcount_saved;
+      werrorcount = werrorcount_saved;
+
+      pp->buffer = tmp_buffer;
+      global_dc->fatal_errors = fatal_errors;
+    }
+  
+  va_end (argp);
+  return ret;
+}
+
 /* Whether, for a feature included in a given standard set (GFC_STD_*),
    we should issue an error or a warning, or be quiet.  */
 
@@ -1176,6 +1227,15 @@
 gfc_clear_warning (void)
 {
   warning_buffer.flag = 0;
+  
+  pretty_printer *pp = global_dc->printer;
+  output_buffer *tmp_buffer = pp->buffer;
+  pp->buffer = &pp_warning_buffer;
+  pp_clear_output_area (pp);
+  pp->buffer = tmp_buffer;
+  pp_warning_buffer.flush_p = false;
+  warningcount_buffered = 0;
+  werrorcount_buffered = 0;
 }
 
 
@@ -1192,6 +1252,20 @@
        fputs (warning_buffer.message, stderr);
       warning_buffer.flag = 0;
     }
+
+  /* This is for the new diagnostics machinery.  */
+  pretty_printer *pp = global_dc->printer;
+  output_buffer *tmp_buffer = pp->buffer;
+  pp->buffer = &pp_warning_buffer;
+  if (pp_last_position_in_text (pp) != NULL)
+    {
+      pp_really_flush (pp);
+      pp_warning_buffer.flush_p = true;
+      warningcount += warningcount_buffered;
+      werrorcount += werrorcount_buffered;
+    }
+
+  pp->buffer = tmp_buffer;
 }
 
 
@@ -1395,9 +1469,9 @@
 /* Switch errors into warnings.  */
 
 void
-gfc_errors_to_warnings (int f)
+gfc_errors_to_warnings (bool f)
 {
-  warnings_not_errors = (f == 1) ? 1 : 0;
+  warnings_not_errors = f;
 }
 
 void
@@ -1407,6 +1481,7 @@
   diagnostic_finalizer (global_dc) = gfc_diagnostic_finalizer;
   diagnostic_format_decoder (global_dc) = gfc_format_decoder;
   global_dc->caret_char = '^';
+  new (&pp_warning_buffer) output_buffer ();
 }
 
 void
Index: gcc/fortran/lang.opt
===================================================================
--- gcc/fortran/lang.opt        (revision 218090)
+++ gcc/fortran/lang.opt        (working copy)
@@ -202,9 +202,13 @@
 Warn about alignment of COMMON blocks
 
 Wampersand
-Fortran Warning
+Fortran Warning Var(warn_ampersand) LangEnabledBy(Fortran, Wpedantic)
 Warn about missing ampersand in continued character constants
 
+Wampersand
+LangEnabledBy(Fortran, Wall)
+;
+
 Warray-temporaries
 Fortran Warning
 Warn about creation of array temporaries
Index: gcc/fortran/scanner.c
===================================================================
--- gcc/fortran/scanner.c       (revision 218090)
+++ gcc/fortran/scanner.c       (working copy)
@@ -1154,9 +1154,10 @@
          if (in_string)
            {
              gfc_current_locus.nextc--;
-             if (gfc_option.warn_ampersand && in_string == INSTRING_WARN)
-               gfc_warning ("Missing '&' in continued character "
-                            "constant at %C");
+             if (warn_ampersand && in_string == INSTRING_WARN)
+               gfc_warning_1 (OPT_Wampersand,
+                              "Missing %<&%> in continued character "
+                              "constant at %C");
            }
          /* Both !$omp and !$ -fopenmp continuation lines have & on the
             continuation line only optionally.  */
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c       (revision 218090)
+++ gcc/fortran/resolve.c       (working copy)
@@ -2431,7 +2431,7 @@
 
       if (!pedantic && (gfc_option.allow_std & GFC_STD_GNU))
        /* Turn erros into warnings with -std=gnu and -std=legacy.  */
-       gfc_errors_to_warnings (1);
+       gfc_errors_to_warnings (true);
 
       if (!gfc_compare_interfaces (sym, def_sym, sym->name, 0, 1,
                                   reason, sizeof(reason), NULL, NULL))
@@ -2444,14 +2444,14 @@
       if (!pedantic
          || ((gfc_option.warn_std & GFC_STD_LEGACY)
              && !(gfc_option.warn_std & GFC_STD_GNU)))
-       gfc_errors_to_warnings (1);
+       gfc_errors_to_warnings (true);
 
       if (sym->attr.if_source != IFSRC_IFBODY)
        gfc_procedure_use (def_sym, actual, where);
     }
 
 done:
-  gfc_errors_to_warnings (0);
+  gfc_errors_to_warnings (false);
 
   if (gsym->type == GSYM_UNKNOWN)
     {
Index: gcc/fortran/primary.c
===================================================================
--- gcc/fortran/primary.c       (revision 218090)
+++ gcc/fortran/primary.c       (working copy)
@@ -951,7 +951,7 @@
 match_string_constant (gfc_expr **result)
 {
   char name[GFC_MAX_SYMBOL_LEN + 1], peek;
-  int i, kind, length, warn_ampersand, ret;
+  int i, kind, length, warn_ampersand_saved, ret;
   locus old_locus, start_locus;
   gfc_symbol *sym;
   gfc_expr *e;
@@ -1071,8 +1071,8 @@
 
   /* We disable the warning for the following loop as the warning has already
      been printed in the loop above.  */
-  warn_ampersand = gfc_option.warn_ampersand;
-  gfc_option.warn_ampersand = 0;
+  warn_ampersand_saved = warn_ampersand;
+  warn_ampersand = false;
 
   p = e->value.character.string;
   for (i = 0; i < length; i++)
@@ -1091,7 +1091,7 @@
     }
 
   *p = '\0';   /* TODO: C-style string is for development/debug purposes.  */
-  gfc_option.warn_ampersand = warn_ampersand;
+  warn_ampersand = warn_ampersand_saved;
 
   next_string_char (delimiter, &ret);
   if (ret != -1)
Index: gcc/fortran/options.c
===================================================================
--- gcc/fortran/options.c       (revision 218090)
+++ gcc/fortran/options.c       (working copy)
@@ -94,7 +94,6 @@
   gfc_option.dump_fortran_optimized = 0;
 
   gfc_option.warn_aliasing = 0;
-  gfc_option.warn_ampersand = 0;
   gfc_option.warn_array_temp = 0;
   gfc_option.warn_function_elimination = 0;
   gfc_option.warn_implicit_interface = 0;
@@ -423,9 +422,6 @@
   if (!gfc_option.flag_automatic)
     gfc_option.flag_max_stack_var_size = 0;
   
-  if (pedantic)
-    gfc_option.warn_ampersand = 1;
-
   /* Optimization implies front end optimization, unless the user
      specified it directly.  */
 
@@ -447,7 +443,6 @@
 set_Wall (int setting)
 {
   gfc_option.warn_aliasing = setting;
-  gfc_option.warn_ampersand = setting;
   gfc_option.warn_line_truncation = setting;
   gfc_option.warn_surprising = setting;
   gfc_option.warn_underflow = setting;
@@ -642,10 +637,6 @@
       gfc_option.warn_aliasing = value;
       break;
 
-    case OPT_Wampersand:
-      gfc_option.warn_ampersand = value;
-      break;
-
     case OPT_Warray_temporaries:
       gfc_option.warn_array_temp = value;
       break;
@@ -1003,7 +994,7 @@
       gfc_option.max_continue_fixed = 19;
       gfc_option.max_continue_free = 39;
       gfc_option.max_identifier_length = 31;
-      gfc_option.warn_ampersand = 1;
+      warn_ampersand = 1;
       warn_tabs = 1;
       break;
 
@@ -1012,7 +1003,7 @@
        | GFC_STD_F2003 | GFC_STD_F95 | GFC_STD_F2008_OBS;
       gfc_option.warn_std = GFC_STD_F95_OBS;
       gfc_option.max_identifier_length = 63;
-      gfc_option.warn_ampersand = 1;
+      warn_ampersand = 1;
       warn_tabs = 1;
       break;
 
@@ -1021,7 +1012,7 @@
        | GFC_STD_F2003 | GFC_STD_F95 | GFC_STD_F2008 | GFC_STD_F2008_OBS;
       gfc_option.warn_std = GFC_STD_F95_OBS | GFC_STD_F2008_OBS;
       gfc_option.max_identifier_length = 63;
-      gfc_option.warn_ampersand = 1;
+      warn_ampersand = 1;
       warn_tabs = 1;
       break;
 
@@ -1031,7 +1022,7 @@
        | GFC_STD_F2008_TS;
       gfc_option.warn_std = GFC_STD_F95_OBS | GFC_STD_F2008_OBS;
       gfc_option.max_identifier_length = 63;
-      gfc_option.warn_ampersand = 1;
+      warn_ampersand = 1;
       warn_tabs = 1;
       break;
 

Reply via email to