From 8d3d2c734d5d5e7e3ac4a14dd691ba8175de67b3 Mon Sep 17 00:00:00 2001
From: Tristan Gingold <tgingold@free.fr>
Date: Mon, 13 May 2019 18:27:55 +0200
Subject: options: support -Werror=WARN to transform one warning into an error.

---
 src/errorout.adb | 17 +++++++++++------
 src/errorout.ads | 12 +++++++++---
 src/flags.ads    |  4 ----
 src/options.adb  | 17 ++++++++++++++++-
 4 files changed, 36 insertions(+), 14 deletions(-)

(limited to 'src')

diff --git a/src/errorout.adb b/src/errorout.adb
index 7906aadba..55ac6c814 100644
--- a/src/errorout.adb
+++ b/src/errorout.adb
@@ -18,7 +18,6 @@
 
 with Name_Table;
 with Files_Map; use Files_Map;
-with Flags; use Flags;
 with Str_Table;
 
 with Vhdl.Errors; use Vhdl.Errors;
@@ -65,6 +64,16 @@ package body Errorout is
       return Warnings_Control (Id).Enabled;
    end Is_Warning_Enabled;
 
+   procedure Warning_Error (Id : Msgid_All_Warnings; As_Error : Boolean) is
+   begin
+      Warnings_Control (Id).Error := As_Error;
+   end Warning_Error;
+
+   function Is_Warning_Error (Id : Msgid_All_Warnings) return Boolean is
+   begin
+      return Warnings_Control (Id).Error;
+   end Is_Warning_Error;
+
    function Warning_Image (Id : Msgid_Warnings) return String
    is
       Img : constant String := Msgid_Warnings'Image (Id);
@@ -166,9 +175,7 @@ package body Errorout is
       end if;
 
       --  Reclassify warnings to errors if -Werror.
-      if Flags.Warn_Error
-        and then (Id = Msgid_Warning or Id in Msgid_Warnings)
-      then
+      if Id in Msgid_All_Warnings and then Is_Warning_Error (Id) then
          New_Id := Msgid_Error;
       else
          New_Id := Id;
@@ -400,6 +407,4 @@ package body Errorout is
    begin
       return (Kind => Earg_Token, Val_Tok => V);
    end Make_Earg_Vhdl_Token;
-
-
 end Errorout;
diff --git a/src/errorout.ads b/src/errorout.ads
index 5cde16c5e..88b82b18a 100644
--- a/src/errorout.ads
+++ b/src/errorout.ads
@@ -122,6 +122,9 @@ package Errorout is
    subtype Msgid_Warnings is Msgid_Type
      range Warnid_Library .. Warnid_Static;
 
+   subtype Msgid_All_Warnings is Msgid_Type
+     range Msgid_Warnings'First .. Msgid_Warning;
+
    --  Get the image of a warning.  This correspond the the identifier of ID,
    --  in lower case, without the Msgid_Warn_ prefix and with '_' replaced
    --  by '-'.
@@ -133,6 +136,9 @@ package Errorout is
    --  Get enable status of a warning.
    function Is_Warning_Enabled (Id : Msgid_Warnings) return Boolean;
 
+   --  Consider a warning as an error.
+   procedure Warning_Error (Id : Msgid_All_Warnings; As_Error : Boolean);
+
    --  State of warnings.
    type Warnings_Setting is private;
 
@@ -262,12 +268,12 @@ private
       Error : Boolean;
    end record;
 
-   type Warnings_Setting is array (Msgid_Warnings) of Warning_Control_Type;
+   type Warnings_Setting is array (Msgid_All_Warnings) of Warning_Control_Type;
 
    Default_Warnings : constant Warnings_Setting :=
      (Warnid_Library | Warnid_Binding | Warnid_Port | Warnid_Shared
-        | Warnid_Runtime_Error | Warnid_Pure | Warnid_Specs
-        | Warnid_Hide    => (Enabled => True, Error => False),
+        | Warnid_Runtime_Error | Warnid_Pure | Warnid_Specs | Warnid_Hide
+        | Msgid_Warning  => (Enabled => True, Error => False),
       others             => (Enabled => False, Error => False));
 
    --  Compute the column from Error_Record E.
diff --git a/src/flags.ads b/src/flags.ads
index 096d889c0..5ad2ece2b 100644
--- a/src/flags.ads
+++ b/src/flags.ads
@@ -151,10 +151,6 @@ package Flags is
    -- --warn-undriven
    --Warn_Undriven : Boolean := False;
 
-   --  --warn-error
-   --  Turns warnings into errors.
-   Warn_Error : Boolean := False;
-
    --  If True, disp original source line and a caret indicating the column.
    Flag_Caret_Diagnostics : Boolean := False;
 
diff --git a/src/options.adb b/src/options.adb
index 553a95545..32d3ca6f1 100644
--- a/src/options.adb
+++ b/src/options.adb
@@ -41,10 +41,25 @@ package body Options is
    begin
       --  Handle -Werror.
       if Opt = "error" then
-         Warn_Error := Val;
+         for I in Msgid_Warnings loop
+            Warning_Error (I, Val);
+         end loop;
          return True;
       end if;
 
+      --  Handle -Werror=xxx
+      if Opt'Length >= 6
+        and then Opt (Opt'First .. Opt'First + 5) = "error="
+      then
+         for I in Msgid_Warnings loop
+            if Warning_Image (I) = Opt (Opt'First + 6 .. Opt'Last) then
+               Warning_Error (I, Val);
+               return True;
+            end if;
+         end loop;
+         return False;
+      end if;
+
       --  Normal warnings.
       for I in Msgid_Warnings loop
          if Warning_Image (I) = Opt then
-- 
cgit v1.2.3