aboutsummaryrefslogtreecommitdiffstats
path: root/testsuite/gna/bug061
diff options
context:
space:
mode:
Diffstat (limited to 'testsuite/gna/bug061')
-rw-r--r--testsuite/gna/bug061/datastructure.vhdl69
-rw-r--r--testsuite/gna/bug061/dictp.vhdl194
-rw-r--r--testsuite/gna/bug061/dictp08.vhdl187
-rw-r--r--testsuite/gna/bug061/test_dict.vhdl17
-rwxr-xr-xtestsuite/gna/bug061/testsuite.sh15
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"