|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - downloadIndex: B T
Length: 32884 (0x8074)
Types: TextFile
Names: »B«
└─⟦180fe333a⟧ Bits:30000405 8mm tape, Rational 1000, SW CATALOG, 10_20_0
└─⟦180fe333a⟧ Bits:30000537 8mm tape, Rational 1000, SW Catalog 10_20_0
└─⟦5cb1d1d7f⟧ »DATA«
└─⟦3b1ee7bd8⟧
└─⟦this⟧
--+ TITLE: TEST PROCEDURE FOR PACKAGE QUEUE_OF_STATIC_ITEMS_G
--+ SUPPORT: Andre Volckov DMA-EPFL CH-1015 Lausanne
--+ REVISION: Jean-Jos# de Rus (11-NOV-1987)
--+ CREATION: 20-JUL-1987 by Andre Volckov
with Text_Io;
use Text_Io;
with Integer_Text_Io;
with Queue_Of_Static_Items_G;
with Generator_Of_Static_Items;
use Generator_Of_Static_Items;
procedure Queue_Of_Static_Items_Test is
------------------------------
--+ OVERVIEW: This procedure tests behaviour of the package
--+ QUEUE_OF_STATIC_ITEMS_G. It tests all primitives exported
--+ by this package in each particular and critical situation.
--+ Reference table in package GENERATOR_OF_STATIC_ITEMS is used to
--+ initialize and compare elements of queues involved in these tests.
-------------------------------------------------------------------------------
package Queue is new Queue_Of_Static_Items_G (Item_Type, "=");
use Queue;
Vector_Size : constant Positive := 100;
Vector : Vector_Type (1 .. Vector_Size);
Step : Integer;
-- Step indicator for error location.
Actual_Max_Free_List_Size : Natural := 0;
-- Actual maximum free list size positioned with SET_MAX_FREE_LIST_SIZE;
Item : Item_Type;
Error : Boolean := False;
Test_Error : exception;
-- Raised on unsuccesful test.
--/ GENERAL PURPOSE PROCEDURES:
-------------------------------------------------------------------------------
procedure Display_Error_Location (Step : in Integer; Number : in Integer) is
-- Displays error location and assigns value "TRUE" to ERROR
-- which stops program execution at the end of a STEP.
begin
Error := True;
Put ("*** ERROR: ");
Integer_Text_Io.Put (Number);
Put (" AT STEP");
Integer_Text_Io.Put (Step);
Put (" FOR MAX_FREE_LIST_SIZE =");
Integer_Text_Io.Put (Actual_Max_Free_List_Size);
New_Line;
end Display_Error_Location;
-------------------------------------------------------------------------------
procedure Null_Act_On_Item (Item : in Item_Type;
Order_Number : in Positive;
Continue : in out Boolean) is
-- Used in tests of traversals.
begin
null;
end Null_Act_On_Item;
-------------------------------------------------------------------------------
procedure Act_On_Item (Item : in Item_Type;
Order_Number : in Positive;
Continue : in out Boolean) is
-- Used in tests of traversals.
Temp : Item_Type;
begin
Assign (Temp, Item);
end Act_On_Item;
-------------------------------------------------------------------------------
procedure Traverse_Without_Action is new Traverse_G (Null_Act_On_Item);
-------------------------------------------------------------------------------
procedure Traverse_With_Action is new Traverse_G (Act_On_Item);
-------------------------------------------------------------------------------
procedure Initialize (Queue : in out Queue_Type;
Number_Of_Elements : in Positive) is
-- Initializes a queue with first NUMBER_OF_ELEMENTS
-- elements of the reference VECTOR.
begin
Destroy (Queue);
for I in 1 .. Number_Of_Elements loop
Insert (Queue, Vector (I));
end loop;
end Initialize;
-------------------------------------------------------------------------------
procedure Check_Empty_Structure (Structure : in out Queue_Type) is
-- Tests behaviour of the exported procedures while
-- the STRUCTURE is empty.
-- Tests the exception EMPTY_STRUCTURE_ERROR.
begin
if Size (Structure) /= 0 then
Display_Error_Location (Step, 5);
end if;
if not Is_Empty (Structure) then
Display_Error_Location (Step, 10);
end if;
begin
Remove (Structure);
Display_Error_Location (Step, 15);
exception
when Empty_Structure_Error =>
null;
end;
begin
Remove (Structure, Item);
Display_Error_Location (Step, 20);
exception
when Empty_Structure_Error =>
null;
end;
begin
Assign (Item, First_Value (Structure));
Display_Error_Location (Step, 25);
exception
when Empty_Structure_Error =>
null;
end;
begin
Get_First_Value (Structure, Item);
Display_Error_Location (Step, 26);
exception
when Empty_Structure_Error =>
null;
end;
begin
Assign (Item, Last_Value (Structure));
Display_Error_Location (Step, 27);
exception
when Empty_Structure_Error =>
null;
end;
begin
Get_Last_Value (Structure, Item);
Display_Error_Location (Step, 28);
exception
when Empty_Structure_Error =>
null;
end;
if Structure /= Structure then
Display_Error_Location (Step, 30);
end if;
begin
Traverse_Without_Action (Structure);
exception
when others =>
Display_Error_Location (Step, 35);
end;
begin
Traverse_With_Action (Structure);
exception
when others =>
Display_Error_Location (Step, 40);
end;
begin
Destroy (Structure);
exception
when others =>
Display_Error_Location (Step, 45);
end;
begin
Assign (Structure, Structure);
exception
when others =>
Display_Error_Location (Step, 50);
end;
if Structure /= Structure then
Display_Error_Location (Step, 55);
end if;
exception
when others =>
Display_Error_Location (Step, 60);
-- Presence of an undefined error!
end Check_Empty_Structure;
-------------------------------------------------------------------------------
procedure Check_Between_Two_Empty_Structures
(Dest, Source : in out Queue_Type) is
-- Check relations and assignment between two empty queues.
begin
if Dest /= Source then
Display_Error_Location (Step, 5);
end if;
begin
Assign (Dest, Source);
exception
when others =>
Display_Error_Location (Step, 10);
end;
end Check_Between_Two_Empty_Structures;
-------------------------------------------------------------------------------
procedure Check_Unary_Operations (Number : in Positive;
Top_Value : in Item_Type;
Bottom_Value : in Item_Type;
Structure : in out Queue_Type) is
-- Check unary operations on queue.
Item : Item_Type;
begin
if Size (Structure) /= Number then
Display_Error_Location (Step, 5);
end if;
if Is_Empty (Structure) then
Display_Error_Location (Step, 10);
end if;
Assign (Item, First_Value (Structure));
if Item /= Top_Value then
Display_Error_Location (Step, 15);
end if;
Get_First_Value (Structure, Item);
if Item /= Top_Value then
Display_Error_Location (Step, 16);
end if;
Assign (Item, Last_Value (Structure));
if Item /= Bottom_Value then
Display_Error_Location (Step, 17);
end if;
Get_Last_Value (Structure, Item);
if Item /= Bottom_Value then
Display_Error_Location (Step, 18);
end if;
Remove (Structure);
if Size (Structure) /= Number - 1 then
Display_Error_Location (Step, 20);
end if;
Insert (Structure, Top_Value);
-- at the end.
if Size (Structure) /= Number then
Display_Error_Location (Step, 25);
end if;
for I in 1 .. Number - 1 loop
Remove (Structure, Item);
Insert (Structure, Item);
end loop;
-- circular movements.
Remove (Structure, Item);
if Size (Structure) /= Number - 1 then
Display_Error_Location (Step, 30);
end if;
if Item /= Top_Value then
Display_Error_Location (Step, 35);
end if;
Insert (Structure, Item);
if Structure /= Structure then
Display_Error_Location (Step, 40);
end if;
begin
Traverse_Without_Action (Structure);
exception
when others =>
Display_Error_Location (Step, 45);
end;
declare
Dest : Queue_Type;
begin
Assign (Dest, Structure);
if Dest /= Structure then
Display_Error_Location (Step, 50);
end if;
Assign (Structure, Structure);
if Dest /= Structure then
Display_Error_Location (Step, 55);
end if;
end;
Destroy (Structure);
if not Is_Empty (Structure) then
Display_Error_Location (Step, 60);
end if;
exception
when others =>
Display_Error_Location (Step, 65);
-- Presence of an undefined error!
end Check_Unary_Operations;
-------------------------------------------------------------------------------
procedure Check_Equal_Structures (Left, Right : in out Queue_Type) is
-- Check relations and assignment between two equal structures.
begin
if Left /= Right then
Display_Error_Location (Step, 5);
end if;
begin
Assign (Left, Right);
exception
when others =>
Display_Error_Location (Step, 10);
end;
begin
Destroy (Left);
Assign (Left, Right);
exception
when others =>
Display_Error_Location (Step, 15);
end;
begin
Destroy (Right);
Assign (Left, Right);
exception
when others =>
Display_Error_Location (Step, 20);
end;
if Left /= Right then
Display_Error_Location (Step, 25);
end if;
exception
when others =>
Display_Error_Location (Step, 30);
-- Presence of an undefined error!
end Check_Equal_Structures;
-------------------------------------------------------------------------------
procedure Check_Not_Equal_Structures (Left, Right : in out Queue_Type) is
-- Check relations and assignment between two different structures.
begin
if Left = Right then
Display_Error_Location (Step, 5);
end if;
if Right = Left then
Display_Error_Location (Step, 10);
end if;
begin
Assign (Left, Right);
exception
when others =>
Display_Error_Location (Step, 15);
end;
if Left /= Right then
Display_Error_Location (Step, 20);
end if;
exception
when others =>
Display_Error_Location (Step, 25);
-- Presence of an undefined error!
end Check_Not_Equal_Structures;
-------------------------------------------------------------------------------
procedure Check_Traversal (Queue : in Queue_Type;
Last : in Natural;
Vector : in Vector_Type) is
-- Check TRAVERSE_G procedure.
Number : Natural;
Order_Number_Error, Value_Error, Stop_Error : exception;
procedure Compare (Item : in Item_Type;
Order_Number : in Positive;
Continue : in out Boolean) is
begin
Number := Number + 1;
if Number /= Order_Number then
raise Order_Number_Error;
end if;
if Item /= Vector (Number) then
raise Value_Error;
end if;
end Compare;
procedure Stop_At_Number (Item : in Item_Type;
Order_Number : in Positive;
Continue : in out Boolean) is
begin
if Order_Number = Number then
Continue := False;
elsif Order_Number > Number then
raise Stop_Error;
end if;
end Stop_At_Number;
begin
declare
procedure Traverse is new Traverse_G (Compare);
begin
Number := 0;
Traverse (Queue);
exception
when Order_Number_Error =>
Display_Error_Location (Step, 5);
when Value_Error =>
Display_Error_Location (Step, 10);
end;
declare
procedure Traverse is new Traverse_G (Stop_At_Number);
begin
Number := 1;
Traverse (Queue);
Number := (Last + 1) / 2;
Traverse (Queue);
Number := Last - 1;
if Number > 0 then
Traverse (Queue);
end if;
Number := Last;
Traverse (Queue);
exception
when Stop_Error =>
Display_Error_Location (Step, 15);
end;
exception
when others =>
Display_Error_Location (Step, 20);
-- Presence of an undefined error!
end Check_Traversal;
-------------------------------------------------------------------------------
procedure Preliminary_Tests is
-- Preliminary verification of each exported procedure.
Source, Dest, Structure : Queue_Type;
begin
--/ SIZE test
for I in Vector'Range loop
Insert (Structure, Vector (I));
if Size (Structure) /= I then
Display_Error_Location (Step, 5);
exit;
end if;
end loop;
for I in Vector'Range loop
Remove (Structure);
if Size (Structure) /= Vector_Size - I then
Display_Error_Location (Step, 10);
exit;
end if;
end loop;
--/ DESTROY test
Initialize (Structure, Vector_Size);
Destroy (Structure);
if Size (Structure) /= 0 then
Display_Error_Location (Step, 15);
end if;
--/ INSERT/REMOVE(...ITEM) and queue content test
Initialize (Structure, Vector_Size);
for I in 1 .. Vector_Size loop
Remove (Structure, Item);
if Item /= Vector (I) then
Display_Error_Location (Step, 20);
exit;
end if;
end loop;
--/ REMOVE test
Initialize (Structure, Vector_Size);
for I in Vector'Range loop
Remove (Structure);
if Size (Structure) /= Vector_Size - I then
Display_Error_Location (Step, 25);
exit;
end if;
end loop;
--/ ASSIGN TEST
Initialize (Source, Vector_Size);
Assign (Dest, Source);
if Dest /= Source then
Display_Error_Location (Step, 30);
end if;
--/ GET_FIRST_VALUE test
Insert (Structure, Vector (Vector_Size / 2));
Assign (Item, First_Value (Structure));
if Item /= Vector (Vector_Size / 2) then
Display_Error_Location (Step, 35);
end if;
Get_First_Value (Structure, Item);
if Item /= Vector (Vector_Size / 2) then
Display_Error_Location (Step, 36);
end if;
Assign (Item, Last_Value (Structure));
if Item /= Vector (Vector_Size / 2) then
Display_Error_Location (Step, 37);
end if;
Get_Last_Value (Structure, Item);
if Item /= Vector (Vector_Size / 2) then
Display_Error_Location (Step, 38);
end if;
--/ "=" test
Initialize (Source, Vector_Size);
Initialize (Dest, Vector_Size);
if Source /= Dest then
Display_Error_Location (Step, 40);
end if;
--/ TRAVERSE_G test
declare
Item : Item_Type;
Compare_Error : exception;
procedure Compare_Each (Item : in Item_Type;
Order_Number : in Positive;
Continue : in out Boolean) is
-- Compares the current element of the queue with corresponding
-- element of the VECTOR.
begin
if Item /= Vector (Order_Number) then
raise Compare_Error;
end if;
end Compare_Each;
procedure Traverse_G_Test is new Traverse_G (Compare_Each);
begin
Initialize (Structure, Vector_Size);
Traverse_G_Test (Structure);
exception
when Compare_Error =>
Display_Error_Location (Step, 45);
end;
exception
when others =>
Display_Error_Location (Step, 50);
-- Presence of an undefined error!
end Preliminary_Tests;
-------------------------------------------------------------------------------
procedure Check_Exceptions is
Structure : Queue_Type;
begin
Initialize (Structure, Vector_Size);
Destroy (Structure);
begin
Remove (Structure);
Display_Error_Location (Step, 5); -- exception not raised
exception
when Empty_Structure_Error =>
null;
end;
declare
Item : Item_Type;
begin
Remove (Structure, Item);
Display_Error_Location (Step, 10); -- exception not raised
exception
when Empty_Structure_Error =>
null;
end;
declare
Item : Item_Type;
begin
Assign (Item, First_Value (Structure));
Display_Error_Location (Step, 15); -- exception not raised
exception
when Empty_Structure_Error =>
null;
end;
begin
Get_First_Value (Structure, Item);
Display_Error_Location (Step, 16); -- exception not raised
exception
when Empty_Structure_Error =>
null;
end;
begin
Assign (Item, Last_Value (Structure));
Display_Error_Location (Step, 17); -- exception not raised
exception
when Empty_Structure_Error =>
null;
end;
begin
Get_Last_Value (Structure, Item);
Display_Error_Location (Step, 18); -- exception not raised
exception
when Empty_Structure_Error =>
null;
end;
Insert (Structure, Vector (1));
Remove (Structure);
begin
Remove (Structure);
Display_Error_Location (Step, 20); -- exception not raised
exception
when Empty_Structure_Error =>
null;
end;
declare
Item : Item_Type;
begin
Remove (Structure, Item);
Display_Error_Location (Step, 25); -- exception not raised
exception
when Empty_Structure_Error =>
null;
end;
declare
Item : Item_Type;
begin
Assign (Item, First_Value (Structure));
Display_Error_Location (Step, 30); -- exception not raised
exception
when Empty_Structure_Error =>
null;
end;
begin
Get_First_Value (Structure, Item);
Display_Error_Location (Step, 35); -- exception not raised
exception
when Empty_Structure_Error =>
null;
end;
begin
Assign (Item, Last_Value (Structure));
Display_Error_Location (Step, 40); -- exception not raised
exception
when Empty_Structure_Error =>
null;
end;
begin
Get_Last_Value (Structure, Item);
Display_Error_Location (Step, 45); -- exception not raised
exception
when Empty_Structure_Error =>
null;
end;
exception
when others =>
Display_Error_Location (Step, 50);
end Check_Exceptions;
-------------------------------------------------------------------------------
-------------------------------------------------------------------------------
--/ MAIN TEST PROCEDURE:
begin
Put ("Tests for QUEUE_OF_STATIC_ITEMS_G...");
New_Line;
Generate (Vector);
for Pass in 1 .. 3 loop
-- Repeat tests for different values of MAX_FREE_LIST_SIZE.
-- If PASS = 1 then MAX_FREE_LIST_SIZE = 0 by default.
if Pass = 2 then
Release_Free_List;
Set_Max_Free_List_Size (Vector_Size / 2);
Actual_Max_Free_List_Size := Vector_Size / 2;
elsif Pass = 3 then
Release_Free_List;
Set_Max_Free_List_Size (Vector_Size);
Actual_Max_Free_List_Size := Vector_Size;
end if;
declare
Structure, Dest, Source : Queue_Type;
-- Stacks involved in tests.
begin
--/ TESTS FOR EXCEPTIONS, CONSTRUCTORS, QUERIES AND ITERATORS:
--/ A declared object must be empty:
Step := 1;
Check_Empty_Structure (Structure);
if Error then
raise Test_Error;
end if;
--/ Check between two declared objects who must be empty:
Step := 2;
Check_Between_Two_Empty_Structures (Dest, Source);
if Error then
raise Test_Error;
end if;
--/ Basic tests of operations
Step := 3;
Preliminary_Tests;
if Error then
raise Test_Error;
end if;
--/ Basic test of exceptions
Step := 4;
Check_Exceptions;
if Error then
raise Test_Error;
end if;
--/ Particular situations tests:
--/ Check unary operations on the queue of size 1:
Step := 5;
Insert (Structure, Vector (1));
Check_Unary_Operations (1, Vector (1), Vector (1), Structure);
if Error then
raise Test_Error;
end if;
--/Check unary operations on the queue of size VECTOR_SIZE:
Step := 6;
Initialize (Structure, Vector_Size);
Check_Unary_Operations (Vector_Size, Vector (1),
Vector (Vector_Size), Structure);
if Error then
raise Test_Error;
end if;
--/ A queue must be empty: check of an empty structure:
Step := 7;
Check_Empty_Structure (Structure);
if Error then
raise Test_Error;
end if;
--/ Successives INSERTs and POPs must leave the queue empty:
Step := 8;
Initialize (Structure, Vector_Size); -- INSERT(STRUCTURE...);
for I in 1 .. Vector_Size loop
Remove (Structure);
end loop;
Check_Empty_Structure (Structure);
if Error then
raise Test_Error;
end if;
--/ Destroy must leave the queue empty:
Step := 9;
Initialize (Structure, Vector_Size);
Destroy (Structure);
Check_Empty_Structure (Structure);
if Error then
raise Test_Error;
end if;
--/ Check of equal structures:
Step := 10;
Initialize (Source, Vector_Size);
Initialize (Dest, Vector_Size);
for I in 1 .. Vector_Size loop
Remove (Source, Item);
Insert (Source, Item);
end loop;
Check_Equal_Structures (Dest, Source);
if Error then
raise Test_Error;
end if;
--/ Check of two empty structures:
Step := 11;
Destroy (Source);
Destroy (Dest);
Check_Between_Two_Empty_Structures (Dest, Source);
if Error then
raise Test_Error;
end if;
--/ Check of not equal structures:
--/ different number of elements.
Step := 12;
Initialize (Source, Vector_Size);
Initialize (Dest, Vector_Size);
Insert (Dest, Vector (Vector_Size));
Check_Not_Equal_Structures (Dest, Source);
if Error then
raise Test_Error;
end if;
--/ Check of not equal structures:
--/ same number of elements; top element is different.
Step := 13;
Initialize (Source, Vector_Size);
Initialize (Dest, Vector_Size);
Insert (Source, Vector (Vector_Size - 1));
Insert (Dest, Vector (Vector_Size));
Check_Not_Equal_Structures (Dest, Source);
if Error then
raise Test_Error;
end if;
--/ Check of not equal structures:
--/ same number of elements; intermediate element is different.
Step := 14;
Destroy (Source);
Destroy (Dest);
for I in 1 .. Vector_Size / 2 loop
Insert (Source, Vector (I));
Insert (Dest, Vector (I));
end loop;
Insert (Source, Vector (1));
Insert (Dest, Vector (2));
for I in Vector_Size / 2 + 1 .. Vector_Size loop
Insert (Source, Vector (I));
Insert (Dest, Vector (I));
end loop;
Check_Not_Equal_Structures (Dest, Source);
if Error then
raise Test_Error;
end if;
--/ Check of not equal structures;
--/ same number of elements; bottom element is different.
Step := 15;
Destroy (Source);
Destroy (Dest);
Insert (Source, Vector (1));
Insert (Dest, Vector (2));
for I in 2 .. Vector_Size loop
Insert (Source, Vector (I));
Insert (Dest, Vector (I));
end loop;
Check_Not_Equal_Structures (Dest, Source);
if Error then
raise Test_Error;
end if;
--/ Check of not equal structures;
--/ DEST is empty;
Step := 16;
Initialize (Source, Vector_Size);
Initialize (Dest, Vector_Size);
Destroy (Dest);
Check_Not_Equal_Structures (Dest, Source);
if Error then
raise Test_Error;
end if;
--/ Check of not equal structures;
--/ SOURCE is empty;
Step := 17;
Initialize (Source, Vector_Size);
Initialize (Dest, Vector_Size);
Destroy (Source);
Check_Not_Equal_Structures (Dest, Source);
if Error then
raise Test_Error;
end if;
--/ Check traversal; 1 element in the queue.
Step := 18;
Insert (Structure, Vector (1));
Check_Traversal (Structure, 1, Vector);
if Error then
raise Test_Error;
end if;
--/ Check traversal; All elements in the queue.
Step := 19;
Initialize (Structure, Vector_Size);
Check_Traversal (Structure, Vector_Size, Vector);
if Error then
raise Test_Error;
end if;
Destroy (Structure);
Destroy (Source);
Destroy (Dest);
end;
end loop;
--/ HEAP MANAGEMENT TESTS:
declare
Structure, Dest, Source : Queue_Type;
-- Stacks involved in tests.
begin
Initialize (Structure, Vector_Size);
Release_Free_List;
Set_Max_Free_List_Size (Vector_Size);
Actual_Max_Free_List_Size := Vector_Size;
--/ Free list management tests on INSERT/REMOVE:
Step := 20;
declare
Free_List_Size_Error : exception;
begin
for I in 1 .. Vector_Size loop
Remove (Structure);
if Free_List_Size /= I then
raise Free_List_Size_Error;
end if;
end loop;
exception
when Free_List_Size_Error =>
Display_Error_Location (Step, 5);
end;
declare
Free_List_Size_Error : exception;
begin
for I in 1 .. Vector_Size loop
Insert (Structure, Vector (I));
if Free_List_Size /= Vector_Size - I then
raise Free_List_Size_Error;
end if;
end loop;
exception
when Free_List_Size_Error =>
Display_Error_Location (Step, 10);
end;
if Error then
raise Test_Error;
end if;
--/ SET_MAX_FREE_LIST test:
Step := 21;
Set_Max_Free_List_Size (Vector_Size / 2);
Actual_Max_Free_List_Size := Vector_Size / 2;
declare
Free_List_Size_Error : exception;
begin
for I in 1 .. Vector_Size / 2 loop
Remove (Structure);
if Free_List_Size /= I then
raise Free_List_Size_Error;
end if;
end loop;
exception
when Free_List_Size_Error =>
Display_Error_Location (Step, 5);
end;
declare
Free_List_Size_Error : exception;
begin
while Size (Structure) /= 0 loop
Remove (Structure);
if Free_List_Size /= Vector_Size / 2 then
raise Free_List_Size_Error;
end if;
end loop;
exception
when Free_List_Size_Error =>
Display_Error_Location (Step, 10);
end;
Insert (Structure, Vector (1));
if Free_List_Size /= Vector_Size / 2 - 1 then
Display_Error_Location (Step, 15);
end if;
if Error then
raise Test_Error;
end if;
--/ RELEASE_FREE_LIST test:
Step := 22;
Set_Max_Free_List_Size (Vector_Size);
Actual_Max_Free_List_Size := Vector_Size;
Initialize (Structure, Vector_Size);
for I in 1 .. Vector_Size loop
Remove (Structure);
end loop;
if Free_List_Size /= Vector_Size then
Display_Error_Location (Step, 5);
end if;
Release_Free_List;
if Free_List_Size /= 0 then
Display_Error_Location (Step, 10);
end if;
if Error then
raise Test_Error;
end if;
--/ Free list management test on DESTROY:
Step := 23;
Initialize (Structure, Vector_Size);
Destroy (Structure);
if Free_List_Size /= Vector_Size then
Display_Error_Location (Step, 5);
end if;
if Error then
raise Test_Error;
end if;
--/ Free list management test on ASSIGN:
Step := 24;
Release_Free_List;
Initialize (Source, Vector_Size - 10);
Initialize (Dest, Vector_Size);
Destroy (Dest);
-- Free list contains VECTOR_SIZE elements.
Assign (Dest, Source);
-- DEST contains VECTOR_SIZE-10 elements
-- Free list must contain 10 elements
if Free_List_Size /= 10 then
Display_Error_Location (Step, 5);
end if;
Destroy (Source);
-- Free list contains VECTOR_SIZE elements.
Assign (Dest, Source);
-- Free list must contain VECTOR_SIZE elements
if Free_List_Size /= Vector_Size then
Display_Error_Location (Step, 10);
end if;
if Error then
raise Test_Error;
end if;
end;
Put_Line ("successfuly completed.");
exception
when Test_Error =>
Put_Line ("Test procedure cannot continue.");
end Queue_Of_Static_Items_Test;