testsuite/gna: add a reproducer for #2166

13 files changed, 873 insertions, 0 deletions

diff --git a/testsuite/gna/issue2166/repro1.vhdl b/testsuite/gna/issue2166/repro1.vhdl
new file mode 100644
index 000000000..c44faf7dc
--- /dev/null
+++ b/testsuite/gna/issue2166/repro1.vhdl
@@ -0,0 +1,28 @@
+entity repro1 is
+end;
+
+architecture behav of repro1 is
+  function InitMemoryBaseType(Size : integer) return integer_vector is
+  begin
+    return (1 to Size => 0);
+  end InitMemoryBaseType;
+
+  subtype MemoryBaseType is integer_vector ;
+  type MemBlockType      is array (integer range <>) of MemoryBaseType ;
+  type MemBlockPtrType   is access MemBlockType ;
+begin
+  process
+    variable MemArr : MemBlockPtrType;
+    variable BlockWidth : natural := 4;
+  begin
+    MemArr := new MemBlockType (0 to BlockWidth - 1)(0 to 31);
+    report natural'image(memarr'length);
+--KO    report natural'image(memarr'element'length);
+    report natural'image(memarr(0)'length);
+    MemArr.all := (others => InitMemoryBaseType(32)) ;
+--KO    MemArr.all := (0 to BlockWidth-1 => InitMemoryBaseType(32)) ;
+--KO:    MemArr(0 to BlockWidth-1) :=
+--      (0 to BlockWidth-1 => InitMemoryBaseType(32)) ;
+    wait;
+  end process;
+end;
diff --git a/testsuite/gna/issue2166/repro2.vhdl b/testsuite/gna/issue2166/repro2.vhdl
new file mode 100644
index 000000000..9c587a932
--- /dev/null
+++ b/testsuite/gna/issue2166/repro2.vhdl
@@ -0,0 +1,33 @@
+entity repro2 is
+end;
+
+architecture behav of repro2 is
+  function id(v : natural) return natural is
+  begin
+    return v;
+  end id;
+
+  function InitMemoryBaseType(Size : integer) return integer_vector is
+  begin
+    return (1 to Size => 0);
+  end InitMemoryBaseType;
+
+  subtype MemoryBaseType is integer_vector ;
+  type MemBlockType      is array (integer range <>) of MemoryBaseType ;
+  type MemBlockPtrType   is access MemBlockType ;
+  type MemArrayType      is array (integer range <>) of MemBlockPtrType ;
+  type MemArrayPtrType   is access MemArrayType ;
+
+begin
+  process
+    variable MemArr : MemArrayPtrType;
+    variable BlockWidth : natural;
+  begin
+    BlockWidth := 4;
+    MemArr := new MemArrayType (0 to 7);
+    MemArr(0) := new MemBlockType (0 to BlockWidth - 1)(0 to 31);
+    MemArr(0)(0 to BlockWidth-1) :=
+      (0 to BlockWidth-1 => InitMemoryBaseType(32)) ;
+    wait;
+  end process;
+end;
diff --git a/testsuite/gna/issue2166/repro3.vhdl b/testsuite/gna/issue2166/repro3.vhdl
new file mode 100644
index 000000000..24475db7b
--- /dev/null
+++ b/testsuite/gna/issue2166/repro3.vhdl
@@ -0,0 +1,27 @@
+entity repro3 is
+end;
+
+architecture behav of repro3 is
+  function InitMemoryBaseType(Size : integer) return integer_vector is
+  begin
+    return (1 to Size => 0);
+  end InitMemoryBaseType;
+
+  subtype MemoryBaseType is integer_vector ;
+  type MemBlockType      is array (integer range <>) of MemoryBaseType ;
+  type MemBlockPtrType   is access MemBlockType ;
+begin
+  process
+    variable MemArr : MemBlockPtrType;
+    variable BlockWidth : natural := 4;
+  begin
+    MemArr := new MemBlockType (0 to BlockWidth - 1)(0 to 31);
+    report natural'image(memarr'length);
+--KO    report natural'image(memarr'element'length);
+    report natural'image(memarr(0)'length);
+    MemArr.all := (0 to BlockWidth-1 => InitMemoryBaseType(32)) ;
+--KO:    MemArr(0 to BlockWidth-1) :=
+--      (0 to BlockWidth-1 => InitMemoryBaseType(32)) ;
+    wait;
+  end process;
+end;
diff --git a/testsuite/gna/issue2166/sram.vhdl b/testsuite/gna/issue2166/sram.vhdl
new file mode 100644
index 000000000..ac8b7ae8a
--- /dev/null
+++ b/testsuite/gna/issue2166/sram.vhdl
@@ -0,0 +1,44 @@
+library ieee ;
+use ieee.std_logic_1164.all ;
+use ieee.numeric_std.all ;
+library OSVVM ;
+use OSVVM.MemoryPkg.all;
+
+Entity SRAM is
+  port (
+    Address : in     std_logic_vector (19 downto 0) ;
+    Data    : inout  std_logic_vector (15 downto 0) ;
+    nCE :in std_logic;
+    nOE :in std_logic;
+    nWE :in std_logic
+    );
+end SRAM ;
+
+Architecture model of SRAM is
+  signal MemoryID : MemoryIDType ;
+  signal WriteEnable, ReadEnable  : std_logic ;
+begin
+  MemoryID <= NewID(
+    Name      => SRAM'instance_name,
+    AddrWidth => Address'length,
+    DataWidth => Data'length) ;
+  WriteEnable <= not nWE and not nCE ;
+
+  RamWriteProc : process
+  begin
+    wait until falling_edge(WriteEnable) ;
+    MemWrite(MemoryID, Address, Data) ;
+  end process RamWriteProc  ;
+
+  ReadEnable <= not nCE and not nOE ;
+
+  ReadProc : process
+  begin
+    wait on Address, ReadEnable ;
+    case ReadEnable is
+      when '1' => Data <=  MemRead(MemoryID, Address) ;
+      when '0' => Data <= (Data'range => 'Z') ;
+      when others => Data <= (Data'range => 'X') ;
+    end case ;
+  end process ReadProc ;
+end model ;
diff --git a/testsuite/gna/issue2166/taggr.vhdl b/testsuite/gna/issue2166/taggr.vhdl
new file mode 100644
index 000000000..478602ca7
--- /dev/null
+++ b/testsuite/gna/issue2166/taggr.vhdl
@@ -0,0 +1,17 @@
+entity taggr is
+end;
+
+architecture behav of taggr is
+  procedure set (v : out string) is
+  begin
+    v := (others => ' ');
+  end set;
+begin
+  process
+    variable s : string (1 to 8);
+  begin
+    set (s);
+    report '<' & s & '>';
+    wait;
+  end process;
+end;
diff --git a/testsuite/gna/issue2166/taggr2.vhdl b/testsuite/gna/issue2166/taggr2.vhdl
new file mode 100644
index 000000000..721f57628
--- /dev/null
+++ b/testsuite/gna/issue2166/taggr2.vhdl
@@ -0,0 +1,19 @@
+entity taggr2 is
+end;
+
+architecture behav of taggr2 is
+  procedure set (v : inout string; l, r : positive) is
+  begin
+    v (l to r) := (others => ' ');
+  end set;
+begin
+  process
+    variable s : string (1 to 8);
+  begin
+    s(1) := 'A';
+    s(8) := 'Z';
+    set (s, 2, 7);
+    report s;
+    wait;
+  end process;
+end;
diff --git a/testsuite/gna/issue2166/tb.vhdl b/testsuite/gna/issue2166/tb.vhdl
new file mode 100644
index 000000000..e35b336be
--- /dev/null
+++ b/testsuite/gna/issue2166/tb.vhdl
@@ -0,0 +1,23 @@
+library ieee ;
+use ieee.std_logic_1164.all ;
+use ieee.numeric_std.all ;
+library OSVVM ;
+use OSVVM.MemoryPkg.all;
+
+entity tb is
+end;
+
+architecture behav of tb is
+begin
+  process
+    variable MemoryID : MemoryIDType;
+  begin
+    MemoryID := NewID(
+      Name      => "my_sram",
+      AddrWidth => 20,
+      DataWidth => 16);
+
+    MemWrite(MemoryId, x"00000", x"0000");
+    wait;
+  end process;
+end ;
diff --git a/testsuite/gna/issue2166/tb2.vhdl b/testsuite/gna/issue2166/tb2.vhdl
new file mode 100644
index 000000000..f08f5d659
--- /dev/null
+++ b/testsuite/gna/issue2166/tb2.vhdl
@@ -0,0 +1,35 @@
+library OSVVM ;
+
+use OSVVM.MemorySupportPkg.all ;
+
+package MemoryPkg is new OSVVM.MemoryGenericPkg
+  generic map (
+--    MemoryBaseType      => MemoryBaseType_X,
+    SizeMemoryBaseType  => SizeMemoryBaseType_X,
+    ToMemoryBaseType    => ToMemoryBaseType_X,
+    FromMemoryBaseType  => FromMemoryBaseType_X,
+    InitMemoryBaseType  => InitMemoryBaseType_X
+  ) ;
+
+library ieee ;
+use ieee.std_logic_1164.all ;
+use ieee.numeric_std.all ;
+use work.MemoryPkg.all;
+
+entity tb2 is
+end;
+
+architecture behav of tb2 is
+begin
+  process
+    variable MemoryID : MemoryIDType;
+  begin
+    MemoryID := NewID(
+      Name      => "my_sram",
+      AddrWidth => 20,
+      DataWidth => 16);
+
+    MemWrite(MemoryId, x"00000", x"0000");
+    wait;
+  end process;
+end ;
diff --git a/testsuite/gna/issue2166/tb3.vhdl b/testsuite/gna/issue2166/tb3.vhdl
new file mode 100644
index 000000000..b5c3dbf0e
--- /dev/null
+++ b/testsuite/gna/issue2166/tb3.vhdl
@@ -0,0 +1,69 @@
+library ieee ;
+use ieee.std_logic_1164.all ;
+
+entity tb3 is
+end;
+
+architecture behav of tb3 is
+begin
+  process
+    function InitMemoryBaseType(Size : integer) return integer_vector is
+    begin
+      return ((Size + 31) / 32 downto 1 => 0);
+    end;
+
+    subtype MemoryBaseType is integer_vector ;
+    type MemBlockType      is array (integer range <>) of MemoryBaseType ;
+    type MemBlockPtrType   is access MemBlockType ;
+    type MemArrayType      is array (integer range <>) of MemBlockPtrType ;
+    type MemArrayPtrType   is access MemArrayType ;
+
+    type MemStructType is record
+      MemArrayPtr         : MemArrayPtrType ;
+      AddrWidth           : integer ;
+      DataWidth           : natural ;
+      BlockWidth          : natural ;
+      MemoryBaseTypeWidth : natural ;
+    end record MemStructType ;
+
+    variable MemStructPtr     : MemStructType := (NULL, -1, 1, 0, 0);
+
+    procedure MemInit (AddrWidth, DataWidth  : integer ) is
+      constant ADJ_BLOCK_WIDTH : integer := 10;
+    begin
+      MemStructPtr.AddrWidth           := AddrWidth ;
+      MemStructPtr.DataWidth           := DataWidth ;
+      MemStructPtr.MemoryBaseTypeWidth := (DataWidth + 31) / 32;
+      MemStructPtr.BlockWidth          := ADJ_BLOCK_WIDTH ;
+      MemStructPtr.MemArrayPtr         := new MemArrayType(0 to 2**(AddrWidth-ADJ_BLOCK_WIDTH)-1) ;
+    end procedure MemInit ;
+
+    ------------------------------------------------------------
+    procedure MemWrite (
+    ------------------------------------------------------------
+      Addr  : std_logic_vector ;
+      Data  : std_logic_vector
+    ) is
+      variable BlockWidth : integer ;
+      variable MemoryBaseTypeWidth : integer ;
+      variable BlockAddr, WordAddr  : integer ;
+    begin
+      BlockWidth := MemStructPtr.BlockWidth ;
+      MemoryBaseTypeWidth := MemStructPtr.MemoryBaseTypeWidth ;
+      BlockAddr  := 0 ;
+
+      assert MemoryBaseTypeWidth = 1;
+      
+      -- If empty, allocate a memory block
+      if MemStructPtr.MemArrayPtr(BlockAddr) = NULL then
+        MemStructPtr.MemArrayPtr(BlockAddr) := new MemBlockType(0 to 2**BlockWidth-1)(MemoryBaseTypeWidth downto 1) ;
+        MemStructPtr.MemArrayPtr(BlockAddr)(0 to 2**BlockWidth-1) := (0 to 2**BlockWidth-1 => InitMemoryBaseType(Data'length)) ;
+      end if ;
+    end procedure MemWrite ;
+  begin
+    MemInit(AddrWidth => 20, DataWidth => 16);
+
+    MemWrite(x"00000", x"0000");
+    wait;
+  end process;
+end ;
diff --git a/testsuite/gna/issue2166/tb4.vhdl b/testsuite/gna/issue2166/tb4.vhdl
new file mode 100644
index 000000000..aefaac9e2
--- /dev/null
+++ b/testsuite/gna/issue2166/tb4.vhdl
@@ -0,0 +1,314 @@
+library OSVVM ;
+
+use OSVVM.MemorySupportPkg.all ;
+
+use std.textio.all ;
+library IEEE ;
+  use IEEE.std_logic_1164.all ;
+  use IEEE.numeric_std.all ;
+  use IEEE.numeric_std_unsigned.all ;
+
+package MemoryGenericPkg is
+  generic (
+--    type integer_vector ;
+    function SizeMemoryBaseType(Size : integer) return integer ; -- is <> ;
+    function ToMemoryBaseType  (A : std_logic_vector) return integer_vector ; -- is <> ;
+    function FromMemoryBaseType(A : integer_vector ; Size : integer) return std_logic_vector ; -- is <> ;
+    function InitMemoryBaseType(Size : integer) return integer_vector -- is <>
+  ) ;
+
+  type MemoryPType is protected
+
+    ------------------------------------------------------------
+    impure function NewID (
+      Name                : String ;
+      AddrWidth           : integer ;
+      DataWidth           : integer 
+    ) return integer ;
+
+    ------------------------------------------------------------
+    procedure MemWrite (
+      ID    : integer ;
+      Addr  : std_logic_vector ;
+      Data  : std_logic_vector
+    ) ;
+    procedure MemRead (
+      ID    : in integer ;
+      Addr  : in  std_logic_vector ;
+      Data  : out std_logic_vector
+    ) ;
+  end protected MemoryPType ;
+
+end MemoryGenericPkg ;
+
+package body MemoryGenericPkg is
+  constant BLOCK_WIDTH : integer := 10 ;
+
+  type MemoryPType is protected body
+
+    subtype MemoryBaseType is integer_vector ;
+    type MemBlockType      is array (integer range <>) of MemoryBaseType ;
+    type MemBlockPtrType   is access MemBlockType ;
+    type MemArrayType      is array (integer range <>) of MemBlockPtrType ;
+    type MemArrayPtrType   is access MemArrayType ;
+
+    type MemStructType is record
+      MemArrayPtr         : MemArrayPtrType ;
+      AddrWidth           : integer ;
+      DataWidth           : natural ;
+      BlockWidth          : natural ;
+      MemoryBaseTypeWidth : natural ;
+    end record MemStructType ;
+
+    -- New Structure
+    type     ItemArrayType    is array (integer range <>) of MemStructType ;
+    type     ItemArrayPtrType is access ItemArrayType ;
+
+    variable Template         : ItemArrayType(1 to 1) := (1 => (NULL, -1, 1, 0, 0)) ;  -- Work around for QS 2020.04 and 2021.02
+    constant MEM_STRUCT_PTR_LEFT : integer := Template'left ;
+    variable MemStructPtr     : ItemArrayPtrType := new ItemArrayType'(Template) ;
+    variable NumItems         : integer := 0 ;
+--    constant MIN_NUM_ITEMS    : integer := 4 ; -- Temporarily small for testing
+    constant MIN_NUM_ITEMS    : integer := 32 ; -- Min amount to resize array
+
+    ------------------------------------------------------------
+    -- Package Local
+    function NormalizeArraySize( NewNumItems, MinNumItems : integer ) return integer is
+    ------------------------------------------------------------
+      variable NormNumItems : integer := NewNumItems ;
+      variable ModNumItems  : integer := 0;
+    begin
+      ModNumItems := NewNumItems mod MinNumItems ;
+      if ModNumItems > 0 then
+        NormNumItems := NormNumItems + (MinNumItems - ModNumItems) ;
+      end if ;
+      return NormNumItems ;
+    end function NormalizeArraySize ;
+
+    ------------------------------------------------------------
+    -- Package Local
+    procedure GrowNumberItems (
+    ------------------------------------------------------------
+      variable ItemArrayPtr     : InOut ItemArrayPtrType ;
+      variable NumItems         : InOut integer ;
+      constant GrowAmount       : in integer ;
+--      constant NewNumItems      : in integer ;
+--      constant CurNumItems      : in integer ;
+      constant MinNumItems      : in integer
+    ) is
+      variable oldItemArrayPtr  : ItemArrayPtrType ;
+      variable NewNumItems : integer ;
+    begin
+      NewNumItems := NumItems + GrowAmount ;
+      -- Array Allocated in declaration to have a single item, but no items (historical mode)
+      -- if ItemArrayPtr = NULL then
+      --  ItemArrayPtr := new ItemArrayType(1 to NormalizeArraySize(NewNumItems, MinNumItems)) ;
+      -- elsif NewNumItems > ItemArrayPtr'length then
+      if NewNumItems > ItemArrayPtr'length then
+        oldItemArrayPtr := ItemArrayPtr ;
+        ItemArrayPtr := new ItemArrayType(1 to NormalizeArraySize(NewNumItems, MinNumItems)) ;
+        ItemArrayPtr.all(1 to NumItems) := oldItemArrayPtr.all(1 to NumItems) ;
+        deallocate(oldItemArrayPtr) ;
+      end if ;
+      NumItems := NewNumItems ;
+    end procedure GrowNumberItems ;
+
+   ------------------------------------------------------------
+    -- PT Local
+    procedure MemInit (ID : integer ;  AddrWidth, DataWidth  : integer ) is
+    ------------------------------------------------------------
+      constant ADJ_BLOCK_WIDTH : integer := minimum(BLOCK_WIDTH, AddrWidth) ;
+    begin
+      if AddrWidth <= 0 then
+        return ;
+      end if ;
+--      if DataWidth <= 0 or DataWidth > 31 then
+--        Alert(MemStructPtr(ID).AlertLogID, "MemoryPkg.MemInit/NewID.  DataWidth = " & to_string(DataWidth) & " must be > 0 and <= 31.", FAILURE) ;
+      if DataWidth <= 0 then
+        return ;
+      end if ;
+
+      MemStructPtr(ID).AddrWidth           := AddrWidth ;
+      MemStructPtr(ID).DataWidth           := DataWidth ;
+      MemStructPtr(ID).MemoryBaseTypeWidth := SizeMemoryBaseType(DataWidth) ;
+      MemStructPtr(ID).BlockWidth          := ADJ_BLOCK_WIDTH ;
+      MemStructPtr(ID).MemArrayPtr         := new MemArrayType(0 to 2**(AddrWidth-ADJ_BLOCK_WIDTH)-1) ;
+    end procedure MemInit ;
+
+    ------------------------------------------------------------
+    impure function NewID (
+    ------------------------------------------------------------
+      Name                : String ;
+      AddrWidth           : integer ;
+      DataWidth           : integer
+    ) return integer is
+      variable NameID              : integer ;
+    begin
+      -- Add New Memory to Structure
+      GrowNumberItems(MemStructPtr, NumItems, GrowAmount => 1, MinNumItems => MIN_NUM_ITEMS) ;
+      -- Construct Memory, Reports agains AlertLogID
+      MemInit(NumItems, AddrWidth, DataWidth) ;
+      -- Check NameStore Index vs MemoryIndex
+      return NumItems ;
+    end function NewID ;
+
+    ------------------------------------------------------------
+    -- PT Local
+    impure function IdOutOfRange(
+    ------------------------------------------------------------
+      constant ID    : in integer ;
+      constant Name  : in string
+    ) return boolean is
+    begin
+      return ID < MemStructPtr'Low or ID > MemStructPtr'High;
+    end function IdOutOfRange ;
+
+    ------------------------------------------------------------
+    procedure MemWrite (
+    ------------------------------------------------------------
+      ID    : integer ;
+      Addr  : std_logic_vector ;
+      Data  : std_logic_vector
+    ) is
+      variable BlockWidth : integer ;
+      variable MemoryBaseTypeWidth : integer ;
+--      constant BlockWidth : integer := MemStructPtr(ID).BlockWidth;
+      variable BlockAddr, WordAddr  : integer ;
+      alias aAddr : std_logic_vector (Addr'length-1 downto 0) is Addr ;
+--      subtype MemBlockSubType is MemBlockType(0 to 2**BlockWidth-1) ;
+    begin
+      if IdOutOfRange(ID, "MemWrite") then
+        return ;
+      end if ;
+      BlockWidth := MemStructPtr(ID).BlockWidth ;
+      MemoryBaseTypeWidth := MemStructPtr(ID).MemoryBaseTypeWidth ;
+
+      -- Check Bounds of Address and if memory is initialized
+      if Addr'length /= MemStructPtr(ID).AddrWidth then
+        return ;
+      end if ;
+
+      -- Check Bounds on Data
+      if Data'length /= MemStructPtr(ID).DataWidth then
+        return ;
+      end if ;
+
+      if is_X( Addr ) then
+        return ;
+      end if ;
+
+      -- Slice out upper address to form block address
+      if aAddr'high >= BlockWidth then
+        BlockAddr := to_integer(aAddr(aAddr'high downto BlockWidth)) ;
+      else
+        BlockAddr  := 0 ;
+      end if ;
+
+      -- If empty, allocate a memory block
+      if (MemStructPtr(ID).MemArrayPtr(BlockAddr) = NULL) then
+--        MemStructPtr(ID).MemArrayPtr(BlockAddr) := new MemBlockType'(0 to 2**BlockWidth-1 => InitMemoryBaseType(Data'length)) ;
+        MemStructPtr(ID).MemArrayPtr(BlockAddr) := new MemBlockType(0 to 2**BlockWidth-1)(MemoryBaseTypeWidth downto 1) ; -- => InitMemoryBaseType(Data'length)) ;
+        MemStructPtr(ID).MemArrayPtr(BlockAddr)(0 to 2**BlockWidth-1) := (0 to 2**BlockWidth-1 => InitMemoryBaseType(Data'length)) ;
+--KO2       MemStructPtr(ID).MemArrayPtr(BlockAddr)(0 to 2**BlockWidth-1) := (others => InitMemoryBaseType(Data'length)) ;
+
+      end if ;
+
+      -- Address of a word within a block
+      WordAddr  := to_integer(aAddr(BlockWidth -1 downto 0)) ;
+
+      -- Write to BlockAddr, WordAddr
+      MemStructPtr(ID).MemArrayPtr(BlockAddr)(WordAddr) := ToMemoryBaseType(Data) ;
+    end procedure MemWrite ;
+
+    ------------------------------------------------------------
+    procedure MemRead (
+    ------------------------------------------------------------
+      ID    : in integer ;
+      Addr  : in  std_logic_vector ;
+      Data  : out std_logic_vector
+    ) is
+      variable BlockWidth : integer ;
+      variable BlockAddr, WordAddr  : integer ;
+      alias aAddr : std_logic_vector (Addr'length-1 downto 0) is Addr ;
+    begin
+      if IdOutOfRange(ID, "MemRead") then
+        return ;
+      end if ;
+      BlockWidth := MemStructPtr(ID).BlockWidth ;
+
+      -- Check Bounds of Address and if memory is initialized
+      if Addr'length /= MemStructPtr(ID).AddrWidth then
+        Data := (Data'range => 'U') ;
+        return ;
+      end if ;
+
+      -- Check Bounds on Data
+      if Data'length /= MemStructPtr(ID).DataWidth then
+        Data := (Data'range => 'U') ;
+        return ;
+      end if ;
+
+      -- If Addr X, data = X
+      if is_X( aAddr ) then
+        Data := (Data'range => 'X') ;
+        return ;
+      end if ;
+
+      -- Slice out upper address to form block address
+      if aAddr'high >= BlockWidth then
+        BlockAddr := to_integer(aAddr(aAddr'high downto BlockWidth)) ;
+      else
+        BlockAddr  := 0 ;
+      end if ;
+
+      -- Empty Block, return all U
+      if (MemStructPtr(ID).MemArrayPtr(BlockAddr) = NULL) then
+        Data := (Data'range => 'U') ;
+        return ;
+      end if ;
+
+      -- Address of a word within a block
+      WordAddr := to_integer(aAddr(BlockWidth -1 downto 0)) ;
+
+      Data := FromMemoryBaseType(MemStructPtr(ID).MemArrayPtr(BlockAddr)(WordAddr), Data'length) ;
+
+    end procedure MemRead ;
+  end protected body MemoryPType ;
+end MemoryGenericPkg ;
+
+library OSVVM ;
+
+use OSVVM.MemorySupportPkg.all ;
+
+package MemoryPkg is new work.MemoryGenericPkg
+  generic map (
+--    MemoryBaseType      => MemoryBaseType_X,
+    SizeMemoryBaseType  => SizeMemoryBaseType_X,
+    ToMemoryBaseType    => ToMemoryBaseType_X,
+    FromMemoryBaseType  => FromMemoryBaseType_X,
+    InitMemoryBaseType  => InitMemoryBaseType_X
+  ) ;
+
+library ieee ;
+use ieee.std_logic_1164.all ;
+use ieee.numeric_std.all ;
+use work.MemoryPkg.all;
+
+entity tb3 is
+end;
+
+architecture behav of tb3 is
+  shared variable MemoryStore : MemoryPType ;
+begin
+  process
+    variable MemoryID : integer;
+  begin
+    MemoryID := MemoryStore.NewID(
+      Name      => "my_sram",
+      AddrWidth => 20,
+      DataWidth => 16);
+
+    MemoryStore.MemWrite(MemoryId, x"00000", x"0000");
+    wait;
+  end process;
+end ;
diff --git a/testsuite/gna/issue2166/tb5.vhdl b/testsuite/gna/issue2166/tb5.vhdl
new file mode 100644
index 000000000..38bb5920d
--- /dev/null
+++ b/testsuite/gna/issue2166/tb5.vhdl
@@ -0,0 +1,114 @@
+use std.textio.all ;
+library IEEE ;
+  use IEEE.std_logic_1164.all ;
+  use IEEE.numeric_std.all ;
+  use IEEE.numeric_std_unsigned.all ;
+
+package MemoryPkg is
+  type MemoryPType is protected
+    procedure MemInit (ID : integer ;  AddrWidth, DataWidth  : integer);
+
+    procedure MemWrite (
+      ID    : integer ;
+      Addr  : std_logic_vector ;
+      Data  : std_logic_vector
+    ) ;
+  end protected MemoryPType ;
+end;
+
+package body MemoryPkg is
+  constant BLOCK_WIDTH : integer := 10 ;
+
+  function InitMemoryBaseType(Size : integer) return integer_vector is
+  begin
+    return (Size / 32 downto 1 => 0);
+  end;
+
+  type MemoryPType is protected body
+
+    subtype MemoryBaseType is integer_vector ;
+    type MemBlockType      is array (integer range <>) of MemoryBaseType ;
+    type MemBlockPtrType   is access MemBlockType ;
+    type MemArrayType      is array (integer range <>) of MemBlockPtrType ;
+    type MemArrayPtrType   is access MemArrayType ;
+
+    type MemStructType is record
+      MemArrayPtr         : MemArrayPtrType ;
+      AddrWidth           : integer ;
+      DataWidth           : natural ;
+      BlockWidth          : natural ;
+      MemoryBaseTypeWidth : natural ;
+    end record MemStructType ;
+
+    -- New Structure
+    type     ItemArrayType    is array (integer range <>) of MemStructType ;
+    type     ItemArrayPtrType is access ItemArrayType ;
+
+    variable Template         : ItemArrayType(1 to 1) := (1 => (NULL, -1, 1, 0, 0)) ;  -- Work around for QS 2020.04 and 2021.02
+    variable MemStructPtr     : ItemArrayPtrType := new ItemArrayType'(Template) ;
+    variable NumItems         : integer := 0 ;
+    constant MIN_NUM_ITEMS    : integer := 32 ; -- Min amount to resize array
+
+   ------------------------------------------------------------
+    -- PT Local
+    procedure MemInit (ID : integer ;  AddrWidth, DataWidth  : integer ) is
+    ------------------------------------------------------------
+      constant ADJ_BLOCK_WIDTH : integer := minimum(BLOCK_WIDTH, AddrWidth) ;
+    begin
+      if AddrWidth <= 0 then
+        return ;
+      end if ;
+      if DataWidth <= 0 then
+        return ;
+      end if ;
+
+      MemStructPtr(ID).AddrWidth           := AddrWidth ;
+      MemStructPtr(ID).DataWidth           := DataWidth ;
+      MemStructPtr(ID).MemoryBaseTypeWidth := (DataWidth + 31) / 32;
+      MemStructPtr(ID).BlockWidth          := ADJ_BLOCK_WIDTH ;
+      MemStructPtr(ID).MemArrayPtr         := new MemArrayType(0 to 2**(AddrWidth-ADJ_BLOCK_WIDTH)-1) ;
+    end procedure MemInit ;
+
+    ------------------------------------------------------------
+    procedure MemWrite (
+    ------------------------------------------------------------
+      ID    : integer ;
+      Addr  : std_logic_vector ;
+      Data  : std_logic_vector
+    ) is
+      variable BlockWidth : integer ;
+      variable MemoryBaseTypeWidth : integer ;
+      variable BlockAddr, WordAddr  : integer ;
+    begin
+      BlockWidth := MemStructPtr(ID).BlockWidth ;
+      MemoryBaseTypeWidth := MemStructPtr(ID).MemoryBaseTypeWidth ;
+      BlockAddr  := 0 ;
+
+      -- If empty, allocate a memory block
+      if MemStructPtr(ID).MemArrayPtr(BlockAddr) = NULL then
+        MemStructPtr(ID).MemArrayPtr(BlockAddr) := new MemBlockType(0 to 2**BlockWidth-1)(MemoryBaseTypeWidth downto 1) ; -- => InitMemoryBaseType(Data'length)) ;
+        MemStructPtr(ID).MemArrayPtr(BlockAddr)(0 to 2**BlockWidth-1) := (0 to 2**BlockWidth-1 => InitMemoryBaseType(Data'length)) ;
+      end if ;
+    end procedure MemWrite ;
+  end protected body MemoryPType ;
+end;
+
+library ieee ;
+use ieee.std_logic_1164.all ;
+use ieee.numeric_std.all ;
+use work.MemoryPkg.all;
+
+entity tb3 is
+end;
+
+architecture behav of tb3 is
+  shared variable MemoryStore : MemoryPType ;
+begin
+  process
+  begin
+    MemoryStore.MemInit(1, AddrWidth => 20, DataWidth => 16);
+
+    MemoryStore.MemWrite(1, x"00000", x"0000");
+    wait;
+  end process;
+end ;
diff --git a/testsuite/gna/issue2166/tb6.vhdl b/testsuite/gna/issue2166/tb6.vhdl
new file mode 100644
index 000000000..3526a4ac5
--- /dev/null
+++ b/testsuite/gna/issue2166/tb6.vhdl
@@ -0,0 +1,90 @@
+library ieee ;
+use ieee.std_logic_1164.all ;
+
+entity tb3 is
+end;
+
+architecture behav of tb3 is
+begin
+  process
+    procedure MemInit (ID : integer ;  AddrWidth, DataWidth  : integer);
+
+    procedure MemWrite (
+      ID    : integer ;
+      Addr  : std_logic_vector ;
+      Data  : std_logic_vector
+    ) ;
+
+    constant BLOCK_WIDTH : integer := 10 ;
+
+    function InitMemoryBaseType(Size : integer) return integer_vector is
+    begin
+      return (Size / 32 downto 1 => 0);
+    end;
+
+    subtype MemoryBaseType is integer_vector ;
+    type MemBlockType      is array (integer range <>) of MemoryBaseType ;
+    type MemBlockPtrType   is access MemBlockType ;
+    type MemArrayType      is array (integer range <>) of MemBlockPtrType ;
+    type MemArrayPtrType   is access MemArrayType ;
+
+    type MemStructType is record
+      MemArrayPtr         : MemArrayPtrType ;
+      AddrWidth           : integer ;
+      DataWidth           : natural ;
+      BlockWidth          : natural ;
+      MemoryBaseTypeWidth : natural ;
+    end record MemStructType ;
+
+    -- New Structure
+    type     ItemArrayType    is array (integer range <>) of MemStructType ;
+    type     ItemArrayPtrType is access ItemArrayType ;
+
+    variable Template         : ItemArrayType(1 to 1) := (1 => (NULL, -1, 1, 0, 0)) ;  -- Work around for QS 2020.04 and 2021.02
+    variable MemStructPtr     : ItemArrayPtrType := new ItemArrayType'(Template) ;
+
+    procedure MemInit (ID : integer ;  AddrWidth, DataWidth  : integer ) is
+      constant ADJ_BLOCK_WIDTH : integer := minimum(BLOCK_WIDTH, AddrWidth) ;
+    begin
+      if AddrWidth <= 0 then
+        return ;
+      end if ;
+      if DataWidth <= 0 then
+        return ;
+      end if ;
+
+      MemStructPtr(ID).AddrWidth           := AddrWidth ;
+      MemStructPtr(ID).DataWidth           := DataWidth ;
+      MemStructPtr(ID).MemoryBaseTypeWidth := (DataWidth + 31) / 32;
+      MemStructPtr(ID).BlockWidth          := ADJ_BLOCK_WIDTH ;
+      MemStructPtr(ID).MemArrayPtr         := new MemArrayType(0 to 2**(AddrWidth-ADJ_BLOCK_WIDTH)-1) ;
+    end procedure MemInit ;
+
+    ------------------------------------------------------------
+    procedure MemWrite (
+    ------------------------------------------------------------
+      ID    : integer ;
+      Addr  : std_logic_vector ;
+      Data  : std_logic_vector
+    ) is
+      variable BlockWidth : integer ;
+      variable MemoryBaseTypeWidth : integer ;
+      variable BlockAddr, WordAddr  : integer ;
+    begin
+      BlockWidth := MemStructPtr(ID).BlockWidth ;
+      MemoryBaseTypeWidth := MemStructPtr(ID).MemoryBaseTypeWidth ;
+      BlockAddr  := 0 ;
+
+      -- If empty, allocate a memory block
+      if MemStructPtr(ID).MemArrayPtr(BlockAddr) = NULL then
+        MemStructPtr(ID).MemArrayPtr(BlockAddr) := new MemBlockType(0 to 2**BlockWidth-1)(MemoryBaseTypeWidth downto 1) ; -- => InitMemoryBaseType(Data'length)) ;
+        MemStructPtr(ID).MemArrayPtr(BlockAddr)(0 to 2**BlockWidth-1) := (0 to 2**BlockWidth-1 => InitMemoryBaseType(Data'length)) ;
+      end if ;
+    end procedure MemWrite ;
+  begin
+    MemInit(1, AddrWidth => 20, DataWidth => 16);
+
+    MemWrite(1, x"00000", x"0000");
+    wait;
+  end process;
+end ;
diff --git a/testsuite/gna/issue2166/testsuite.sh b/testsuite/gna/issue2166/testsuite.sh
new file mode 100755
index 000000000..8828745e3
--- /dev/null
+++ b/testsuite/gna/issue2166/testsuite.sh
@@ -0,0 +1,60 @@
+#! /bin/sh
+
+. ../../testenv.sh
+
+export GHDL_STD_FLAGS="--std=08 -frelaxed"
+
+analyze repro1.vhdl
+elab_simulate repro1
+
+analyze repro3.vhdl
+elab_simulate repro3
+
+analyze repro2.vhdl
+elab_simulate repro2
+
+analyze tb3.vhdl
+elab_simulate tb3
+
+if false; then
+    export GHDL_STD_FLAGS="--std=08 -frelaxed --work=osvvm -Wno-hide"
+
+    analyze OsvvmLibraries/osvvm/TextUtilPkg.vhd
+    analyze OsvvmLibraries/osvvm/ResolutionPkg.vhd
+    analyze OsvvmLibraries/osvvm/NamePkg.vhd
+    analyze OsvvmLibraries/osvvm/OsvvmGlobalPkg.vhd
+    analyze OsvvmLibraries/osvvm/VendorCovApiPkg.vhd
+    analyze OsvvmLibraries/osvvm/TranscriptPkg.vhd
+    analyze OsvvmLibraries/osvvm/AlertLogPkg.vhd
+    analyze OsvvmLibraries/osvvm/NameStorePkg.vhd
+    #analyze OsvvmLibraries/osvvm/MessageListPkg.vhd
+    #analyze OsvvmLibraries/osvvm/SortListPkg_int.vhd
+    #analyze OsvvmLibraries/osvvm/RandomBasePkg.vhd
+    #analyze OsvvmLibraries/osvvm/RandomPkg.vhd
+    #analyze OsvvmLibraries/osvvm/RandomProcedurePkg.vhd
+    #analyze OsvvmLibraries/osvvm/CoveragePkg.vhd
+    #analyze OsvvmLibraries/osvvm/ScoreboardGenericPkg.vhd
+    #analyze OsvvmLibraries/osvvm/ScoreboardPkg_slv.vhd
+    #analyze OsvvmLibraries/osvvm/ScoreboardPkg_int.vhd
+    #analyze OsvvmLibraries/osvvm/ResizePkg.vhd
+    analyze OsvvmLibraries/osvvm/MemorySupportPkg.vhd
+    analyze OsvvmLibraries/osvvm/MemoryGenericPkg.vhd
+    analyze OsvvmLibraries/osvvm/MemoryPkg.vhd
+    #analyze OsvvmLibraries/osvvm/TbUtilPkg.vhd
+    #analyze OsvvmLibraries/osvvm/ReportPkg.vhd
+    #analyze OsvvmLibraries/osvvm/OsvvmTypesPkg.vhd
+    #analyze OsvvmLibraries/osvvm/OsvvmContext.vhd
+
+
+    export GHDL_STD_FLAGS="--std=08 -frelaxed"
+
+    analyze tb2.vhdl
+    elab_simulate tb2
+
+    analyze tb.vhdl
+    elab_simulate tb
+fi
+
+clean
+
+echo "Test successful"