Re: [PATCH, Fortran] Allow warnings given through gfc_error to associate with warning flags

[Jakub Jelinek <jakub at redhat dot com>]

On Tue, Nov 01, 2016 at 11:10:39AM -0400, Fritz Reese wrote:
> Currently warnings given by the GNU Fortran front-end typically
> indicate which flag controls the warning, if any, as given by the
> first argument to gfc_warning. However, there is no support for
> controlling warnings which are emitted by gfc_error when
> warnings_not_errors is set. Herein I propose a patch such that when a
> call to gfc_error may cause a warning, suppression of the warning can
> be controlled with a -W* warning flag, as with other warnings.
> 
> The simple patch extends the gfc_error interface to also accept an
> additional 'opt' arg, which is passed as the same first argument to
> gfc_warning if warnings_not_errors causes a warning instead of an
> error. The old interface remains, so that a default 'opt' of 0 is
> passed when gfc_error is called with no 'opt' argument. This minimizes
> the impact of the interface change on existing code. Note also that if
> the call to gfc_error would actually cause an error, the warning flag
> will not suppress the error.
> 
> See the patch for details. Bootstraps and regtests on x86_64-redhat-linux.
> 
> Another patch proposal will follow which utilizes this functionality
> to introduce a new warning -W[no-]argument-mismatch, assuming this one
> is OK.

Unfortunately this broke translation handling.  While C++ allows function
overloading, xgettext requires that for a specific function name there is
just a single position of the formatting string in its argument list and a
single position and kind of the arguments (va_list vs. ...).

So, make gcc.pot is right now broken because of this, so it wouldn't be
possible to get GCC 7 translated.

