errorout: count max number of errors, limit errors.

3 files changed, 66 insertions, 46 deletions

diff --git a/src/vhdl/errorout-console.adb b/src/vhdl/errorout-console.adb
index cbb2b1bd5..0e9694811 100644
--- a/src/vhdl/errorout-console.adb
+++ b/src/vhdl/errorout-console.adb
@@ -189,47 +189,34 @@ package body Errorout.Console is
       end if;
 
       --  Display level.
-      declare
-         Id_Level : Msgid_Type;
-      begin
-         if Flags.Warn_Error
-           and then (E.Id = Msgid_Warning or E.Id in Msgid_Warnings)
-         then
-            Id_Level := Msgid_Error;
-         else
-            Id_Level := E.Id;
-         end if;
-
-         case Id_Level is
-            when Msgid_Note =>
-               if Flag_Color_Diagnostics = On then
-                  Set_Color (Color_Note);
-               end if;
-               Put ("note:");
-            when Msgid_Warning | Msgid_Warnings =>
-               if Flag_Color_Diagnostics = On then
-                  Set_Color (Color_Warning);
-               end if;
-               Put ("warning:");
-            when Msgid_Error =>
-               Nbr_Errors := Nbr_Errors + 1;
-               if Flag_Color_Diagnostics = On then
-                  Set_Color (Color_Error);
-               end if;
-               if Msg_Len = 0
-                 or else Flag_Color_Diagnostics = On
-               then
-                  --  'error:' is displayed only if not location is present, or
-                  --  if messages are colored.
-                  Put ("error:");
-               end if;
-            when Msgid_Fatal =>
-               if Flag_Color_Diagnostics = On then
-                  Set_Color (Color_Fatal);
-               end if;
-               Put ("fatal:");
-         end case;
-      end;
+      case E.Id is
+         when Msgid_Note =>
+            if Flag_Color_Diagnostics = On then
+               Set_Color (Color_Note);
+            end if;
+            Put ("note:");
+         when Msgid_Warning | Msgid_Warnings =>
+            if Flag_Color_Diagnostics = On then
+               Set_Color (Color_Warning);
+            end if;
+            Put ("warning:");
+         when Msgid_Error =>
+            if Flag_Color_Diagnostics = On then
+               Set_Color (Color_Error);
+            end if;
+            if Msg_Len = 0
+              or else Flag_Color_Diagnostics = On
+            then
+               --  'error:' is displayed only if not location is present, or
+               --  if messages are colored.
+               Put ("error:");
+            end if;
+         when Msgid_Fatal =>
+            if Flag_Color_Diagnostics = On then
+               Set_Color (Color_Fatal);
+            end if;
+            Put ("fatal:");
+      end case;
 
       if Flag_Color_Diagnostics = On then
          Set_Color (Color_Message);
diff --git a/src/vhdl/errorout.adb b/src/vhdl/errorout.adb
index e31bf4477..33804e1a6 100644
--- a/src/vhdl/errorout.adb
+++ b/src/vhdl/errorout.adb
@@ -215,10 +215,30 @@ package body Errorout is
 
       File : Source_File_Entry;
       Line : Natural;
+      New_Id : Msgid_Type;
       Offset : Natural;
       Line_Pos : Source_Ptr;
       pragma Unreferenced (Line_Pos);
    begin
+      --  Reclassify warnings to errors if -Werror.
+      if Flags.Warn_Error
+        and then (Id = Msgid_Warning or Id in Msgid_Warnings)
+      then
+         New_Id := Msgid_Error;
+      else
+         New_Id := Id;
+      end if;
+      pragma Unreferenced (Id);
+
+      --  Limit the number of errors.
+      if not Cont and then New_Id = Msgid_Error then
+         Nbr_Errors := Nbr_Errors + 1;
+         if Nbr_Errors > Max_Nbr_Errors then
+            return;
+         end if;
+      end if;
+
+      --  Set error location.
       File := No_Source_File_Entry;
       Line := 0;
       Offset := 0;
@@ -253,7 +273,7 @@ package body Errorout is
       end case;
 
       Report_Handler.Error_Start
-        (Err => (Origin, Id, Cont, File, Line, Offset));
+        (Err => (Origin, New_Id, Cont, File, Line, Offset));
 
       --  Display message.
       declare
@@ -410,6 +430,17 @@ package body Errorout is
       end;
 
       Report_Handler.Message_End.all;
+
+      if not Cont
+        and then New_Id = Msgid_Error
+        and then Nbr_Errors = Max_Nbr_Errors
+      then
+         --  Limit reached.  Emit a message.
+         Report_Handler.Error_Start
+           (Err => (Origin, Msgid_Error, False, File, Line, Offset));
+         Report_Handler.Message ("error limit reached");
+         Report_Handler.Message_End.all;
+      end if;
    end Report_Msg;
 
    procedure Error_Msg_Option_NR (Msg: String) is
diff --git a/src/vhdl/errorout.ads b/src/vhdl/errorout.ads
index eb9c2a7a3..cdbb482a2 100644
--- a/src/vhdl/errorout.ads
+++ b/src/vhdl/errorout.ads
@@ -23,15 +23,17 @@ package Errorout is
    Option_Error: exception;
    Compilation_Error: exception;
 
-   -- This kind can't be handled.
-   --procedure Error_Kind (Msg: String; Kind: Iir_Kind);
+   --  This kind can't be handled.
    procedure Error_Kind (Msg: String; An_Iir: in Iir);
    procedure Error_Kind (Msg: String; Def : Iir_Predefined_Functions);
    procedure Error_Kind (Msg : String; N : PSL_Node);
    pragma No_Return (Error_Kind);
 
-   -- The number of errors (ie, number of calls to error_msg*).
-   Nbr_Errors: Natural := 0;
+   --  The number of errors (ie, number of calls to error_msg*).
+   Nbr_Errors : Natural := 0;
+
+   --  Maximum number of errors, before silent them.
+   Max_Nbr_Errors : constant Natural := 100;
 
    type Msgid_Type is
      (--  Any note