grt: add check for empty stack2.

3 files changed, 27 insertions, 4 deletions

diff --git a/src/grt/grt-processes.adb b/src/grt/grt-processes.adb
index c10c0ac95..a4850d9ad 100644
--- a/src/grt/grt-processes.adb
+++ b/src/grt/grt-processes.adb
@@ -807,6 +807,13 @@ package body Grt.Processes is
                Set_Current_Process (Proc);
                Proc.Subprg.all (Proc.This);
                if Grt.Options.Checks then
+                  if Proc.State = State_Sensitized
+                    and then not Is_Empty (Proc.Stack2)
+                  then
+                     --  A non-sensitized process may store its state
+                     --  on stack2.
+                     Internal_Error ("non-empty stack2");
+                  end if;
                   Ghdl_Signal_Internal_Checks;
                end if;
             end;
diff --git a/src/grt/grt-stack2.adb b/src/grt/grt-stack2.adb
index 1ae18be5a..aaf686980 100644
--- a/src/grt/grt-stack2.adb
+++ b/src/grt/grt-stack2.adb
@@ -142,7 +142,8 @@ package body Grt.Stack2 is
       return Chunk.Mem (Chunk.First)'Address;
    end Allocate;
 
-   function Create return Stack2_Ptr is
+   function Create return Stack2_Ptr
+   is
       Res : Stack2_Acc;
       Chunk : Chunk_Acc;
    begin
@@ -154,9 +155,15 @@ package body Grt.Stack2 is
       return To_Addr (Res);
    end Create;
 
-   --  May be used to debug.
-   procedure Dump_Stack2 (S : Stack2_Ptr);
-   pragma Unreferenced (Dump_Stack2);
+   function Is_Empty (S : Stack2_Ptr) return Boolean
+   is
+      S2 : constant Stack2_Acc := To_Acc (S);
+   begin
+      if S2 = null then
+         return True;
+      end if;
+      return S2.Top = 1;
+   end Is_Empty;
 
    procedure Dump_Stack2 (S : Stack2_Ptr)
    is
@@ -174,6 +181,9 @@ package body Grt.Stack2 is
       Put ("Stack 2 at ");
       Put (stdout, Address (S));
       New_Line;
+      if S2 = null then
+         return;
+      end if;
       Put ("First Chunk at ");
       Put (stdout, To_Address (S2.First_Chunk));
       Put (", last chunk at ");
diff --git a/src/grt/grt-stack2.ads b/src/grt/grt-stack2.ads
index 1c0c79afe..a7c2799f6 100644
--- a/src/grt/grt-stack2.ads
+++ b/src/grt/grt-stack2.ads
@@ -58,6 +58,12 @@ package Grt.Stack2 is
 
    --  Create a secondary stack.
    function Create return Stack2_Ptr;
+
+   --  Return True iff S is null or empty.
+   function Is_Empty (S : Stack2_Ptr) return Boolean;
+
+   --  May be used to debug.
+   procedure Dump_Stack2 (S : Stack2_Ptr);
 private
    type Stack2_Ptr is new System.Address;
    Null_Stack2_Ptr : constant Stack2_Ptr := Stack2_Ptr (System.Null_Address);