diff options
author | Tristan Gingold <tgingold@free.fr> | 2016-10-01 06:52:15 +0200 |
---|---|---|
committer | Tristan Gingold <tgingold@free.fr> | 2016-10-01 06:52:15 +0200 |
commit | fa1727c1ce8cf56069e853c780adc39beee8fc71 (patch) | |
tree | cfaaa7fedf8fd35147ce98794c017f310ba6089d | |
parent | 44095bf454b98b580ff41c92da52ce431a45828d (diff) | |
download | ghdl-fa1727c1ce8cf56069e853c780adc39beee8fc71.tar.gz ghdl-fa1727c1ce8cf56069e853c780adc39beee8fc71.tar.bz2 ghdl-fa1727c1ce8cf56069e853c780adc39beee8fc71.zip |
Add a test for interface subprograms.
-rw-r--r-- | testsuite/gna/bug061/datastructure.vhdl | 69 | ||||
-rw-r--r-- | testsuite/gna/bug061/dictp.vhdl | 194 | ||||
-rw-r--r-- | testsuite/gna/bug061/dictp08.vhdl | 187 | ||||
-rw-r--r-- | testsuite/gna/bug061/test_dict.vhdl | 17 | ||||
-rwxr-xr-x | testsuite/gna/bug061/testsuite.sh | 15 |
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" |