Add --ieee-asserts= option.

Correctly elaborate anonymous subtypes in associations.

5 files changed, 66 insertions, 8 deletions

diff --git a/translate/grt/grt-lib.adb b/translate/grt/grt-lib.adb
index d1de1d7a3..0d1507ff0 100644
--- a/translate/grt/grt-lib.adb
+++ b/translate/grt/grt-lib.adb
@@ -32,13 +32,37 @@ package body Grt.Lib is
       Memmove (Dest, Src, Size);
    end Ghdl_Memcpy;
 
+   Ieee_Name : constant String := "ieee" & NUL;
+
    procedure Do_Report (Msg : String;
                         Str : Std_String_Ptr;
                         Severity : Integer;
-                        Loc : Ghdl_Location_Ptr)
+                        Loc : Ghdl_Location_Ptr;
+                        Unit : Ghdl_Rti_Access)
    is
+      use Grt.Options;
       Level : Integer := Severity mod 256;
    begin
+      --  Assertions from ieee library can be disabled.
+      if Unit /= null
+        and then Unit.Kind = Ghdl_Rtik_Package_Body
+        and then (Ieee_Asserts = Disable_Asserts
+                    or (Ieee_Asserts = Disable_Asserts_At_Time_0
+                          and Current_Time = 0))
+      then
+         declare
+            Blk : Ghdl_Rtin_Block_Acc := To_Ghdl_Rtin_Block_Acc (Unit);
+            Pkg : Ghdl_Rtin_Block_Acc := To_Ghdl_Rtin_Block_Acc (Blk.Parent);
+            Lib : Ghdl_Rtin_Type_Scalar_Acc :=
+              To_Ghdl_Rtin_Type_Scalar_Acc (Pkg.Parent);
+         begin
+            --  Return now if this assert comes from the ieee library.
+            if Strcmp (Lib.Name, To_Ghdl_C_String (Ieee_Name'Address)) = 0 then
+               return;
+            end if;
+         end;
+      end if;
+
       Report_H;
       Report_C (Loc.Filename);
       Report_C (":");
@@ -71,17 +95,23 @@ package body Grt.Lib is
    end Do_Report;
 
    procedure Ghdl_Assert_Failed
-     (Str : Std_String_Ptr; Severity : Integer; Loc : Ghdl_Location_Ptr)
+     (Str : Std_String_Ptr;
+      Severity : Integer;
+      Loc : Ghdl_Location_Ptr;
+      Unit : Ghdl_Rti_Access)
    is
    begin
-      Do_Report ("assertion", Str, Severity, Loc);
+      Do_Report ("assertion", Str, Severity, Loc, Unit);
    end Ghdl_Assert_Failed;
 
    procedure Ghdl_Report
-     (Str : Std_String_Ptr; Severity : Integer; Loc : Ghdl_Location_Ptr)
+     (Str : Std_String_Ptr;
+      Severity : Integer;
+      Loc : Ghdl_Location_Ptr;
+      Unit : Ghdl_Rti_Access)
    is
    begin
-      Do_Report ("report", Str, Severity, Loc);
+      Do_Report ("report", Str, Severity, Loc, Unit);
    end Ghdl_Report;
 
    procedure Ghdl_Program_Error (Filename : Ghdl_C_String;
diff --git a/translate/grt/grt-lib.ads b/translate/grt/grt-lib.ads
index 2c25ab161..5bb2cd437 100644
--- a/translate/grt/grt-lib.ads
+++ b/translate/grt/grt-lib.ads
@@ -16,6 +16,7 @@
 --  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
 --  02111-1307, USA.
 with Grt.Types; use Grt.Types;
+with Grt.Rtis; use Grt.Rtis;
 
 package Grt.Lib is
    pragma Preelaborate (Grt.Lib);
@@ -24,10 +25,16 @@ package Grt.Lib is
      (Dest : Ghdl_Ptr; Src : Ghdl_Ptr; Size : Ghdl_Index_Type);
 
    procedure Ghdl_Assert_Failed
-     (Str : Std_String_Ptr; Severity : Integer; Loc : Ghdl_Location_Ptr);
+     (Str : Std_String_Ptr;
+      Severity : Integer;
+      Loc : Ghdl_Location_Ptr;
+      Unit : Ghdl_Rti_Access);
 
    procedure Ghdl_Report
-     (Str : Std_String_Ptr; Severity : Integer; Loc : Ghdl_Location_Ptr);
+     (Str : Std_String_Ptr;
+      Severity : Integer;
+      Loc : Ghdl_Location_Ptr;
+      Unit : Ghdl_Rti_Access);
 
    Note_Severity    : constant Integer := 0;
    Warning_Severity : constant Integer := 1;
diff --git a/translate/grt/grt-options.adb b/translate/grt/grt-options.adb
index 140f088b9..0cb515e97 100644
--- a/translate/grt/grt-options.adb
+++ b/translate/grt/grt-options.adb
@@ -147,6 +147,8 @@ package body Grt.Options is
       P (" --help, -h        disp this help");
       P (" --assert-level=LEVEL   stop simulation if assert at LEVEL");
       P ("       LEVEL is note,warning,error,failure,none");
+      P (" --ieee-asserts=POLICY  enable or disable asserts from IEEE");
+      P ("       POLICY is enable,disable,disable-at-0");
       P (" --stop-time=X     stop the simulation at time X");
       P ("       X is expressed as a time value, without spaces: 1ns, ps...");
       P (" --stop-delta=X    stop the simulation cycle after X delta");
@@ -415,6 +417,16 @@ package body Grt.Options is
                else
                   Error ("bad argument for --assert-level option, try --help");
                end if;
+            elsif Len > 15 and then Argument (1 .. 15) = "--ieee-asserts=" then
+               if Argument (16 .. Len) = "disable" then
+                  Ieee_Asserts := Disable_Asserts;
+               elsif Argument (16 .. Len) = "enable" then
+                  Ieee_Asserts := Enable_Asserts;
+               elsif Argument (16 .. Len) = "disable-at-0" then
+                  Ieee_Asserts := Disable_Asserts_At_Time_0;
+               else
+                  Error ("bad argument for --ieee-asserts option, try --help");
+               end if;
             elsif Argument = "--expect-failure" then
                Expect_Failure := True;
             elsif Len >= 13 and then Argument (1 .. 13) = "--stack-size=" then
diff --git a/translate/grt/grt-options.ads b/translate/grt/grt-options.ads
index 7e2c17b10..c71abacda 100644
--- a/translate/grt/grt-options.ads
+++ b/translate/grt/grt-options.ads
@@ -85,6 +85,15 @@ package Grt.Options is
    --  Level at which an assert stop the simulation.
    Severity_Level : Integer := Failure_Severity;
 
+   --  How assertions are handled.
+   type Assert_Handling is
+     (Enable_Asserts,
+      Disable_Asserts_At_Time_0,
+      Disable_Asserts);
+
+   --  Handling of assertions from IEEE library.
+   Ieee_Asserts : Assert_Handling := Enable_Asserts;
+
    --  Set by --stop-time=XXX to stop the simulation at or just after XXX.
    --  (unit is fs in fact).
    Stop_Time : Std_Time := Std_Time'Last;
diff --git a/translate/grt/grt-rtis.ads b/translate/grt/grt-rtis.ads
index f6d5b580f..305940850 100644
--- a/translate/grt/grt-rtis.ads
+++ b/translate/grt/grt-rtis.ads
@@ -24,7 +24,7 @@ package Grt.Rtis is
 
    type Ghdl_Rtik is
      (Ghdl_Rtik_Top,
-      Ghdl_Rtik_Library,
+      Ghdl_Rtik_Library,        -- use scalar
       Ghdl_Rtik_Package,
       Ghdl_Rtik_Package_Body,
       Ghdl_Rtik_Entity,