The following patch fixes that (or I'm open for a better name, but it just
can't be called gfc_error).

Bootstrapped/regtested on x86_64-linux and i686-linux, ok for trunk?

2016-12-27  Jakub Jelinek  <jakub@redhat.com>

	* gfortran.h (gfc_error): Rename overload with OPT argument to...
	(gfc_error_opt): ... this.
	* error.c (gfc_error): Rename overloads with OPT argument to...
	(gfc_error_opt): ... this.  Adjust callers.
	(gfc_notify_std, gfc_error): Adjust callers.
	* resolve.c (resolve_structure_cons, resolve_global_procedure): Use
	gfc_error_opt instead of gfc_error.
	* interface.c (argument_rank_mismatch, compare_parameter,
	gfc_check_typebound_override): Likewise.  Fix up formatting.

--- gcc/fortran/gfortran.h.jj	2016-12-16 11:24:34.000000000 +0100
+++ gcc/fortran/gfortran.h	2016-12-27 10:08:56.543172428 +0100
@@ -2793,7 +2793,7 @@ bool gfc_warning_now_at (location_t loc,
 void gfc_clear_warning (void);
 void gfc_warning_check (void);
 
-void gfc_error (int opt, const char *, ...) ATTRIBUTE_GCC_GFC(2,3);
+void gfc_error_opt (int opt, const char *, ...) ATTRIBUTE_GCC_GFC(2,3);
 void gfc_error (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
 void gfc_error_now (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
 void gfc_fatal_error (const char *, ...) ATTRIBUTE_NORETURN ATTRIBUTE_GCC_GFC(1,2);
--- gcc/fortran/error.c.jj	2016-12-12 22:46:52.000000000 +0100
+++ gcc/fortran/error.c	2016-12-27 10:18:06.182182585 +0100
@@ -67,7 +67,7 @@ gfc_push_suppress_errors (void)
 }
 
 static void
-gfc_error (int opt, const char *gmsgid, va_list ap)  ATTRIBUTE_GCC_GFC(2,0);
+gfc_error_opt (int opt, const char *gmsgid, va_list ap)  ATTRIBUTE_GCC_GFC(2,0);
 
 static bool
 gfc_warning (int opt, const char *gmsgid, va_list ap) ATTRIBUTE_GCC_GFC(2,0);
@@ -902,7 +902,7 @@ gfc_notify_std (int std, const char *gms
   if (warning)
     gfc_warning (0, buffer, argp);
   else
-    gfc_error (0, buffer, argp);
+    gfc_error_opt (0, buffer, argp);
   va_end (argp);
 
   return (warning && !warnings_are_errors) ? true : false;
@@ -1252,7 +1252,7 @@ gfc_warning_check (void)
 /* Issue an error.  */
 
 static void
-gfc_error (int opt, const char *gmsgid, va_list ap)
+gfc_error_opt (int opt, const char *gmsgid, va_list ap)
 {
   va_list argp;
   va_copy (argp, ap);
@@ -1308,11 +1308,11 @@ gfc_error (int opt, const char *gmsgid,
 
 
 void
-gfc_error (int opt, const char *gmsgid, ...)
+gfc_error_opt (int opt, const char *gmsgid, ...)
 {
   va_list argp;
   va_start (argp, gmsgid);
-  gfc_error (opt, gmsgid, argp);
+  gfc_error_opt (opt, gmsgid, argp);
   va_end (argp);
 }
 
@@ -1322,7 +1322,7 @@ gfc_error (const char *gmsgid, ...)
 {
   va_list argp;
   va_start (argp, gmsgid);
-  gfc_error (0, gmsgid, argp);
+  gfc_error_opt (0, gmsgid, argp);
   va_end (argp);
 }
 
--- gcc/fortran/resolve.c.jj	2016-12-14 20:28:15.000000000 +0100
+++ gcc/fortran/resolve.c	2016-12-27 10:15:56.877825156 +0100
@@ -1312,10 +1312,10 @@ resolve_structure_cons (gfc_expr *expr,
 	  if (s2 && !gfc_compare_interfaces (comp->ts.interface, s2, name, 0, 1,
 					     err, sizeof (err), NULL, NULL))
 	    {
-	      gfc_error (OPT_Wargument_mismatch,
-			 "Interface mismatch for procedure-pointer component "
-			 "%qs in structure constructor at %L: %s",
-			 comp->name, &cons->expr->where, err);
+	      gfc_error_opt (OPT_Wargument_mismatch,
+			     "Interface mismatch for procedure-pointer "
+			     "component %qs in structure constructor at %L:"
+			     " %s", comp->name, &cons->expr->where, err);
 	      return false;
 	    }
 	}
@@ -2466,9 +2466,9 @@ resolve_global_procedure (gfc_symbol *sy
       if (!gfc_compare_interfaces (sym, def_sym, sym->name, 0, 1,
 				   reason, sizeof(reason), NULL, NULL))
 	{
-	  gfc_error (OPT_Wargument_mismatch,
-		     "Interface mismatch in global procedure %qs at %L: %s ",
-		    sym->name, &sym->declared_at, reason);
+	  gfc_error_opt (OPT_Wargument_mismatch,
+			 "Interface mismatch in global procedure %qs at %L:"
+			 " %s ", sym->name, &sym->declared_at, reason);
 	  goto done;
 	}
 
--- gcc/fortran/interface.c.jj	2016-12-20 10:52:38.000000000 +0100
+++ gcc/fortran/interface.c	2016-12-27 10:14:39.481808717 +0100
@@ -2125,25 +2125,17 @@ argument_rank_mismatch (const char *name
 
   /* TS 29113, C407b.  */
   if (rank2 == -1)
-    {
-      gfc_error ("The assumed-rank array at %L requires that the dummy argument"
-		 " %qs has assumed-rank", where, name);
-    }
+    gfc_error ("The assumed-rank array at %L requires that the dummy argument"
+	       " %qs has assumed-rank", where, name);
   else if (rank1 == 0)
-    {
-      gfc_error (OPT_Wargument_mismatch, "Rank mismatch in argument %qs at %L "
-		 "(scalar and rank-%d)", name, where, rank2);
-    }
+    gfc_error_opt (OPT_Wargument_mismatch, "Rank mismatch in argument %qs "
+		   "at %L (scalar and rank-%d)", name, where, rank2);
   else if (rank2 == 0)
-    {
-      gfc_error (OPT_Wargument_mismatch, "Rank mismatch in argument %qs at %L "
-		 "(rank-%d and scalar)", name, where, rank1);
-    }
+    gfc_error_opt (OPT_Wargument_mismatch, "Rank mismatch in argument %qs "
+		   "at %L (rank-%d and scalar)", name, where, rank1);
   else
-    {
-      gfc_error (OPT_Wargument_mismatch, "Rank mismatch in argument %qs at %L "
-		 "(rank-%d and rank-%d)", name, where, rank1, rank2);
-    }
+    gfc_error_opt (OPT_Wargument_mismatch, "Rank mismatch in argument %qs "
+		   "at %L (rank-%d and rank-%d)", name, where, rank1, rank2);
 }
 
 
@@ -2192,9 +2184,9 @@ compare_parameter (gfc_symbol *formal, g
 				   sizeof(err), NULL, NULL))
 	{
 	  if (where)
-	    gfc_error (OPT_Wargument_mismatch,
-		       "Interface mismatch in dummy procedure %qs at %L: %s",
-		       formal->name, &actual->where, err);
+	    gfc_error_opt (OPT_Wargument_mismatch,
+			   "Interface mismatch in dummy procedure %qs at %L:"
+			   " %s", formal->name, &actual->where, err);
 	  return false;
 	}
 
@@ -2220,9 +2212,9 @@ compare_parameter (gfc_symbol *formal, g
 				   err, sizeof(err), NULL, NULL))
 	{
 	  if (where)
-	    gfc_error (OPT_Wargument_mismatch,
-		       "Interface mismatch in dummy procedure %qs at %L: %s",
-		       formal->name, &actual->where, err);
+	    gfc_error_opt (OPT_Wargument_mismatch,
+			   "Interface mismatch in dummy procedure %qs at %L:"
+			   " %s", formal->name, &actual->where, err);
 	  return false;
 	}
     }
@@ -2251,10 +2243,10 @@ compare_parameter (gfc_symbol *formal, g
 					 CLASS_DATA (actual)->ts.u.derived)))
     {
       if (where)
-	gfc_error (OPT_Wargument_mismatch,
-		   "Type mismatch in argument %qs at %L; passed %s to %s",
-		   formal->name, where, gfc_typename (&actual->ts),
-		   gfc_typename (&formal->ts));
+	gfc_error_opt (OPT_Wargument_mismatch,
+		       "Type mismatch in argument %qs at %L; passed %s to %s",
+		       formal->name, where, gfc_typename (&actual->ts),
+		       gfc_typename (&formal->ts));
       return false;
     }
 
@@ -4551,9 +4543,9 @@ gfc_check_typebound_override (gfc_symtre
       if (!gfc_check_dummy_characteristics (proc_formal->sym, old_formal->sym,
 					check_type, err, sizeof(err)))
 	{
-	  gfc_error (OPT_Wargument_mismatch,
-		     "Argument mismatch for the overriding procedure "
-		     "%qs at %L: %s", proc->name, &where, err);
+	  gfc_error_opt (OPT_Wargument_mismatch,
+			 "Argument mismatch for the overriding procedure "
+			 "%qs at %L: %s", proc->name, &where, err);
 	  return false;
 	}
 


	Jakub