diff options
Diffstat (limited to 'testsuite/vests/vhdl-ams/ashenden/compliant/access-types')
18 files changed, 1486 insertions, 0 deletions
diff --git a/testsuite/vests/vhdl-ams/ashenden/compliant/access-types/bounded_buffer_adt.vhd b/testsuite/vests/vhdl-ams/ashenden/compliant/access-types/bounded_buffer_adt.vhd new file mode 100644 index 000000000..3041d0380 --- /dev/null +++ b/testsuite/vests/vhdl-ams/ashenden/compliant/access-types/bounded_buffer_adt.vhd @@ -0,0 +1,114 @@ + +-- Copyright (C) 2002 Morgan Kaufmann Publishers, Inc + +-- This file is part of VESTs (Vhdl tESTs). + +-- VESTs is free software; you can redistribute it and/or modify it +-- under the terms of the GNU General Public License as published by the +-- Free Software Foundation; either version 2 of the License, or (at +-- your option) any later version. + +-- VESTs is distributed in the hope that it will be useful, but WITHOUT +-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +-- for more details. + +-- You should have received a copy of the GNU General Public License +-- along with VESTs; if not, write to the Free Software Foundation, +-- Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + +package bounded_buffer_adt is + + subtype byte is bit_vector(0 to 7); + + type bounded_buffer_object; -- private + + type bounded_buffer is access bounded_buffer_object; + + function new_bounded_buffer ( size : in positive ) return bounded_buffer; + -- creates a bounded buffer object with 'size' bytes of storage + + procedure test_empty ( variable the_bounded_buffer : in bounded_buffer; + is_empty : out boolean ); + -- tests whether the bounded buffer is empty (i.e., no data to read) + + procedure test_full ( variable the_bounded_buffer : in bounded_buffer; + is_full : out boolean ); + -- tests whether the bounded buffer is full (i.e., no data can be written) + + procedure write ( the_bounded_buffer : inout bounded_buffer; data : in byte ); + -- if the bounded buffer is not full, writes the data + -- if it is full, assertion violation with severity failure + + procedure read ( the_bounded_buffer : inout bounded_buffer; data : out byte ); + -- if the bounded buffer is not empty, read the first byte of data + -- if it is empty, assertion violation with severity failure + +---------------------------------------------------------------- + + -- the following types are private to the ADT + + type store_array is array (natural range <>) of byte; + + type store_ptr is access store_array; + + type bounded_buffer_object is record + byte_count : natural; + head_index, tail_index : natural; + store : store_ptr; + end record bounded_buffer_object; + +end package bounded_buffer_adt; + + + +package body bounded_buffer_adt is + + function new_bounded_buffer ( size : in positive ) return bounded_buffer is + begin + return new bounded_buffer_object'( + byte_count => 0, head_index => 0, tail_index => 0, + store => new store_array(0 to size - 1) ); + end function new_bounded_buffer; + + procedure test_empty ( variable the_bounded_buffer : in bounded_buffer; + is_empty : out boolean ) is + begin + is_empty := the_bounded_buffer.byte_count = 0; + end procedure test_empty; + + procedure test_full ( variable the_bounded_buffer : in bounded_buffer; + is_full : out boolean ) is + begin + is_full := the_bounded_buffer.byte_count = the_bounded_buffer.store'length; + end procedure test_full; + + procedure write ( the_bounded_buffer : inout bounded_buffer; data : in byte ) is + variable buffer_full : boolean; + begin + test_full(the_bounded_buffer, buffer_full); + if buffer_full then + report "write to full bounded buffer" severity failure; + else + the_bounded_buffer.store(the_bounded_buffer.tail_index) := data; + the_bounded_buffer.tail_index := (the_bounded_buffer.tail_index + 1) + mod the_bounded_buffer.store'length; + the_bounded_buffer.byte_count := the_bounded_buffer.byte_count + 1; + end if; + end procedure write; + + procedure read ( the_bounded_buffer : inout bounded_buffer; data : out byte ) is + variable buffer_empty : boolean; + begin + test_empty(the_bounded_buffer, buffer_empty); + if buffer_empty then + report "read from empty bounded buffer" severity failure; + else + data := the_bounded_buffer.store(the_bounded_buffer.head_index); + the_bounded_buffer.head_index := (the_bounded_buffer.head_index + 1) + mod the_bounded_buffer.store'length; + the_bounded_buffer.byte_count := the_bounded_buffer.byte_count - 1; + end if; + end procedure read; + +end package body bounded_buffer_adt; diff --git a/testsuite/vests/vhdl-ams/ashenden/compliant/access-types/index-ams.txt b/testsuite/vests/vhdl-ams/ashenden/compliant/access-types/index-ams.txt new file mode 100644 index 000000000..6a27774ef --- /dev/null +++ b/testsuite/vests/vhdl-ams/ashenden/compliant/access-types/index-ams.txt @@ -0,0 +1,30 @@ +--------------------------------------------------------------------------------------------------------------------------------------------- +-- Chapter 20 - Access Types and Abstract Data Types +--------------------------------------------------------------------------------------------------------------------------------------------- +-- Filename Primary Unit Secondary Unit Figure/Section +----------- ------------ -------------- -------------- +list_traversal.vhd entity list_traversal test Figure 20-5 +list_search.vhd entity list_search test Figure 20-7 +bounded_buffer_adt.vhd package bounded_buffer_adt body Figures 20-8, 20-11 +receiver.vhd entity receiver test Figure 20-9 +ordered_collection_adt.vhd package «element_type_simple_name»_ordered_collection_adt +-- body Figures 20-12, 20-16 +stimulus_types-1.vhd package stimulus_types body Figure 20-13 +test_bench-1.vhd package stimulus_element_ordered_collection_adt +-- body -- +-- entity test_bench initial_test Figure 20-14 +inline_01.vhd entity inline_01 test Section 20.1 +inline_02a.vhd entity inline_02a test Section 20.1 +inline_03.vhd entity inline_03 test Section 20.1 +inline_04a.vhd entity inline_04a test Section 20.1 +inline_05.vhd entity inline_05 test Section 20.1 +inline_06a.vhd entity inline_06a test Section 20.2 +inline_07a.vhd entity inline_07a test Section 20.2 +inline_08.vhd entity inline_08 test Section 20.2 +inline_09.vhd entity inline_09 test Section 20.2 +--------------------------------------------------------------------------------------------------------------------------------------------- +-- TestBenches +--------------------------------------------------------------------------------------------------------------------------------------------- +-- Filename Primary Unit Secondary Unit Tested Model +------------ ------------ -------------- ------------ +tb_bounded_buffer_adt.vhd entity tb_bounded_buffer_adt test bounded_buffer_adt.vhd diff --git a/testsuite/vests/vhdl-ams/ashenden/compliant/access-types/inline_01.vhd b/testsuite/vests/vhdl-ams/ashenden/compliant/access-types/inline_01.vhd new file mode 100644 index 000000000..2d326bda1 --- /dev/null +++ b/testsuite/vests/vhdl-ams/ashenden/compliant/access-types/inline_01.vhd @@ -0,0 +1,73 @@ + +-- Copyright (C) 2002 Morgan Kaufmann Publishers, Inc + +-- This file is part of VESTs (Vhdl tESTs). + +-- VESTs is free software; you can redistribute it and/or modify it +-- under the terms of the GNU General Public License as published by the +-- Free Software Foundation; either version 2 of the License, or (at +-- your option) any later version. + +-- VESTs is distributed in the hope that it will be useful, but WITHOUT +-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +-- for more details. + +-- You should have received a copy of the GNU General Public License +-- along with VESTs; if not, write to the Free Software Foundation, +-- Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + +entity inline_01 is + +end entity inline_01; + + +---------------------------------------------------------------- + + +architecture test of inline_01 is +begin + + + process is + + -- code from book: + + type natural_ptr is access natural; + + variable count : natural_ptr; + + -- end of code from book + + begin + + -- code from book: + + count := new natural; + + count.all := 10; + + if count.all = 0 then + -- . . . + -- not in book + report "count.all = 0"; + -- end not in book + end if; + + -- end of code from book + + if count.all /= 0 then + report "count.all /= 0"; + end if; + + -- code from book: + + count := new natural'(10); + + -- end of code from book + + wait; + end process; + + +end architecture test; diff --git a/testsuite/vests/vhdl-ams/ashenden/compliant/access-types/inline_02a.vhd b/testsuite/vests/vhdl-ams/ashenden/compliant/access-types/inline_02a.vhd new file mode 100644 index 000000000..2a0e4e686 --- /dev/null +++ b/testsuite/vests/vhdl-ams/ashenden/compliant/access-types/inline_02a.vhd @@ -0,0 +1,59 @@ + +-- Copyright (C) 2002 Morgan Kaufmann Publishers, Inc + +-- This file is part of VESTs (Vhdl tESTs). + +-- VESTs is free software; you can redistribute it and/or modify it +-- under the terms of the GNU General Public License as published by the +-- Free Software Foundation; either version 2 of the License, or (at +-- your option) any later version. + +-- VESTs is distributed in the hope that it will be useful, but WITHOUT +-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +-- for more details. + +-- You should have received a copy of the GNU General Public License +-- along with VESTs; if not, write to the Free Software Foundation, +-- Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + +entity inline_02a is + +end entity inline_02a; + + +---------------------------------------------------------------- + + +architecture test of inline_02a is +begin + + + process is + + -- code from book: + + type stimulus_record is record + stimulus_time : time; + stimulus_value : real_vector(0 to 3); + end record stimulus_record; + + type stimulus_ptr is access stimulus_record; + + variable bus_stimulus : stimulus_ptr; + + -- end of code from book + + begin + + -- code from book: + + bus_stimulus := new stimulus_record'( 20 ns, real_vector'(0.0, 5.0, 0.0, 42.0) ); + + -- end of code from book + + wait; + end process; + + +end architecture test; diff --git a/testsuite/vests/vhdl-ams/ashenden/compliant/access-types/inline_03.vhd b/testsuite/vests/vhdl-ams/ashenden/compliant/access-types/inline_03.vhd new file mode 100644 index 000000000..e4ed82464 --- /dev/null +++ b/testsuite/vests/vhdl-ams/ashenden/compliant/access-types/inline_03.vhd @@ -0,0 +1,88 @@ + +-- Copyright (C) 2002 Morgan Kaufmann Publishers, Inc + +-- This file is part of VESTs (Vhdl tESTs). + +-- VESTs is free software; you can redistribute it and/or modify it +-- under the terms of the GNU General Public License as published by the +-- Free Software Foundation; either version 2 of the License, or (at +-- your option) any later version. + +-- VESTs is distributed in the hope that it will be useful, but WITHOUT +-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +-- for more details. + +-- You should have received a copy of the GNU General Public License +-- along with VESTs; if not, write to the Free Software Foundation, +-- Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + +entity inline_03 is + +end entity inline_03; + + +---------------------------------------------------------------- + + +architecture test of inline_03 is +begin + + + process is + + type natural_ptr is access natural; + + -- code from book: + + variable count1, count2 : natural_ptr; + + -- end of code from book + + begin + + -- code from book: + + count1 := new natural'(5); + count2 := new natural'(10); + + count2 := count1; + + count1.all := 20; + + -- end of code from book + + assert + -- code from book: + count1 = count2 + -- end of code from book + ; + + -- code from book: + + count1 := new natural'(30); + count2 := new natural'(30); + + -- end of code from book + + assert count1 = count2; + + assert + -- code from book: + count1.all = count2.all + -- end of code from book + ; + + -- code from book: + + if count1 /= null then + count1.all := count1.all + 1; + end if; + + -- end of code from book + + wait; + end process; + + +end architecture test; diff --git a/testsuite/vests/vhdl-ams/ashenden/compliant/access-types/inline_04a.vhd b/testsuite/vests/vhdl-ams/ashenden/compliant/access-types/inline_04a.vhd new file mode 100644 index 000000000..82aa9448f --- /dev/null +++ b/testsuite/vests/vhdl-ams/ashenden/compliant/access-types/inline_04a.vhd @@ -0,0 +1,61 @@ + +-- Copyright (C) 2002 Morgan Kaufmann Publishers, Inc + +-- This file is part of VESTs (Vhdl tESTs). + +-- VESTs is free software; you can redistribute it and/or modify it +-- under the terms of the GNU General Public License as published by the +-- Free Software Foundation; either version 2 of the License, or (at +-- your option) any later version. + +-- VESTs is distributed in the hope that it will be useful, but WITHOUT +-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +-- for more details. + +-- You should have received a copy of the GNU General Public License +-- along with VESTs; if not, write to the Free Software Foundation, +-- Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + +entity inline_04a is + +end entity inline_04a; + + +---------------------------------------------------------------- + + +architecture test of inline_04a is +begin + + + process is + + -- code from book: + + type stimulus_record is record + stimulus_time : time; + stimulus_value : real_vector(0 to 3); + end record stimulus_record; + + type stimulus_ptr is access stimulus_record; + + variable bus_stimulus : stimulus_ptr; + + -- end of code from book + + begin + + bus_stimulus := new stimulus_record; + + bus_stimulus.all := stimulus_record'(20 ns, real_vector'(0.0, 5.0, 0.0, 42.0) ); + + report time'image(bus_stimulus.all.stimulus_time); + + report time'image(bus_stimulus.stimulus_time); + + wait; + end process; + + +end architecture test; diff --git a/testsuite/vests/vhdl-ams/ashenden/compliant/access-types/inline_05.vhd b/testsuite/vests/vhdl-ams/ashenden/compliant/access-types/inline_05.vhd new file mode 100644 index 000000000..8a03a87f4 --- /dev/null +++ b/testsuite/vests/vhdl-ams/ashenden/compliant/access-types/inline_05.vhd @@ -0,0 +1,86 @@ + +-- Copyright (C) 2002 Morgan Kaufmann Publishers, Inc + +-- This file is part of VESTs (Vhdl tESTs). + +-- VESTs is free software; you can redistribute it and/or modify it +-- under the terms of the GNU General Public License as published by the +-- Free Software Foundation; either version 2 of the License, or (at +-- your option) any later version. + +-- VESTs is distributed in the hope that it will be useful, but WITHOUT +-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +-- for more details. + +-- You should have received a copy of the GNU General Public License +-- along with VESTs; if not, write to the Free Software Foundation, +-- Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + +entity inline_05 is + +end entity inline_05; + + +---------------------------------------------------------------- + + +architecture test of inline_05 is +begin + + + process is + + -- code from book: + + type coordinate is array (1 to 3) of real; + type coordinate_ptr is access coordinate; + + variable origin : coordinate_ptr := new coordinate'(0.0, 0.0, 0.0); + + type time_array is array (positive range <>) of time; + variable activation_times : time_array(1 to 100); + + -- end of code from book + + begin + + report real'image( origin(1) ); + report real'image( origin(2) ); + report real'image( origin(3) ); + report real'image( origin.all(1) ); + + wait; + end process; + + + process is + + type time_array is array (positive range <>) of time; + + -- code from book: + + type time_array_ptr is access time_array; + + variable activation_times : time_array_ptr; + + -- end of code from book + + begin + + -- code from book: + + activation_times := new time_array'(10 us, 15 us, 40 us); + + activation_times := new time_array'( activation_times.all + & time_array'(70 us, 100 us) ); + + activation_times := new time_array(1 to 10); + + -- end of code from book + + wait; + end process; + + +end architecture test; diff --git a/testsuite/vests/vhdl-ams/ashenden/compliant/access-types/inline_06a.vhd b/testsuite/vests/vhdl-ams/ashenden/compliant/access-types/inline_06a.vhd new file mode 100644 index 000000000..4322b31ed --- /dev/null +++ b/testsuite/vests/vhdl-ams/ashenden/compliant/access-types/inline_06a.vhd @@ -0,0 +1,51 @@ + +-- Copyright (C) 2002 Morgan Kaufmann Publishers, Inc + +-- This file is part of VESTs (Vhdl tESTs). + +-- VESTs is free software; you can redistribute it and/or modify it +-- under the terms of the GNU General Public License as published by the +-- Free Software Foundation; either version 2 of the License, or (at +-- your option) any later version. + +-- VESTs is distributed in the hope that it will be useful, but WITHOUT +-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +-- for more details. + +-- You should have received a copy of the GNU General Public License +-- along with VESTs; if not, write to the Free Software Foundation, +-- Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + +entity inline_06a is + +end entity inline_06a; + + +---------------------------------------------------------------- + + +architecture test of inline_06a is +begin + + + process is + + -- code from book: + + type value_cell is record + value : real_vector(0 to 3); + next_cell : value_ptr; + end record value_cell; + + type value_ptr is access value_cell; + + -- end of code from book + + begin + + wait; + end process; + + +end architecture test; diff --git a/testsuite/vests/vhdl-ams/ashenden/compliant/access-types/inline_07a.vhd b/testsuite/vests/vhdl-ams/ashenden/compliant/access-types/inline_07a.vhd new file mode 100644 index 000000000..64b633797 --- /dev/null +++ b/testsuite/vests/vhdl-ams/ashenden/compliant/access-types/inline_07a.vhd @@ -0,0 +1,72 @@ + +-- Copyright (C) 2002 Morgan Kaufmann Publishers, Inc + +-- This file is part of VESTs (Vhdl tESTs). + +-- VESTs is free software; you can redistribute it and/or modify it +-- under the terms of the GNU General Public License as published by the +-- Free Software Foundation; either version 2 of the License, or (at +-- your option) any later version. + +-- VESTs is distributed in the hope that it will be useful, but WITHOUT +-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +-- for more details. + +-- You should have received a copy of the GNU General Public License +-- along with VESTs; if not, write to the Free Software Foundation, +-- Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + +entity inline_07a is + +end entity inline_07a; + + +---------------------------------------------------------------- + + +architecture test of inline_07a is +begin + + + process is + + -- code from book: + + type value_cell; + + type value_ptr is access value_cell; + + type value_cell is record + value : real_vector(0 to 3); + next_cell : value_ptr; + end record value_cell; + + variable value_list : value_ptr; + + -- end of code from book + + begin + + -- code from book: + + if value_list /= null then + -- . . . -- do something with the list + -- not in book + report "value_list /= null"; + -- end not in book + end if; + + value_list := new value_cell'( real_vector'(0.0, 5.0, 0.0, 42.0), value_list ); + + value_list := new value_cell'( real_vector'(3.3, 2.2, 0.27, 1.9), value_list ); + + value_list := new value_cell'( real_vector'(2.9, 0.1, 21.12, 8.3), value_list ); + + -- end of code from book + + wait; + end process; + + +end architecture test; diff --git a/testsuite/vests/vhdl-ams/ashenden/compliant/access-types/inline_08.vhd b/testsuite/vests/vhdl-ams/ashenden/compliant/access-types/inline_08.vhd new file mode 100644 index 000000000..9533f4fd1 --- /dev/null +++ b/testsuite/vests/vhdl-ams/ashenden/compliant/access-types/inline_08.vhd @@ -0,0 +1,48 @@ + +-- Copyright (C) 2002 Morgan Kaufmann Publishers, Inc + +-- This file is part of VESTs (Vhdl tESTs). + +-- VESTs is free software; you can redistribute it and/or modify it +-- under the terms of the GNU General Public License as published by the +-- Free Software Foundation; either version 2 of the License, or (at +-- your option) any later version. + +-- VESTs is distributed in the hope that it will be useful, but WITHOUT +-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +-- for more details. + +-- You should have received a copy of the GNU General Public License +-- along with VESTs; if not, write to the Free Software Foundation, +-- Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + +entity inline_08 is + +end entity inline_08; + + +---------------------------------------------------------------- + + +architecture test of inline_08 is + + type T is (t1, t2, t3); + + -- code from book: + + type T_ptr is access T; + + procedure deallocate ( P : inout T_ptr ); + + -- end of code from book + + procedure deallocate ( P : inout T_ptr ) is + begin + null; + end procedure deallocate; + +begin + + +end architecture test; diff --git a/testsuite/vests/vhdl-ams/ashenden/compliant/access-types/inline_09.vhd b/testsuite/vests/vhdl-ams/ashenden/compliant/access-types/inline_09.vhd new file mode 100644 index 000000000..d570cee51 --- /dev/null +++ b/testsuite/vests/vhdl-ams/ashenden/compliant/access-types/inline_09.vhd @@ -0,0 +1,67 @@ + +-- Copyright (C) 2002 Morgan Kaufmann Publishers, Inc + +-- This file is part of VESTs (Vhdl tESTs). + +-- VESTs is free software; you can redistribute it and/or modify it +-- under the terms of the GNU General Public License as published by the +-- Free Software Foundation; either version 2 of the License, or (at +-- your option) any later version. + +-- VESTs is distributed in the hope that it will be useful, but WITHOUT +-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +-- for more details. + +-- You should have received a copy of the GNU General Public License +-- along with VESTs; if not, write to the Free Software Foundation, +-- Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + +entity inline_09 is + +end entity inline_09; + + +---------------------------------------------------------------- + + +architecture test of inline_09 is + +begin + + process is + + type value_cell; + + type value_ptr is access value_cell; + + type value_cell is record + value : bit_vector(0 to 3); + next_cell : value_ptr; + end record value_cell; + + variable value_list, cell_to_be_deleted : value_ptr; + + begin + value_list := new value_cell'( B"1000", value_list ); + value_list := new value_cell'( B"0010", value_list ); + value_list := new value_cell'( B"0000", value_list ); + + -- code from book: + + cell_to_be_deleted := value_list; + value_list := value_list.next_cell; + deallocate(cell_to_be_deleted); + + while value_list /= null loop + cell_to_be_deleted := value_list; + value_list := value_list.next_cell; + deallocate(cell_to_be_deleted); + end loop; + + -- end of code from book + + wait; + end process; + +end architecture test; diff --git a/testsuite/vests/vhdl-ams/ashenden/compliant/access-types/list_search.vhd b/testsuite/vests/vhdl-ams/ashenden/compliant/access-types/list_search.vhd new file mode 100644 index 000000000..57208983d --- /dev/null +++ b/testsuite/vests/vhdl-ams/ashenden/compliant/access-types/list_search.vhd @@ -0,0 +1,80 @@ + +-- Copyright (C) 2002 Morgan Kaufmann Publishers, Inc + +-- This file is part of VESTs (Vhdl tESTs). + +-- VESTs is free software; you can redistribute it and/or modify it +-- under the terms of the GNU General Public License as published by the +-- Free Software Foundation; either version 2 of the License, or (at +-- your option) any later version. + +-- VESTs is distributed in the hope that it will be useful, but WITHOUT +-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +-- for more details. + +-- You should have received a copy of the GNU General Public License +-- along with VESTs; if not, write to the Free Software Foundation, +-- Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + +entity list_search is + +end entity list_search; + + +---------------------------------------------------------------- + + +architecture test of list_search is + + signal s : bit_vector(0 to 3); + +begin + + process is + + type value_cell; + + type value_ptr is access value_cell; + + type value_cell is record + value : bit_vector(0 to 3); + next_cell : value_ptr; + end record value_cell; + + variable value_list, current_cell : value_ptr; + variable search_value : bit_vector(0 to 3); + + begin + value_list := new value_cell'( B"1000", value_list ); + value_list := new value_cell'( B"0010", value_list ); + value_list := new value_cell'( B"0000", value_list ); + + search_value := B"0010"; + + -- code from book: + + current_cell := value_list; + while current_cell /= null + and current_cell.value /= search_value loop + current_cell := current_cell.next_cell; + end loop; + assert current_cell /= null + report "search for value failed"; + + -- end of code from book + + search_value := B"1111"; + + current_cell := value_list; + while current_cell /= null + and current_cell.value /= search_value loop + current_cell := current_cell.next_cell; + end loop; + assert current_cell /= null + report "search for value failed"; + + wait; + end process; + +end architecture test; diff --git a/testsuite/vests/vhdl-ams/ashenden/compliant/access-types/list_traversal.vhd b/testsuite/vests/vhdl-ams/ashenden/compliant/access-types/list_traversal.vhd new file mode 100644 index 000000000..4c0dedd5f --- /dev/null +++ b/testsuite/vests/vhdl-ams/ashenden/compliant/access-types/list_traversal.vhd @@ -0,0 +1,66 @@ + +-- Copyright (C) 2002 Morgan Kaufmann Publishers, Inc + +-- This file is part of VESTs (Vhdl tESTs). + +-- VESTs is free software; you can redistribute it and/or modify it +-- under the terms of the GNU General Public License as published by the +-- Free Software Foundation; either version 2 of the License, or (at +-- your option) any later version. + +-- VESTs is distributed in the hope that it will be useful, but WITHOUT +-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +-- for more details. + +-- You should have received a copy of the GNU General Public License +-- along with VESTs; if not, write to the Free Software Foundation, +-- Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + +entity list_traversal is + +end entity list_traversal; + + +---------------------------------------------------------------- + + +architecture test of list_traversal is + + signal s : bit_vector(0 to 3); + +begin + + process is + + type value_cell; + + type value_ptr is access value_cell; + + type value_cell is record + value : bit_vector(0 to 3); + next_cell : value_ptr; + end record value_cell; + + variable value_list, current_cell : value_ptr; + + begin + value_list := new value_cell'( B"1000", value_list ); + value_list := new value_cell'( B"0010", value_list ); + value_list := new value_cell'( B"0000", value_list ); + + -- code from book: + + current_cell := value_list; + while current_cell /= null loop + s <= current_cell.value; + wait for 10 ns; + current_cell := current_cell.next_cell; + end loop; + + -- end of code from book + + wait; + end process; + +end architecture test; diff --git a/testsuite/vests/vhdl-ams/ashenden/compliant/access-types/ordered_collection_adt.vhd b/testsuite/vests/vhdl-ams/ashenden/compliant/access-types/ordered_collection_adt.vhd new file mode 100644 index 000000000..5a011748a --- /dev/null +++ b/testsuite/vests/vhdl-ams/ashenden/compliant/access-types/ordered_collection_adt.vhd @@ -0,0 +1,163 @@ + +-- Copyright (C) 2002 Morgan Kaufmann Publishers, Inc + +-- This file is part of VESTs (Vhdl tESTs). + +-- VESTs is free software; you can redistribute it and/or modify it +-- under the terms of the GNU General Public License as published by the +-- Free Software Foundation; either version 2 of the License, or (at +-- your option) any later version. + +-- VESTs is distributed in the hope that it will be useful, but WITHOUT +-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +-- for more details. + +-- You should have received a copy of the GNU General Public License +-- along with VESTs; if not, write to the Free Software Foundation, +-- Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + +package «element_type_simple_name»_ordered_collection_adt is + + -- template: fill in the placeholders to specialize for a particular type + + alias element_type is «element_type»; + alias key_type is «key_type»; + alias key_of is «key_function» [ element_type return key_type ]; + alias "<" is «less_than_function» [ key_type, key_type return boolean ]; + + -- types provided by the package + + type ordered_collection_object; -- private + type position_object; -- private + + type ordered_collection is access ordered_collection_object; + type position is access position_object; + + -- operations on ordered collections + + function new_ordered_collection return ordered_collection; + -- returns an empty ordered collection of element_type values + + procedure insert ( c : inout ordered_collection; e : in element_type ); + -- inserts e into c in position determined by key_of(e) + + procedure get_element ( variable p : in position; e : out element_type ); + -- returns the element value at position p in its collection + + procedure test_null_position ( variable p : in position; is_null : out boolean ); + -- test whether p refers to no position in its collection + + procedure search ( variable c : in ordered_collection; k : in key_type; + p : out position ); + -- searches for an element with key k in c, and returns the position of + -- that element, or, if not found, a position for which test_null_position + -- returns true + + procedure find_first ( variable c : in ordered_collection; p : out position ); + -- returns the position of the first element of c + + procedure advance ( p : inout position ); + -- advances p to the next element in its collection, + -- or if there are no more, sets p so that test_null_position returns true + + procedure delete ( p : inout position ); + -- deletes the element at position p from its collection, and advances p + + -- private types: pretend these are not visible + + type ordered_collection_object is + record + element : element_type; + next_element, prev_element : ordered_collection; + end record ordered_collection_object; + + type position_object is + record + the_collection : ordered_collection; + current_element : ordered_collection; + end record position_object; + +end package «element_type_simple_name»_ordered_collection_adt; + + +package body «element_type_simple_name»_ordered_collection_adt is + + function new_ordered_collection return ordered_collection is + variable result : ordered_collection := new ordered_collection_object; + begin + result.next_element := result; + result.prev_element := result; + return result; + end function new_ordered_collection; + + procedure insert ( c : inout ordered_collection; e : in element_type ) is + variable current_element : ordered_collection := c.next_element; + variable new_element : ordered_collection; + begin + while current_element /= c + and key_of(current_element.element) < key_of(e) loop + current_element := current_element.next_element; + end loop; + -- insert new element before current_element + new_element := new ordered_collection_object'( + element => e, + next_element => current_element, + prev_element => current_element.prev_element ); + new_element.next_element.prev_element := new_element; + new_element.prev_element.next_element := new_element; + end procedure insert; + + procedure get_element ( variable p : in position; e : out element_type ) is + begin + e := p.current_element.element; + end procedure get_element; + + procedure test_null_position ( variable p : in position; is_null : out boolean ) is + begin + is_null := p.current_element = p.the_collection; + end procedure test_null_position; + + procedure search ( variable c : in ordered_collection; k : in key_type; + p : out position ) is + variable current_element : ordered_collection := c.next_element; + begin + while current_element /= c + and key_of(current_element.element) < k loop + current_element := current_element.next_element; + end loop; + if current_element = c or k < key_of(current_element.element) then + p := new position_object'(c, c); -- null position + else + p := new position_object'(c, current_element); + end if; + end procedure search; + + procedure find_first ( variable c : in ordered_collection; p : out position ) is + begin + p := new position_object'(c, c.next_element); + end procedure find_first; + + procedure advance ( p : inout position ) is + variable is_null : boolean; + begin + test_null_position(p, is_null); + if not is_null then + p.current_element := p.current_element.next_element; + end if; + end procedure advance; + + procedure delete ( p : inout position ) is + variable is_null : boolean; + begin + test_null_position(p, is_null); + if not is_null then + p.current_element.next_element.prev_element + := p.current_element.prev_element; + p.current_element.prev_element.next_element + := p.current_element.next_element; + p.current_element := p.current_element.next_element; + end if; + end procedure delete; + +end package body «element_type_simple_name»_ordered_collection_adt; diff --git a/testsuite/vests/vhdl-ams/ashenden/compliant/access-types/receiver.vhd b/testsuite/vests/vhdl-ams/ashenden/compliant/access-types/receiver.vhd new file mode 100644 index 000000000..e7aad315c --- /dev/null +++ b/testsuite/vests/vhdl-ams/ashenden/compliant/access-types/receiver.vhd @@ -0,0 +1,62 @@ + +-- Copyright (C) 2002 Morgan Kaufmann Publishers, Inc + +-- This file is part of VESTs (Vhdl tESTs). + +-- VESTs is free software; you can redistribute it and/or modify it +-- under the terms of the GNU General Public License as published by the +-- Free Software Foundation; either version 2 of the License, or (at +-- your option) any later version. + +-- VESTs is distributed in the hope that it will be useful, but WITHOUT +-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +-- for more details. + +-- You should have received a copy of the GNU General Public License +-- along with VESTs; if not, write to the Free Software Foundation, +-- Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + +entity receiver is +end entity receiver; + + + +architecture test of receiver is +begin + + -- code from book + + receiver : process is + + use work.bounded_buffer_adt.all; + + variable receive_buffer : bounded_buffer := new_bounded_buffer(2048); + variable buffer_overrun, buffer_underrun : boolean; + -- . . . + + -- not in book + variable received_byte, check_byte : byte; + -- end not in book + + begin + -- . . . + + test_full(receive_buffer, buffer_overrun); + if not buffer_overrun then + write(receive_buffer, received_byte); + end if; + -- . . . + + test_empty(receive_buffer, buffer_underrun); + if not buffer_underrun then + read(receive_buffer, check_byte); + end if; + -- . . . + + end process receiver; + + -- end code from book + +end architecture test; + diff --git a/testsuite/vests/vhdl-ams/ashenden/compliant/access-types/stimulus_types-1.vhd b/testsuite/vests/vhdl-ams/ashenden/compliant/access-types/stimulus_types-1.vhd new file mode 100644 index 000000000..a7d924533 --- /dev/null +++ b/testsuite/vests/vhdl-ams/ashenden/compliant/access-types/stimulus_types-1.vhd @@ -0,0 +1,42 @@ + +-- Copyright (C) 2002 Morgan Kaufmann Publishers, Inc + +-- This file is part of VESTs (Vhdl tESTs). + +-- VESTs is free software; you can redistribute it and/or modify it +-- under the terms of the GNU General Public License as published by the +-- Free Software Foundation; either version 2 of the License, or (at +-- your option) any later version. + +-- VESTs is distributed in the hope that it will be useful, but WITHOUT +-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +-- for more details. + +-- You should have received a copy of the GNU General Public License +-- along with VESTs; if not, write to the Free Software Foundation, +-- Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + +package stimulus_types is + + constant stimulus_vector_length : positive := 4; + + type stimulus_element is record + application_time : delay_length; + pattern : real_vector(0 to stimulus_vector_length - 1); + end record stimulus_element; + + function stimulus_key ( stimulus : stimulus_element ) return delay_length; + +end package stimulus_types; + +---------------------------------------------------------------- + +package body stimulus_types is + + function stimulus_key ( stimulus : stimulus_element ) return delay_length is + begin + return stimulus.application_time; + end function stimulus_key; + +end package body stimulus_types; diff --git a/testsuite/vests/vhdl-ams/ashenden/compliant/access-types/tb_bounded_buffer_adt.vhd b/testsuite/vests/vhdl-ams/ashenden/compliant/access-types/tb_bounded_buffer_adt.vhd new file mode 100644 index 000000000..9da5aa2aa --- /dev/null +++ b/testsuite/vests/vhdl-ams/ashenden/compliant/access-types/tb_bounded_buffer_adt.vhd @@ -0,0 +1,100 @@ + +-- Copyright (C) 2002 Morgan Kaufmann Publishers, Inc + +-- This file is part of VESTs (Vhdl tESTs). + +-- VESTs is free software; you can redistribute it and/or modify it +-- under the terms of the GNU General Public License as published by the +-- Free Software Foundation; either version 2 of the License, or (at +-- your option) any later version. + +-- VESTs is distributed in the hope that it will be useful, but WITHOUT +-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +-- for more details. + +-- You should have received a copy of the GNU General Public License +-- along with VESTs; if not, write to the Free Software Foundation, +-- Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + +entity tb_bounded_buffer_adt is +end entity tb_bounded_buffer_adt; + + +architecture test of tb_bounded_buffer_adt is +begin + + process is + + use work.bounded_buffer_adt.all; + + variable buf : bounded_buffer := new_bounded_buffer(4); + variable empty, full : boolean; + variable d : byte; + + begin + test_empty(buf, empty); + assert empty; + test_full(buf, full); + assert not full; + + write(buf, X"01"); + write(buf, X"02"); + + test_empty(buf, empty); + assert not empty; + test_full(buf, full); + assert not full; + + write(buf, X"03"); + write(buf, X"04"); + + test_empty(buf, empty); + assert not empty; + test_full(buf, full); + assert full; + + write(buf, X"05"); + + read(buf, d); + read(buf, d); + + test_empty(buf, empty); + assert not empty; + test_full(buf, full); + assert not full; + + read(buf, d); + read(buf, d); + + test_empty(buf, empty); + assert empty; + test_full(buf, full); + assert not full; + + read(buf, d); + + write(buf, X"06"); + write(buf, X"07"); + write(buf, X"08"); + read(buf, d); + read(buf, d); + write(buf, X"09"); + read(buf, d); + write(buf, X"0A"); + read(buf, d); + write(buf, X"0B"); + read(buf, d); + write(buf, X"0C"); + read(buf, d); + write(buf, X"0D"); + read(buf, d); + write(buf, X"0E"); + read(buf, d); + write(buf, X"0F"); + read(buf, d); + + wait; + end process; + +end architecture test; diff --git a/testsuite/vests/vhdl-ams/ashenden/compliant/access-types/test_bench-1.vhd b/testsuite/vests/vhdl-ams/ashenden/compliant/access-types/test_bench-1.vhd new file mode 100644 index 000000000..00ef8bdf5 --- /dev/null +++ b/testsuite/vests/vhdl-ams/ashenden/compliant/access-types/test_bench-1.vhd @@ -0,0 +1,224 @@ + +-- Copyright (C) 2002 Morgan Kaufmann Publishers, Inc + +-- This file is part of VESTs (Vhdl tESTs). + +-- VESTs is free software; you can redistribute it and/or modify it +-- under the terms of the GNU General Public License as published by the +-- Free Software Foundation; either version 2 of the License, or (at +-- your option) any later version. + +-- VESTs is distributed in the hope that it will be useful, but WITHOUT +-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +-- for more details. + +-- You should have received a copy of the GNU General Public License +-- along with VESTs; if not, write to the Free Software Foundation, +-- Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + +-- not in book + +package stimulus_element_ordered_collection_adt is + + -- template: fill in the placeholders to specialize for a particular type + + alias element_type is work.stimulus_types.stimulus_element; + alias key_type is delay_length; + alias key_of is work.stimulus_types.stimulus_key [ element_type return key_type ]; + alias "<" is std.standard."<" [ key_type, key_type return boolean ]; + + -- types provided by the package + + type ordered_collection_object; -- private + type position_object; -- private + + type ordered_collection is access ordered_collection_object; + type position is access position_object; + + -- operations on ordered collections + + function new_ordered_collection return ordered_collection; + -- returns an empty ordered collection of element_type values + + procedure insert ( c : inout ordered_collection; e : in element_type ); + -- inserts e into c in position determined by key_of(e) + + procedure get_element ( variable p : in position; e : out element_type ); + -- returns the element value at position p in its collection + + procedure test_null_position ( variable p : in position; is_null : out boolean ); + -- test whether p refers to no position in its collection + + procedure search ( variable c : in ordered_collection; k : in key_type; + p : out position ); + -- searches for an element with key k in c, and returns the position of + -- that element, or, if not found, a position for which test_null_position + -- returns true + + procedure find_first ( variable c : in ordered_collection; p : out position ); + -- returns the position of the first element of c + + procedure advance ( p : inout position ); + -- advances p to the next element in its collection, + -- or if there are no more, sets p so that test_null_position returns true + + procedure delete ( p : inout position ); + -- deletes the element at position p from its collection, and advances p + + -- private types: pretend these are not visible + + type ordered_collection_object is + record + element : element_type; + next_element, prev_element : ordered_collection; + end record ordered_collection_object; + + type position_object is + record + the_collection : ordered_collection; + current_element : ordered_collection; + end record position_object; + +end package stimulus_element_ordered_collection_adt; + + + +package body stimulus_element_ordered_collection_adt is + + function new_ordered_collection return ordered_collection is + variable result : ordered_collection := new ordered_collection_object; + begin + result.next_element := result; + result.prev_element := result; + return result; + end function new_ordered_collection; + + procedure insert ( c : inout ordered_collection; e : in element_type ) is + variable current_element : ordered_collection := c.next_element; + variable new_element : ordered_collection; + begin + while current_element /= c + and key_of(current_element.element) < key_of(e) loop + current_element := current_element.next_element; + end loop; + -- insert new element before current_element + new_element := new ordered_collection_object'( + element => e, + next_element => current_element, + prev_element => current_element.prev_element ); + new_element.next_element.prev_element := new_element; + new_element.prev_element.next_element := new_element; + end procedure insert; + + procedure get_element ( variable p : in position; e : out element_type ) is + begin + e := p.current_element.element; + end procedure get_element; + + procedure test_null_position ( variable p : in position; is_null : out boolean ) is + begin + is_null := p.current_element = p.the_collection; + end procedure test_null_position; + + procedure search ( variable c : in ordered_collection; k : in key_type; + p : out position ) is + variable current_element : ordered_collection := c.next_element; + begin + while current_element /= c + and key_of(current_element.element) < k loop + current_element := current_element.next_element; + end loop; + if current_element = c or k < key_of(current_element.element) then + p := new position_object'(c, c); -- null position + else + p := new position_object'(c, current_element); + end if; + end procedure search; + + procedure find_first ( variable c : in ordered_collection; p : out position ) is + begin + p := new position_object'(c, c.next_element); + end procedure find_first; + + procedure advance ( p : inout position ) is + variable is_null : boolean; + begin + test_null_position(p, is_null); + if not is_null then + p.current_element := p.current_element.next_element; + end if; + end procedure advance; + + procedure delete ( p : inout position ) is + variable is_null : boolean; + begin + test_null_position(p, is_null); + if not is_null then + p.current_element.next_element.prev_element + := p.current_element.prev_element; + p.current_element.prev_element.next_element + := p.current_element.next_element; + p.current_element := p.current_element.next_element; + end if; + end procedure delete; + +end package body stimulus_element_ordered_collection_adt; + + + +entity test_bench is +end entity test_bench; + +-- end not in book + + +architecture initial_test of test_bench is + + use work.stimulus_types.all; + + -- . . . -- component and signal declarations + + -- not in book + signal dut_signals : real_vector(0 to stimulus_vector_length - 1); + -- end not in book + +begin + + -- . . . -- instantiate design under test + + stimulus_generation : process is + + use work.stimulus_element_ordered_collection_adt.all; + + variable stimulus_list : ordered_collection := new_ordered_collection; + variable next_stimulus_position : position; + variable next_stimulus : stimulus_element; + variable position_is_null : boolean; + + begin + insert(stimulus_list, stimulus_element'(0 ns, real_vector'(0.0, 5.0, 0.0, 2.0))); + insert(stimulus_list, stimulus_element'(200 ns, real_vector'(3.3, 2.1, 0.0, 2.0))); + insert(stimulus_list, stimulus_element'(300 ns, real_vector'(3.3, 2.1, 1.1, 3.3))); + insert(stimulus_list, stimulus_element'(50 ns, real_vector'(3.3, 3.3, 2.2, 4.0))); + insert(stimulus_list, stimulus_element'(60 ns, real_vector'(5.0, 3.3, 4.0, 2.2))); + -- . . . + -- not in book + insert(stimulus_list, stimulus_element'(100 ns, real_vector'(0.0, 0.0, 0.0, 0.0))); + search(stimulus_list, 100 ns, next_stimulus_position); + delete(next_stimulus_position); + get_element(next_stimulus_position, next_stimulus); + -- end not in book + find_first(stimulus_list, next_stimulus_position); + loop + test_null_position(next_stimulus_position, position_is_null); + exit when position_is_null; + get_element(next_stimulus_position, next_stimulus); + wait for next_stimulus.application_time - now; + dut_signals <= next_stimulus.pattern; + advance(next_stimulus_position); + end loop; + wait; + end process stimulus_generation; + +end architecture initial_test; |