Add a test for interface subprograms.

5 files changed, 482 insertions, 0 deletions

diff --git a/testsuite/gna/bug061/datastructure.vhdl b/testsuite/gna/bug061/datastructure.vhdl
new file mode 100644
index 000000000..005211229
--- /dev/null
+++ b/testsuite/gna/bug061/datastructure.vhdl
@@ -0,0 +1,69 @@
+library ieee;
+use ieee.std_logic_1164.all;
+
+
+
+package DataStructures is
+
+
+  -- Simple hashing functions
+  function Modulo_Int (d : integer; size : positive) return natural;
+  function Modulo (d : string;  size : positive) return natural;
+
+  -- Dictionaries
+  package Integer_Integer_Dict_Pkg is new work.corelib_Dict
+    generic map (KEY_TYPE   => integer,
+                 VALUE_TYPE => integer,
+                 to_hash    => Modulo_Int);
+
+  package Integer_StdLogicVector_Dict_Pkg is new work.corelib_Dict
+    generic map (KEY_TYPE   => integer,
+                 VALUE_TYPE => std_logic_vector,
+                 to_hash    => Modulo_Int);
+
+  package String_String_Dict_Pkg is new work.corelib_Dict
+    generic map (KEY_TYPE   => string,
+                 VALUE_TYPE => string,
+                 to_hash    => Modulo);
+
+  package String_StdLogicVector_Dict_Pkg is new work.corelib_Dict
+    generic map (KEY_TYPE   => string,
+                 VALUE_TYPE => std_logic_vector,
+                 to_hash    => Modulo);
+
+  -- Aliases for convenience reasons
+  alias Integer_Integer_Dict is Integer_Integer_Dict_Pkg.PT_DICT;
+  alias Integer_Slv_Dict     is Integer_StdLogicVector_Dict_Pkg.PT_DICT;
+  alias String_String_Dict   is String_String_Dict_Pkg.PT_DICT;
+  alias String_Slv_Dict      is String_StdLogicVector_Dict_Pkg.PT_DICT;
+
+
+end package;
+
+
+
+package body DataStructures is
+
+
+  -- Simple modulo function for integers
+  function Modulo_int (d : integer; size : positive) return natural is
+  begin
+    return d mod size;
+  end function Modulo_Int;
+
+  -- Simple modulo function for ISO 8859 Latin-1 8-bit strings
+  -- of arbitrary length (>= VHDL 93)
+  function Modulo (d : string; size : positive) return natural is
+    variable hash : natural := 0;
+  begin
+    assert size <= ((natural'high - 255) / 256 + 1)
+      report Modulo[string, natural return natural]'instance_name & ": size parameter too large, possible overflow"
+                   severity failure;
+    for i in d'range loop
+      hash := (hash * 256 + Character'Pos (d(i))) mod size;
+    end loop;
+    return hash;
+  end function Modulo;
+
+
+end package body DataStructures;
diff --git a/testsuite/gna/bug061/dictp.vhdl b/testsuite/gna/bug061/dictp.vhdl
new file mode 100644
index 000000000..b350703e1
--- /dev/null
+++ b/testsuite/gna/bug061/dictp.vhdl
@@ -0,0 +1,194 @@
+library ieee;
+use ieee.std_logic_1164.all;
+
+
+
+package corelib_Dict is
+
+--  generic (
+--    type     KEY_TYPE;
+--    type     VALUE_TYPE;
+--    function to_hash(d : in KEY_TYPE, size : positive) return natural;
+--    INIT_SIZE : natural := 128
+--  );
+
+
+  -- REMOVE when using package generics
+  constant INIT_SIZE : positive := 128;
+  alias to_hash is "mod" [integer, integer return integer];
+  subtype KEY_TYPE   is integer;
+  subtype VALUE_TYPE is std_logic_vector;
+
+
+  type PT_DICT is protected
+
+    procedure Set (constant key : in KEY_TYPE; constant data : in VALUE_TYPE);
+    procedure Get (constant key : in KEY_TYPE; data : out VALUE_TYPE);
+    impure function Get (constant key : KEY_TYPE) return VALUE_TYPE;
+    procedure Del (constant key : in KEY_TYPE);
+    procedure Clear;
+    impure function HasKey (constant key : KEY_TYPE) return boolean;
+    impure function Count return natural;
+
+  end protected PT_DICT;
+
+  procedure Merge(d0 : inout PT_DICT; d1 : inout PT_DICT; dout : inout PT_DICT);
+
+
+end package corelib_Dict;
+
+
+
+package body corelib_Dict is
+
+
+  type t_key_ptr  is access KEY_TYPE;
+  type t_data_ptr is access VALUE_TYPE;
+
+
+  type PT_DICT is protected body
+
+
+    type t_entry;
+    type t_entry_ptr is access t_entry;
+
+    type t_entry is record
+      key        : t_key_ptr;
+      data       : t_data_ptr;
+      last_entry : t_entry_ptr;
+      next_entry : t_entry_ptr;
+    end record t_entry;
+
+    type t_entry_array is array (0 to INIT_SIZE-1) of t_entry_ptr;
+
+    variable head  : t_entry_array := (others => null);
+
+    variable entry_count : integer_vector(0 to INIT_SIZE-1) := (others => 0);
+
+
+    -- Private method to find entry stored in dictionary
+    impure function Find (constant key : KEY_TYPE) return t_entry_ptr;
+
+    impure function Find (constant key : KEY_TYPE) return t_entry_ptr is
+      variable entry : t_entry_ptr := head(to_hash(key, INIT_SIZE));
+    begin
+      while (entry /= null) loop
+        if (entry.key.all = key) then
+          return entry;
+        end if;
+        entry := entry.last_entry;
+      end loop;
+      return null;
+    end function Find;
+
+
+    procedure Set (constant key : in KEY_TYPE; constant data : in VALUE_TYPE) is
+      variable addr  : natural := 0;
+      variable entry : t_entry_ptr := Find(key);
+    begin
+      if (entry = null) then
+        addr := to_hash(key, INIT_SIZE);
+        if (head(addr) /= null) then
+          entry                            := new t_entry;
+          entry.key                        := new KEY_TYPE'(key);
+          entry.data                       := new VALUE_TYPE'(data);
+          entry.last_entry                 := head(addr);
+          entry.next_entry                 := null;
+          head(addr)                       := entry;
+          head(addr).last_entry.next_entry := head(addr);
+        else
+          head(addr)            := new t_entry;
+          head(addr).key        := new KEY_TYPE'(key);
+          head(addr).data       := new VALUE_TYPE'(data);
+          head(addr).last_entry := null;
+          head(addr).next_entry := null;
+        end if;
+        entry_count(addr) := entry_count(addr) + 1;
+      else
+        entry.data.all := data;
+      end if;
+    end procedure Set;
+
+    procedure Get (constant key : in KEY_TYPE; data : out VALUE_TYPE) is
+      variable entry : t_entry_ptr := Find(key);
+    begin
+      assert entry /= null
+        report PT_DICT'instance_name & ": ERROR: key " & to_string(key) & " not found"
+        severity failure;
+      data := entry.data.all;
+    end procedure Get;
+
+    impure function Get (constant key : KEY_TYPE) return VALUE_TYPE is
+      variable entry : t_entry_ptr := Find(key);
+    begin
+      assert entry /= null
+        report PT_DICT'instance_name & ": ERROR: key " & to_string(key) & " not found"
+        severity failure;
+      return entry.data.all;
+    end function Get;
+
+    procedure Del (constant key : in KEY_TYPE) is
+      variable entry : t_entry_ptr := Find(key);
+      variable addr  : natural := 0;
+    begin
+      if (entry /= null) then
+        addr := to_hash(key, INIT_SIZE);
+        -- remove head entry
+        if(entry.next_entry = null and entry.last_entry /= null) then
+          entry.last_entry.next_entry := null;
+          head(addr)                  := entry.last_entry;
+        -- remove start entry
+        elsif(entry.next_entry /= null and entry.last_entry = null) then
+          entry.next_entry.last_entry := null;
+        -- remove from between
+        elsif(entry.next_entry /= null and entry.last_entry /= null) then
+          entry.last_entry.next_entry := entry.next_entry;
+          entry.next_entry.last_entry := entry.last_entry;
+        else
+          head(addr) := null;
+        end if;
+        deallocate(entry.key);
+        deallocate(entry.data);
+        deallocate(entry);
+        entry_count(addr) := entry_count(addr) - 1;
+      end if;
+    end procedure Del;
+
+    procedure Clear  is
+      variable entry   : t_entry_ptr;
+      variable entry_d : t_entry_ptr;
+    begin
+      for i in t_entry_array'range loop
+        entry := head(i);
+        while (entry /= null) loop
+          entry_d := entry;
+          Del(entry_d.key.all);
+          entry := entry.last_entry;
+        end loop;
+      end loop;
+    end procedure Clear;
+
+    impure function HasKey (constant key : KEY_TYPE) return boolean is
+    begin
+      return Find(key) /= null;
+    end function HasKey;
+
+    impure function Count return natural is
+      variable value : natural := 0;
+    begin
+      for i in entry_count'range loop
+        value := value + entry_count(i);
+      end loop;
+      return value;
+    end function Count;
+
+
+  end protected body PT_DICT;
+
+
+  procedure Merge(d0 : inout PT_DICT; d1 : inout PT_DICT; dout : inout PT_DICT) is
+  begin
+  end procedure Merge;
+
+
+end package body corelib_Dict;
diff --git a/testsuite/gna/bug061/dictp08.vhdl b/testsuite/gna/bug061/dictp08.vhdl
new file mode 100644
index 000000000..e3fa712b9
--- /dev/null
+++ b/testsuite/gna/bug061/dictp08.vhdl
@@ -0,0 +1,187 @@
+library ieee;
+use ieee.std_logic_1164.all;
+
+
+
+package corelib_Dict is
+
+  generic (
+    type     KEY_TYPE;
+    type     VALUE_TYPE;
+    function to_hash(d : in KEY_TYPE; size : positive) return natural;
+    INIT_SIZE : natural := 128
+  );
+
+
+  type PT_DICT is protected
+
+    procedure Set (constant key : in KEY_TYPE; constant data : in VALUE_TYPE);
+    procedure Get (constant key : in KEY_TYPE; data : out VALUE_TYPE);
+    impure function Get (constant key : KEY_TYPE) return VALUE_TYPE;
+    procedure Del (constant key : in KEY_TYPE);
+    procedure Clear;
+    impure function HasKey (constant key : KEY_TYPE) return boolean;
+    impure function Count return natural;
+
+  end protected PT_DICT;
+
+  procedure Merge(d0 : inout PT_DICT; d1 : inout PT_DICT; dout : inout PT_DICT);
+
+
+end package corelib_Dict;
+
+
+
+package body corelib_Dict is
+
+
+  type t_key_ptr  is access KEY_TYPE;
+  type t_data_ptr is access VALUE_TYPE;
+
+
+  type PT_DICT is protected body
+
+
+    type t_entry;
+    type t_entry_ptr is access t_entry;
+
+    type t_entry is record
+      key        : t_key_ptr;
+      data       : t_data_ptr;
+      last_entry : t_entry_ptr;
+      next_entry : t_entry_ptr;
+    end record t_entry;
+
+    type t_entry_array is array (0 to INIT_SIZE-1) of t_entry_ptr;
+
+    variable head  : t_entry_array := (others => null);
+
+    variable entry_count : integer_vector(0 to INIT_SIZE-1) := (others => 0);
+
+
+    -- Private method to find entry stored in dictionary
+    impure function Find (constant key : KEY_TYPE) return t_entry_ptr;
+
+    impure function Find (constant key : KEY_TYPE) return t_entry_ptr is
+      variable entry : t_entry_ptr := head(to_hash(key, INIT_SIZE));
+    begin
+      while (entry /= null) loop
+        if (entry.key.all = key) then
+          return entry;
+        end if;
+        entry := entry.last_entry;
+      end loop;
+      return null;
+    end function Find;
+
+
+    procedure Set (constant key : in KEY_TYPE; constant data : in VALUE_TYPE) is
+      variable addr  : natural := 0;
+      variable entry : t_entry_ptr := Find(key);
+    begin
+      if (entry = null) then
+        addr := to_hash(key, INIT_SIZE);
+        if (head(addr) /= null) then
+          entry                            := new t_entry;
+          entry.key                        := new KEY_TYPE'(key);
+          entry.data                       := new VALUE_TYPE'(data);
+          entry.last_entry                 := head(addr);
+          entry.next_entry                 := null;
+          head(addr)                       := entry;
+          head(addr).last_entry.next_entry := head(addr);
+        else
+          head(addr)            := new t_entry;
+          head(addr).key        := new KEY_TYPE'(key);
+          head(addr).data       := new VALUE_TYPE'(data);
+          head(addr).last_entry := null;
+          head(addr).next_entry := null;
+        end if;
+        entry_count(addr) := entry_count(addr) + 1;
+      else
+        entry.data.all := data;
+      end if;
+    end procedure Set;
+
+    procedure Get (constant key : in KEY_TYPE; data : out VALUE_TYPE) is
+      variable entry : t_entry_ptr := Find(key);
+    begin
+      assert entry /= null
+        report PT_DICT'instance_name & ": ERROR: key not found"
+        severity failure;
+      data := entry.data.all;
+    end procedure Get;
+
+    impure function Get (constant key : KEY_TYPE) return VALUE_TYPE is
+      variable entry : t_entry_ptr := Find(key);
+    begin
+      assert entry /= null
+        report PT_DICT'instance_name & ": ERROR: key not found"
+        severity failure;
+      return entry.data.all;
+    end function Get;
+
+    procedure Del (constant key : in KEY_TYPE) is
+      variable entry : t_entry_ptr := Find(key);
+      variable addr  : natural := 0;
+    begin
+      if (entry /= null) then
+        addr := to_hash(key, INIT_SIZE);
+        -- remove head entry
+        if(entry.next_entry = null and entry.last_entry /= null) then
+          entry.last_entry.next_entry := null;
+          head(addr)                  := entry.last_entry;
+        -- remove start entry
+        elsif(entry.next_entry /= null and entry.last_entry = null) then
+          entry.next_entry.last_entry := null;
+        -- remove from between
+        elsif(entry.next_entry /= null and entry.last_entry /= null) then
+          entry.last_entry.next_entry := entry.next_entry;
+          entry.next_entry.last_entry := entry.last_entry;
+        else
+          head(addr) := null;
+        end if;
+        deallocate(entry.key);
+        deallocate(entry.data);
+        deallocate(entry);
+        entry_count(addr) := entry_count(addr) - 1;
+      end if;
+    end procedure Del;
+
+    procedure Clear  is
+      variable entry   : t_entry_ptr;
+      variable entry_d : t_entry_ptr;
+    begin
+      for i in t_entry_array'range loop
+        entry := head(i);
+        while (entry /= null) loop
+          entry_d := entry;
+          Del(entry_d.key.all);
+          entry := entry.last_entry;
+        end loop;
+      end loop;
+    end procedure Clear;
+
+    impure function HasKey (constant key : KEY_TYPE) return boolean is
+    begin
+      return Find(key) /= null;
+    end function HasKey;
+
+    impure function Count return natural is
+      variable value : natural := 0;
+    begin
+      for i in entry_count'range loop
+        value := value + entry_count(i);
+      end loop;
+      return value;
+    end function Count;
+
+
+  end protected body PT_DICT;
+
+
+  procedure Merge(d0 : inout PT_DICT; d1 : inout PT_DICT; dout : inout PT_DICT) is
+  begin
+  end procedure Merge;
+
+
+end package body corelib_Dict;
diff --git a/testsuite/gna/bug061/test_dict.vhdl b/testsuite/gna/bug061/test_dict.vhdl
new file mode 100644
index 000000000..b4b1c4f93
--- /dev/null
+++ b/testsuite/gna/bug061/test_dict.vhdl
@@ -0,0 +1,17 @@
+entity test_dict is
+end test_dict;
+
+use work.datastructures.all;
+
+architecture behav of test_dict is
+begin
+  process
+    variable dict : String_String_Dict;
+  begin
+    dict.set ("entity", "module");
+    dict.set ("process", "always");
+
+    assert dict.get ("entity") = "module" severity failure;
+    wait;
+  end process;
+end behav;
diff --git a/testsuite/gna/bug061/testsuite.sh b/testsuite/gna/bug061/testsuite.sh
new file mode 100755
index 000000000..483eec5e1
--- /dev/null
+++ b/testsuite/gna/bug061/testsuite.sh
@@ -0,0 +1,15 @@
+#! /bin/sh
+
+. ../../testenv.sh
+
+GHDL_STD_FLAGS=--std=08
+analyze dictp.vhdl
+analyze dictp08.vhdl
+
+analyze -g datastructure.vhdl
+analyze -g test_dict.vhdl
+elab_simulate test_dict
+
+clean
+
+echo "Test successful"