|
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: 92227 (0x16843)
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⟧
--------------------------------- COPYRIGHT ------------------------------------
-- (C) 1987 Swiss Federal Institute of Technology (EPFL). --
-- Represented by A. Strohmeier DMA-EPFL 1015 Lausanne Switzerland. --
-- All Rights Reserved. --
--------------------------------------------------------------------------------
--+ TITLE : TEST PROCEDURE FOR PACKAGE
--+ SET_OF_DYNAMIC_ITEMS_G
--+ SUPPORT : Jean-Jos# de Rus DMA-EPFL CH-1015 Lausanne
--+ CREATION : 19-OCT-1987 by Jean-jos# de Rus
with Text_Io;
use Text_Io;
with Integer_Text_Io;
with Set_Of_Dynamic_Items_G;
with Generator_Of_Dynamic_Items;
use Generator_Of_Dynamic_Items;
procedure Set_Of_Dynamic_Items_Test is
------------------------------
--+ OVERVIEW:
--+ This procedure tests behaviour of the package SET_OF_DYNAMIC_ITEMS_G
--+ It tests all primitives exported by this package in each particular and
--+ critical situation.
--+ Reference vector in package GENERATOR_OF_DYNAMIC_ITEMS is used to
--+ initialize and compare elements of SETs involved in these tests.
-------------------------------------------------------------------------------
package Set_Of_Items is new Set_Of_Dynamic_Items_G
(Item_Type, Less, Equals, Assign, Destroy);
use Set_Of_Items;
package Set_Operations is new Set_Operations_G;
use Set_Operations;
Vector_Size : constant Positive := 100;
Vector, Vector2, Descending_Vector, Ascending_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, Item2 : Item_Type;
Error : Boolean := False;
Test_Error : exception;
-- Raised on unsuccesful test.
--/ GENERAL PURPOSE PROCEDURES:
-------------------------------------------------------------------------------
function "=" (Left, Right : Item_Type) return Boolean is
-- Used on equality (or inequality) tests with ITEM_TYPE values.
begin
return Equals (Left, Right);
end "=";
-------------------------------------------------------------------------------
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_Action (Item : in Item_Type;
Order_Number : in Positive;
Continue : in out Boolean) is
-- Used in tests of traversals.
begin
null;
end Null_Action;
-------------------------------------------------------------------------------
procedure Null_Modify (Item : in out Item_Type;
Order_Number : in Positive;
Continue : in out Boolean) is
-- Used in tests of traversals.
begin
null;
end Null_Modify;
-------------------------------------------------------------------------------
procedure Traverse_Asc_Without_Action is new Traverse_Asc_G (Null_Action);
procedure Traverse_Desc_Without_Action is new Traverse_Desc_G (Null_Action);
procedure Disorder_Traverse_Without_Action is
new Disorder_Traverse_G (Null_Action);
-------------------------------------------------------------------------------
procedure Initialize (Set : in out Set_Type;
Number_Of_Elements : in Positive) is
-- Initializes a SET with first NUMBER_OF_ELEMENTS
-- elements of VECTOR.
begin
Destroy (Set);
for I in 1 .. Number_Of_Elements loop
Insert (Set, Vector (I));
end loop;
end Initialize;
--------------------------------------------------------------------------------
procedure Initialize2 (Set : in out Set_Type;
Number_Of_Elements : in Positive) is
-- Initializes a SET with first NUMBER_OF_ELEMENTS
-- elements of VECTOR2.
-- VECTOR and VECTOR2 are quite different
begin
Destroy (Set);
for I in 1 .. Number_Of_Elements loop
Insert (Set, Vector2 (I));
end loop;
end Initialize2;
-------------------------------------------------------------------------------
procedure Check_Empty_Structure (Structure : in out Set_Type) is
-- Tests behaviour of the exported procedures while
-- the STRUCTURE is empty.
-- Tests the exception EMPTY_STRUCTURE_ERROR.
Found : Boolean;
Number_Deleted : Natural;
Item : Item_Type;
begin
Assign (Item, Vector (Vector'First));
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;
if Is_Present (Structure, Item) then
Display_Error_Location (Step, 15);
end if;
Remove (Structure, Ascending_Vector (1), Found);
if Found then
Display_Error_Location (Step, 25);
end if;
begin
Remove (Structure, Ascending_Vector (1));
Display_Error_Location (Step, 30);
exception
when Missing_Item_Error =>
null;
end;
begin
Remove_Max (Structure);
Display_Error_Location (Step, 35);
exception
when Empty_Structure_Error =>
null;
end;
begin
Remove_Max (Structure, Item);
Display_Error_Location (Step, 40);
exception
when Empty_Structure_Error =>
null;
end;
begin
Remove_Min (Structure);
Display_Error_Location (Step, 45);
exception
when Empty_Structure_Error =>
null;
end;
begin
Remove_Min (Structure, Item);
Display_Error_Location (Step, 50);
exception
when Empty_Structure_Error =>
null;
end;
begin
Get_Max (Structure, Item);
Display_Error_Location (Step, 55);
exception
when Empty_Structure_Error =>
null;
end;
begin
Assign (Item, Max (Structure));
Display_Error_Location (Step, 60);
exception
when Empty_Structure_Error =>
null;
end;
begin
Get_Min (Structure, Item);
Display_Error_Location (Step, 65);
exception
when Empty_Structure_Error =>
null;
end;
begin
Assign (Item, Min (Structure));
Display_Error_Location (Step, 70);
exception
when Empty_Structure_Error =>
null;
end;
begin
Traverse_Asc_Without_Action (Structure);
exception
when others =>
Display_Error_Location (Step, 115);
end;
begin
Traverse_Desc_Without_Action (Structure);
exception
when others =>
Display_Error_Location (Step, 120);
end;
begin
Disorder_Traverse_Without_Action (Structure);
exception
when others =>
Display_Error_Location (Step, 125);
end;
begin
Destroy (Structure);
exception
when others =>
Display_Error_Location (Step, 145);
end;
begin
Assign (Structure, Structure);
exception
when others =>
Display_Error_Location (Step, 150);
end;
if Structure /= Structure then
Display_Error_Location (Step, 155);
end if;
begin
Assign (Item, Less (Structure, Item));
Display_Error_Location (Step, 160);
exception
when Missing_Item_Error =>
null;
end;
begin
Get_Less (Structure, Item);
Display_Error_Location (Step, 165);
exception
when Missing_Item_Error =>
null;
end;
Get_Less (Structure, Item, Found);
if Found then
Display_Error_Location (Step, 170);
end if;
begin
Assign (Item, Less_Or_Equal (Structure, Item));
Display_Error_Location (Step, 180);
exception
when Missing_Item_Error =>
null;
end;
begin
Get_Less_Or_Equal (Structure, Item);
Display_Error_Location (Step, 185);
exception
when Missing_Item_Error =>
null;
end;
Get_Less_Or_Equal (Structure, Item, Found);
if Found then
Display_Error_Location (Step, 190);
end if;
begin
Assign (Item, Greater (Structure, Item));
Display_Error_Location (Step, 195);
exception
when Missing_Item_Error =>
null;
end;
begin
Get_Greater (Structure, Item);
Display_Error_Location (Step, 200);
exception
when Missing_Item_Error =>
null;
end;
Get_Greater (Structure, Item, Found);
if Found then
Display_Error_Location (Step, 205);
end if;
begin
Assign (Item, Greater_Or_Equal (Structure, Item));
Display_Error_Location (Step, 210);
exception
when Missing_Item_Error =>
null;
end;
begin
Get_Greater_Or_Equal (Structure, Item);
Display_Error_Location (Step, 215);
exception
when Missing_Item_Error =>
null;
end;
Get_Greater_Or_Equal (Structure, Item, Found);
if Found then
Display_Error_Location (Step, 220);
end if;
exception
when others =>
Display_Error_Location (Step, 225);
-- Presence of an undefined error!
end Check_Empty_Structure;
-------------------------------------------------------------------------------
procedure Check_Between_Two_Empty_Structures
(Dest, Source : in out Set_Type) is
-- Check relations and assignment between two empty SETs.
begin
if Dest /= Source then
Display_Error_Location (Step, 5);
end if;
if Dest < Source then
Display_Error_Location (Step, 10);
end if;
if Dest > Source then
Display_Error_Location (Step, 15);
end if;
if not (Dest >= Source) then
Display_Error_Location (Step, 20);
end if;
if not (Dest <= Source) then
Display_Error_Location (Step, 25);
end if;
begin
Assign (Dest, Source);
exception
when others =>
Display_Error_Location (Step, 30);
end;
end Check_Between_Two_Empty_Structures;
-------------------------------------------------------------------------------
procedure Check_Unary_Operations (Number : in Positive;
Min_Value : in Item_Type;
Max_Value : in Item_Type;
Structure : in out Set_Type) is
-- Check unary operations on SET.
Found : Boolean;
begin
if Number = 1 then
-- tests only for structures of size 1.
begin
Assign (Item, Ascending_Vector (Vector'Last));
Remove (Structure, Item, Found);
if Found then
Display_Error_Location (Step, 5);
end if;
Assign (Item2, Less (Structure, Item));
if Item2 /= Max (Structure) then
Display_Error_Location (Step, 10);
end if;
Get_Less (Structure, Item);
if Item /= Max (Structure) then
Display_Error_Location (Step, 15);
end if;
Assign (Item, Ascending_Vector (Vector'Last));
Get_Less (Structure, Item, Found);
if not Found or Item /= Max (Structure) then
Display_Error_Location (Step, 20);
end if;
Assign (Item, Ascending_Vector (Vector'Last));
Assign (Item2, Less_Or_Equal (Structure, Item));
if Item2 /= Max (Structure) then
Display_Error_Location (Step, 25);
end if;
Get_Less_Or_Equal (Structure, Item);
if Item /= Max (Structure) then
Display_Error_Location (Step, 30);
end if;
Get_Less_Or_Equal (Structure, Item, Found);
if not Found or Item /= Max (Structure) then
Display_Error_Location (Step, 35);
end if;
Destroy (Structure);
Insert (Structure, Ascending_Vector (Vector'Last));
Assign (Item, Ascending_Vector (Vector'First));
Assign (Item2, Greater (Structure, Item));
if Item2 /= Min (Structure) then
Display_Error_Location (Step, 40);
end if;
Get_Greater (Structure, Item);
if Item /= Min (Structure) then
Display_Error_Location (Step, 45);
end if;
Assign (Item, Ascending_Vector (Vector'First));
Get_Greater (Structure, Item, Found);
if not Found or Item /= Min (Structure) then
Display_Error_Location (Step, 50);
end if;
Assign (Item, Ascending_Vector (Vector'First));
Assign (Item2, Greater_Or_Equal (Structure, Item));
if Item2 /= Min (Structure) then
Display_Error_Location (Step, 55);
end if;
Get_Greater_Or_Equal (Structure, Item);
if Item /= Min (Structure) then
Display_Error_Location (Step, 60);
end if;
Get_Greater_Or_Equal (Structure, Item, Found);
if not Found or Item /= Min (Structure) then
Display_Error_Location (Step, 65);
end if;
Assign (Item, Ascending_Vector (Vector'Last));
Assign (Item2, Less_Or_Equal (Structure, Item));
if Item2 /= Item or Item2 /= Max (Structure) then
Display_Error_Location (Step, 70);
end if;
Get_Less_Or_Equal (Structure, Item);
if Item /= Max (Structure) then
Display_Error_Location (Step, 75);
end if;
Get_Less_Or_Equal (Structure, Item, Found);
if not Found then
Display_Error_Location (Step, 80);
end if;
Get_Greater (Structure, Item, Found);
if Found then
Display_Error_Location (Step, 85);
end if;
Assign (Item2, Greater_Or_Equal (Structure, Item));
if Item2 /= Item or Item /= Min (Structure) then
Display_Error_Location (Step, 90);
end if;
Get_Greater_Or_Equal (Structure, Item);
if Item /= Min (Structure) then
Display_Error_Location (Step, 95);
end if;
Get_Greater_Or_Equal (Structure, Item, Found);
if not Found or Item /= Min (Structure) then
Display_Error_Location (Step, 100);
end if;
Destroy (Structure);
Insert (Structure, Ascending_Vector (1));
end;
else
-- tests only for structures of size VECTOR_SIZE.
begin
Assign (Item, Max_Value);
Assign (Item2, Less (Structure, Item));
if Item2 /= Ascending_Vector (Vector_Size - 1) then
Display_Error_Location (Step, 105);
end if;
Get_Less (Structure, Item);
if Item /= Ascending_Vector (Vector_Size - 1) then
Display_Error_Location (Step, 110);
end if;
Assign (Item, Max_Value);
Get_Less (Structure, Item, Found);
if not Found or Item /= Ascending_Vector (Vector_Size - 1) then
Display_Error_Location (Step, 115);
end if;
Assign (Item, Max_Value);
Assign (Item2, Less_Or_Equal (Structure, Item));
if Item2 /= Ascending_Vector (Vector_Size) or
Item2 /= Max_Value then
Display_Error_Location (Step, 120);
end if;
Get_Less_Or_Equal (Structure, Item);
if Item /= Max_Value then
Display_Error_Location (Step, 125);
end if;
Assign (Item, Max_Value);
Get_Less_Or_Equal (Structure, Item, Found);
if not Found or Item /= Max_Value then
Display_Error_Location (Step, 130);
end if;
Assign (Item, Min_Value);
Get_Less (Structure, Item, Found);
if Found then
Display_Error_Location (Step, 135);
end if;
Assign (Item2, Less_Or_Equal (Structure, Item));
if Item2 /= Min_Value then
Display_Error_Location (Step, 140);
end if;
Get_Less_Or_Equal (Structure, Item);
if Item /= Min_Value then
Display_Error_Location (Step, 145);
end if;
Get_Less_Or_Equal (Structure, Item, Found);
if not Found or Item /= Min_Value then
Display_Error_Location (Step, 150);
end if;
Assign (Item2, Greater (Structure, Item));
if Item2 /= Ascending_Vector (Vector'First + 1) then
Display_Error_Location (Step, 155);
end if;
Assign (Item, Min_Value);
Get_Greater (Structure, Item, Found);
if not Found or Item /= Ascending_Vector (Vector'First + 1) then
Display_Error_Location (Step, 160);
end if;
Assign (Item, Max_Value);
Get_Greater (Structure, Item, Found);
if Found then
Display_Error_Location (Step, 165);
end if;
Assign (Item, Min_Value);
Assign (Item2, Greater_Or_Equal (Structure, Item));
if Item2 /= Min_Value then
Display_Error_Location (Step, 170);
end if;
Get_Greater_Or_Equal (Structure, Item);
if Item /= Min_Value then
Display_Error_Location (Step, 175);
end if;
Get_Greater_Or_Equal (Structure, Item, Found);
if not Found or Item /= Min_Value then
Display_Error_Location (Step, 180);
end if;
Assign (Item, Max_Value);
Assign (Item2, Greater_Or_Equal (Structure, Item));
if Item2 /= Max_Value then
Display_Error_Location (Step, 185);
end if;
Get_Greater_Or_Equal (Structure, Item);
if Item /= Max_Value then
Display_Error_Location (Step, 190);
end if;
Get_Greater_Or_Equal (Structure, Item, Found);
if not Found or Item /= Max_Value then
Display_Error_Location (Step, 195);
end if;
Assign (Item, Max_Value);
Remove_Max (Structure);
Assign (Item2, Less (Structure, Item));
if Item2 /= Max (Structure) then
Display_Error_Location (Step, 200);
end if;
Get_Less (Structure, Item);
if Item /= Max (Structure) then
Display_Error_Location (Step, 205);
end if;
Assign (Item, Max_Value);
Get_Less (Structure, Item, Found);
if not Found or Item /= Max (Structure) then
Display_Error_Location (Step, 210);
end if;
Assign (Item, Max_Value);
Assign (Item2, Less_Or_Equal (Structure, Item));
if Item2 /= Max (Structure) then
Display_Error_Location (Step, 215);
end if;
Get_Less_Or_Equal (Structure, Item);
if Item /= Max (Structure) then
Display_Error_Location (Step, 220);
end if;
Assign (Item, Max_Value);
Get_Less_Or_Equal (Structure, Item, Found);
if not Found or Item /= Max (Structure) then
Display_Error_Location (Step, 230);
end if;
Assign (Item, Min_Value);
Remove_Min (Structure);
Get_Less (Structure, Item, Found);
if Found or Item /= Min_Value then
Display_Error_Location (Step, 235);
end if;
Get_Less_Or_Equal (Structure, Item, Found);
if Found or Item /= Min_Value then
Display_Error_Location (Step, 240);
end if;
Assign (Item2, Greater (Structure, Item));
if Item2 /= Min (Structure) then
Display_Error_Location (Step, 245);
end if;
Get_Greater (Structure, Item);
if Item /= Min (Structure) then
Display_Error_Location (Step, 250);
end if;
Assign (Item, Min_Value);
Get_Greater (Structure, Item, Found);
if not Found or Item /= Min (Structure) then
Display_Error_Location (Step, 255);
end if;
Assign (Item, Min_Value);
Assign (Item2, Greater_Or_Equal (Structure, Item));
if Item2 /= Min (Structure) then
Display_Error_Location (Step, 260);
end if;
Get_Greater_Or_Equal (Structure, Item);
if Item /= Min (Structure) then
Display_Error_Location (Step, 265);
end if;
Assign (Item, Min_Value);
Get_Greater_Or_Equal (Structure, Item, Found);
if not Found or Item /= Min (Structure) then
Display_Error_Location (Step, 270);
end if;
Assign (Item, Max_Value);
Get_Greater (Structure, Item, Found);
if Found or Item /= Max_Value then
Display_Error_Location (Step, 275);
end if;
Get_Greater_Or_Equal (Structure, Item, Found);
if Found or Item /= Max_Value then
Display_Error_Location (Step, 280);
end if;
Remove (Structure, Item, Found);
if Found then
Display_Error_Location (Step, 285);
end if;
Initialize (Structure, Vector_Size);
end;
declare
Middle_Item, Less_Item, Greater_Item : Item_Type;
begin
Assign (Middle_Item, Ascending_Vector (Vector_Size / 2));
Assign (Item, Middle_Item);
Assign (Less_Item, Ascending_Vector (Vector_Size / 2 - 1));
Assign (Greater_Item, Ascending_Vector (Vector_Size / 2 + 1));
Remove (Structure, Middle_Item);
Assign (Item2, Less (Structure, Item));
if Item2 /= Less_Item then
Display_Error_Location (Step, 290);
end if;
Get_Less (Structure, Item);
if Item /= Less_Item then
Display_Error_Location (Step, 295);
end if;
Assign (Item, Middle_Item);
Get_Less (Structure, Item, Found);
if not Found or Item /= Less_Item then
Display_Error_Location (Step, 300);
end if;
Assign (Item, Middle_Item);
Assign (Item2, Less_Or_Equal (Structure, Item));
if Item2 /= Less_Item then
Display_Error_Location (Step, 305);
end if;
Get_Less_Or_Equal (Structure, Item);
if Item /= Less_Item then
Display_Error_Location (Step, 310);
end if;
Assign (Item, Middle_Item);
Get_Less_Or_Equal (Structure, Item, Found);
if not Found or Item /= Less_Item then
Display_Error_Location (Step, 315);
end if;
Assign (Item, Middle_Item);
Assign (Item2, Greater (Structure, Item));
if Item2 /= Greater_Item then
Display_Error_Location (Step, 320);
end if;
Assign (Item, Middle_Item);
Get_Greater (Structure, Item, Found);
if not Found or Item /= Greater_Item then
Display_Error_Location (Step, 325);
end if;
Assign (Item, Middle_Item);
Assign (Item2, Greater_Or_Equal (Structure, Item));
if Item2 /= Greater_Item then
Display_Error_Location (Step, 330);
end if;
Get_Greater_Or_Equal (Structure, Item);
if Item /= Greater_Item then
Display_Error_Location (Step, 335);
end if;
Assign (Item, Middle_Item);
Get_Greater_Or_Equal (Structure, Item, Found);
if not Found or Item /= Greater_Item then
Display_Error_Location (Step, 340);
end if;
Initialize (Structure, Vector_Size);
end;
end if;
-- Common tests for any size structures.
if Size (Structure) /= Number then
Display_Error_Location (Step, 345);
end if;
if Is_Empty (Structure) then
Display_Error_Location (Step, 350);
end if;
Get_Max (Structure, Item);
if Item /= Max_Value then
Display_Error_Location (Step, 355);
end if;
Assign (Item, Max (Structure));
if Item /= Max_Value then
Display_Error_Location (Step, 360);
end if;
Get_Min (Structure, Item);
if Item /= Min_Value then
Display_Error_Location (Step, 365);
end if;
Assign (Item, Min (Structure));
if Item /= Min_Value then
Display_Error_Location (Step, 370);
end if;
Remove (Structure, Max_Value);
if Size (Structure) /= Number - 1 then
Display_Error_Location (Step, 380);
end if;
Insert (Structure, Max_Value);
Remove (Structure, Max_Value, Found);
if Size (Structure) /= Number - 1 or not Found then
Display_Error_Location (Step, 385);
end if;
Insert (Structure, Max_Value);
Remove_Max (Structure);
if Size (Structure) /= Number - 1 then
Display_Error_Location (Step, 390);
end if;
Insert (Structure, Max_Value);
Remove_Max (Structure, Item);
if Size (Structure) /= Number - 1 then
Display_Error_Location (Step, 395);
end if;
if Item /= Max_Value then
Display_Error_Location (Step, 400);
end if;
Insert (Structure, Max_Value);
Remove_Min (Structure);
if Size (Structure) /= Number - 1 then
Display_Error_Location (Step, 405);
end if;
Insert (Structure, Min_Value);
Remove_Min (Structure, Item);
if Size (Structure) /= Number - 1 then
Display_Error_Location (Step, 410);
end if;
if Item /= Min_Value then
Display_Error_Location (Step, 415);
end if;
Insert (Structure, Min_Value);
if Size (Structure) /= Number then
Display_Error_Location (Step, 420);
end if;
if Structure /= Structure then
Display_Error_Location (Step, 425);
end if;
Insert (Structure, Min_Value, Found);
if not Found then
Display_Error_Location (Step, 455);
end if;
begin
Traverse_Asc_Without_Action (Structure);
exception
when others =>
Display_Error_Location (Step, 460);
end;
begin
Traverse_Desc_Without_Action (Structure);
exception
when others =>
Display_Error_Location (Step, 465);
end;
begin
Disorder_Traverse_Without_Action (Structure);
exception
when others =>
Display_Error_Location (Step, 470);
end;
if not Is_Present (Structure, Min_Value) then
Display_Error_Location (Step, 495);
end if;
declare
Dest : Set_Type;
begin
Assign (Dest, Structure);
if Dest /= Structure then
Display_Error_Location (Step, 500);
end if;
Assign (Structure, Structure);
if Dest /= Structure then
Display_Error_Location (Step, 505);
end if;
end;
Destroy (Structure);
if not Is_Empty (Structure) then
Display_Error_Location (Step, 510);
end if;
exception
when others =>
Display_Error_Location (Step, 470);
-- Presence of an undefined error!
end Check_Unary_Operations;
-------------------------------------------------------------------------------
procedure Check_Equal_Structures (Left, Right : in out Set_Type) is
-- Check relations and assignment between two equal structures.
begin
if Left /= Right then
Display_Error_Location (Step, 5);
end if;
if Left < Right then
Display_Error_Location (Step, 10);
end if;
if Left > Right then
Display_Error_Location (Step, 15);
end if;
if not (Left >= Right) then
Display_Error_Location (Step, 20);
end if;
if not (Left <= Right) then
Display_Error_Location (Step, 25);
end if;
begin
Assign (Left, Right);
exception
when others =>
Display_Error_Location (Step, 30);
end;
begin
Destroy (Left);
Assign (Left, Right);
exception
when others =>
Display_Error_Location (Step, 35);
end;
begin
Destroy (Right);
Assign (Left, Right);
exception
when others =>
Display_Error_Location (Step, 40);
end;
if Left /= Right then
Display_Error_Location (Step, 45);
end if;
exception
when others =>
Display_Error_Location (Step, 50);
-- Presence of an undefined error!
end Check_Equal_Structures;
-------------------------------------------------------------------------------
procedure Check_Not_Equal_Structures (Left, Right : in out Set_Type) is
-- Check relations and assignment between two different structures.
Structure : Set_Type;
Found, Duplicate_Item : Boolean;
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;
Initialize (Structure, Vector_Size - 1);
Assign (Item, Vector (Vector'Last));
if Is_Present (Structure, Item) then
Display_Error_Location (Step, 30);
end if;
Insert (Structure, Item, Duplicate_Item);
if Duplicate_Item then
Display_Error_Location (Step, 40);
end if;
if Size (Structure) /= Vector_Size then
Display_Error_Location (Step, 50);
end if;
exception
when others =>
Display_Error_Location (Step, 55);
-- Presence of an undefined error!
end Check_Not_Equal_Structures;
-------------------------------------------------------------------------------
procedure Check_Set_Operations is
-- Check procedures
-- UNION
-- INTERSECTION
-- DIFFERENCE
-- SYMMETRIC_DIFFERENCE
-- "<" strict set inclusion
-- "<=" set inclusion
-- ">"
-- ">="
-- "=" set equality
Dest, Dest2, Left, Right : Set_Type;
Item : Item_Type;
Error : Boolean;
begin
--/ UNION
Initialize (Left, Vector_Size);
Initialize2 (Right, Vector_Size);
Union (Dest, Left, Right);
if Size (Dest) /= Size (Left) + Size (Right) then
Display_Error_Location (Step, 5);
end if;
-- DEST must contain LEFT and RIGHT.
for I in 1 .. 2 * Vector_Size loop
Assign (Item, Max (Dest));
Remove_Max (Dest);
if not (Is_Present (Left, Item) or Is_Present (Right, Item)) then
Display_Error_Location (Step, 10);
end if;
end loop;
Destroy (Dest);
Assign (Item, Max (Left));
Insert (Right, Item);
-- LEFT and RIGHT are different except for one element.
Union (Dest, Left, Right);
if (Size (Dest) /= Size (Left) + Size (Right) - 1) then
Display_Error_Location (Step, 15);
end if;
Destroy (Dest);
Destroy (Left);
-- LEFT is empty
Union (Dest, Left, Right);
if Dest /= Right then
Display_Error_Location (Step, 20);
end if;
if Size (Dest) /= Size (Right) then
Display_Error_Location (Step, 25);
end if;
Destroy (Dest);
Union (Dest, Right, Left);
if Dest /= Right then
Display_Error_Location (Step, 30);
end if;
if Size (Dest) /= Size (Right) then
Display_Error_Location (Step, 35);
end if;
Destroy (Dest);
Union (Dest, Left, Left);
if not Is_Empty (Dest) then
Display_Error_Location (Step, 40);
end if;
if Size (Dest) /= 0 then
Display_Error_Location (Step, 45);
end if;
Union (Dest, Right, Right);
if Dest /= Right then
Display_Error_Location (Step, 50);
end if;
if Size (Dest) /= Size (Right) then
Display_Error_Location (Step, 55);
end if;
Destroy (Dest);
Destroy (Right);
-- LEFT and RIGHT are both empty.
Union (Dest, Left, Right);
if not Is_Empty (Dest) then
Display_Error_Location (Step, 60);
end if;
if Size (Dest) /= 0 then
Display_Error_Location (Step, 65);
end if;
--/ INTERSECTION
Initialize (Left, Vector_Size);
Initialize2 (Right, Vector_Size);
Intersection (Dest, Left, Right);
if not Is_Empty (Dest) then
Display_Error_Location (Step, 70);
end if;
if Size (Dest) /= 0 then
Display_Error_Location (Step, 80);
end if;
Assign (Item, Max (Left));
Insert (Right, Item);
-- LEFT and RIGHT are different except for one element.
Intersection (Dest, Left, Right);
if not Is_Present (Dest, Item) then
Display_Error_Location (Step, 85);
end if;
if Size (Dest) /= 1 then
Display_Error_Location (Step, 90);
end if;
Destroy (Dest);
Destroy (Left);
-- LEFT is empty.
Intersection (Dest, Left, Right);
if not Is_Empty (Dest) then
Display_Error_Location (Step, 95);
end if;
if Size (Dest) /= 0 then
Display_Error_Location (Step, 100);
end if;
Intersection (Dest, Right, Left);
if not Is_Empty (Dest) then
Display_Error_Location (Step, 105);
end if;
if Size (Dest) /= 0 then
Display_Error_Location (Step, 110);
end if;
Intersection (Dest, Left, Left);
if not Is_Empty (Dest) then
Display_Error_Location (Step, 115);
end if;
if Size (Dest) /= 0 then
Display_Error_Location (Step, 120);
end if;
Intersection (Dest, Right, Right);
if Dest /= Right then
Display_Error_Location (Step, 125);
end if;
if Size (Dest) /= Size (Right) then
Display_Error_Location (Step, 130);
end if;
-- DEST and RIGHT must be equals.
while not Is_Empty (Dest) loop
Assign (Item, Max (Right));
Remove_Max (Right);
if not Is_Present (Dest, Item) then
Display_Error_Location (Step, 135);
end if;
Remove (Dest, Item);
end loop;
-- LEFT and RIGHT are both empty.
Intersection (Dest, Left, Right);
if not Is_Empty (Dest) then
Display_Error_Location (Step, 140);
end if;
if Size (Dest) /= 0 then
Display_Error_Location (Step, 145);
end if;
-- DIFFERENCE
Initialize (Left, Vector_Size);
Initialize2 (Right, Vector_Size);
Difference (Dest, Left, Right);
if Dest /= Left then
Display_Error_Location (Step, 150);
end if;
if Size (Dest) /= Size (Left) then
Display_Error_Location (Step, 155);
end if;
Destroy (Dest);
Assign (Item, Max (Left));
Insert (Right, Item);
-- LEFT and RIGHT are different except for one element.
Difference (Dest, Left, Right);
if Size (Dest) /= Size (Left) - 1 then
Display_Error_Location (Step, 160);
end if;
if Is_Present (Dest, Item) then
Display_Error_Location (Step, 165);
end if;
Destroy (Dest);
Destroy (Left);
-- LEFT is empty.
Difference (Dest, Left, Right);
if not Is_Empty (Dest) then
Display_Error_Location (Step, 170);
end if;
if Size (Dest) /= 0 then
Display_Error_Location (Step, 175);
end if;
-- LEFT is empty and RIGHT is not.
Difference (Dest, Right, Left);
if Dest /= Right then
Display_Error_Location (Step, 180);
end if;
if Size (Dest) /= Size (Right) then
Display_Error_Location (Step, 185);
end if;
Destroy (Dest);
Difference (Dest, Left, Left);
if not Is_Empty (Dest) then
Display_Error_Location (Step, 190);
end if;
if Size (Dest) /= 0 then
Display_Error_Location (Step, 195);
end if;
Difference (Dest, Right, Right);
if not Is_Empty (Dest) then
Display_Error_Location (Step, 200);
end if;
if Size (Dest) /= 0 then
Display_Error_Location (Step, 205);
end if;
Destroy (Right);
-- LEFT and RIGHT are both empty.
Difference (Dest, Left, Right);
if not Is_Empty (Dest) then
Display_Error_Location (Step, 210);
end if;
if Size (Dest) /= 0 then
Display_Error_Location (Step, 215);
end if;
-- SYMMETRIC_DIFFERENCE
declare
Dest1, Dest2 : Set_Type;
procedure A_Diff_B_Union_B_Diff_A
(Destination, Left, Right : in out Set_Type;
Error : out Boolean) is
Dest1, Dest2 : Set_Type;
begin
Destroy (Destination);
Difference (Dest1, Left, Right);
Difference (Dest2, Right, Left);
Union (Destination, Dest1, Dest2);
Destroy (Dest1);
Symmetric_Difference (Dest1, Left, Right);
Error := Dest1 /= Destination;
end A_Diff_B_Union_B_Diff_A;
procedure A_Union_B_Diff_A_Inter_B
(Destination, Left, Right : in out Set_Type;
Error : out Boolean) is
Dest1, Dest2 : Set_Type;
begin
Destroy (Destination);
Union (Dest1, Left, Right);
Intersection (Dest2, Left, Right);
Difference (Destination, Dest1, Dest2);
Destroy (Dest1);
Symmetric_Difference (Dest1, Left, Right);
Error := Dest1 /= Destination;
end A_Union_B_Diff_A_Inter_B;
-- The symmetric difference can be obtained, if we consider
-- two set A and B, by two different ways :
-- (A UNION B) DIFFERENCE (A INTERSECTION B)
-- (A DIFFERENCE B) UNION (B DIFFERENCE A)
begin
Destroy (Dest);
Initialize (Left, Vector_Size);
Initialize2 (Right, Vector_Size);
Symmetric_Difference (Dest, Left, Right);
if Is_Empty (Dest) then
Display_Error_Location (Step, 220);
end if;
if Size (Dest) /= Size (Left) + Size (Right) then
Display_Error_Location (Step, 225);
end if;
A_Diff_B_Union_B_Diff_A (Dest1, Left, Right, Error);
if Error then
Display_Error_Location (Step, 230);
end if;
A_Union_B_Diff_A_Inter_B (Dest2, Left, Right, Error);
if Error then
Display_Error_Location (Step, 235);
end if;
if Dest1 /= Dest2 then
Display_Error_Location (Step, 240);
end if;
Assign (Item, Max (Left));
Insert (Right, Item);
-- LEFT and RIGHT are different except for one element.
Symmetric_Difference (Dest, Left, Right);
if Is_Present (Dest, Item) then
Display_Error_Location (Step, 245);
end if;
if Size (Dest) /= Size (Left) + Size (Right) - 2 then
Display_Error_Location (Step, 250);
end if;
A_Diff_B_Union_B_Diff_A (Dest1, Left, Right, Error);
if Error then
Display_Error_Location (Step, 255);
end if;
A_Union_B_Diff_A_Inter_B (Dest2, Left, Right, Error);
if Error then
Display_Error_Location (Step, 260);
end if;
if Dest1 /= Dest2 then
Display_Error_Location (Step, 265);
end if;
Destroy (Dest);
Destroy (Left);
-- LEFT is empty and RIGHT is not.
Symmetric_Difference (Dest, Left, Right);
if Is_Empty (Dest) then
Display_Error_Location (Step, 270);
end if;
if Size (Dest) /= Size (Right) then
Display_Error_Location (Step, 275);
end if;
A_Diff_B_Union_B_Diff_A (Dest1, Left, Right, Error);
if Error then
Display_Error_Location (Step, 280);
end if;
A_Union_B_Diff_A_Inter_B (Dest2, Left, Right, Error);
if Error then
Display_Error_Location (Step, 285);
end if;
if Dest1 /= Dest2 then
Display_Error_Location (Step, 280);
end if;
Symmetric_Difference (Dest, Right, Left);
if Is_Empty (Dest) then
Display_Error_Location (Step, 295);
end if;
if Size (Dest) /= Size (Right) then
Display_Error_Location (Step, 300);
end if;
A_Diff_B_Union_B_Diff_A (Dest1, Left, Right, Error);
if Error then
Display_Error_Location (Step, 305);
end if;
A_Union_B_Diff_A_Inter_B (Dest2, Left, Right, Error);
if Error then
Display_Error_Location (Step, 310);
end if;
if Dest1 /= Dest2 then
Display_Error_Location (Step, 315);
end if;
Symmetric_Difference (Dest, Left, Left);
if not Is_Empty (Dest) then
Display_Error_Location (Step, 320);
end if;
if Size (Dest) /= 0 then
Display_Error_Location (Step, 325);
end if;
A_Diff_B_Union_B_Diff_A (Dest1, Left, Right, Error);
if Error then
Display_Error_Location (Step, 330);
end if;
A_Union_B_Diff_A_Inter_B (Dest2, Left, Right, Error);
if Error then
Display_Error_Location (Step, 335);
end if;
if Dest1 /= Dest2 then
Display_Error_Location (Step, 340);
end if;
Symmetric_Difference (Dest, Right, Right);
if not Is_Empty (Dest) then
Display_Error_Location (Step, 345);
end if;
if Size (Dest) /= 0 then
Display_Error_Location (Step, 350);
end if;
A_Diff_B_Union_B_Diff_A (Dest1, Left, Right, Error);
if Error then
Display_Error_Location (Step, 355);
end if;
A_Union_B_Diff_A_Inter_B (Dest2, Left, Right, Error);
if Error then
Display_Error_Location (Step, 360);
end if;
if Dest1 /= Dest2 then
Display_Error_Location (Step, 365);
end if;
Destroy (Right);
-- LEFT and RIGHT are both empty.
Symmetric_Difference (Dest, Left, Right);
if not Is_Empty (Dest) then
Display_Error_Location (Step, 370);
end if;
if Size (Dest) /= 0 then
Display_Error_Location (Step, 375);
end if;
A_Diff_B_Union_B_Diff_A (Dest1, Left, Right, Error);
if Error then
Display_Error_Location (Step, 380);
end if;
A_Union_B_Diff_A_Inter_B (Dest2, Left, Right, Error);
if Error then
Display_Error_Location (Step, 385);
end if;
if Dest1 /= Dest2 then
Display_Error_Location (Step, 390);
end if;
end;
--/ strict set inclusion "<" and ">"
Initialize (Left, Vector_Size);
Initialize2 (Right, Vector_Size);
-- LEFT and RIGHT are entirely different.
if Left < Right then
Display_Error_Location (Step, 395);
end if;
if Left > Right then
Display_Error_Location (Step, 400);
end if;
if not ((Left < Right) = (Right > Left)) then
Display_Error_Location (Step, 405);
end if;
Initialize (Right, Vector_Size);
-- LEFT and RIGHT are identical.
if Left < Left then
Display_Error_Location (Step, 410);
end if;
if Left > Left then
Display_Error_Location (Step, 415);
end if;
Remove_Max (Left);
-- RIGHT contains one more element than LEFT.
if not (Left < Right) then
Display_Error_Location (Step, 420);
end if;
if Left > Right then
Display_Error_Location (Step, 425);
end if;
if not (Right > Left) then
Display_Error_Location (Step, 430);
end if;
Remove_Max (Right);
Remove_Max (Right);
-- LEFT contains one more element than RIGHT.
if Left < Right then
Display_Error_Location (Step, 435);
end if;
Destroy (Left);
-- LEFT is empty and RIGHT is not.
if not (Left < Right) then
Display_Error_Location (Step, 440);
end if;
if Left > Right then
Display_Error_Location (Step, 445);
end if;
if Right < Left then
Display_Error_Location (Step, 450);
end if;
if not (Right > Left) then
Display_Error_Location (Step, 455);
end if;
--/ set inclusion "<=" and ">="
Initialize (Left, Vector_Size);
Initialize2 (Right, Vector_Size);
if Left <= Right then
Display_Error_Location (Step, 460);
end if;
if Left >= Right then
Display_Error_Location (Step, 465);
end if;
if not ((Left <= Right) = (Right >= Left)) then
Display_Error_Location (Step, 470);
end if;
Initialize (Right, Vector_Size);
-- LEFT and RIGHT are identical.
if not (Left <= Left) then
Display_Error_Location (Step, 475);
end if;
if not (Left >= Left) then
Display_Error_Location (Step, 480);
end if;
Remove_Max (Left);
-- RIGHT contains one more element than LEFT.
if not (Left <= Right) then
Display_Error_Location (Step, 485);
end if;
if Left >= Right then
Display_Error_Location (Step, 490);
end if;
if not (Right >= Left) then
Display_Error_Location (Step, 495);
end if;
Remove_Max (Right);
Remove_Max (Right);
-- LEFT contains one more element than RIGHT.
if Left <= Right then
Display_Error_Location (Step, 500);
end if;
Destroy (Left);
-- LEFT is empty and RIGHT is not.
if not (Left <= Right) then
Display_Error_Location (Step, 505);
end if;
if Left >= Right then
Display_Error_Location (Step, 510);
end if;
if Right <= Left then
Display_Error_Location (Step, 515);
end if;
if not (Right >= Left) then
Display_Error_Location (Step, 520);
end if;
if not ((Left < Right or Left = Right) = (Left <= Right)) then
Display_Error_Location (Step, 525);
end if;
if not ((Left > Right or Left = Right) = (Left >= Right)) then
Display_Error_Location (Step, 530);
end if;
--/ set equality
Initialize (Left, Vector_Size);
Initialize2 (Right, Vector_Size);
if Left = Right then
Display_Error_Location (Step, 535);
end if;
Initialize (Right, Vector_Size);
if not (Left = Right) then
Display_Error_Location (Step, 540);
end if;
Remove_Max (Left);
if Left = Right then
Display_Error_Location (Step, 545);
end if;
if Right = Left then
Display_Error_Location (Step, 550);
end if;
end Check_Set_Operations;
-------------------------------------------------------------------------------
procedure Check_Asc_Traversal (Set : in out Set_Type;
Last : in Natural;
Ascending_Vector : in Vector_Type) is
-- Check procedures
-- TRAVERSE_ASC_G.
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 /= Ascending_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_Asc is new Traverse_Asc_G (Compare);
begin
Number := 0;
Traverse_Asc (Set);
exception
when Order_Number_Error =>
Display_Error_Location (Step, 5);
when Value_Error =>
Display_Error_Location (Step, 10);
end;
declare
procedure Traverse_Asc is new Traverse_Asc_G (Stop_At_Number);
begin
Number := 1;
Traverse_Asc (Set);
Number := (Last + 1) / 2;
Traverse_Asc (Set);
Number := Last - 1;
if Number > 0 then
Traverse_Asc (Set);
end if;
Number := Last;
Traverse_Asc (Set);
exception
when Stop_Error =>
Display_Error_Location (Step, 15);
end;
exception
when others =>
Display_Error_Location (Step, 35);
-- Presence of an undefined error!
end Check_Asc_Traversal;
-------------------------------------------------------------------------------
procedure Check_Desc_Traversal (Set : in out Set_Type;
Last : in Natural;
Descending_Vector : in Vector_Type) is
-- Check procedures
-- TRAVERSE_DESC_G.
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 /= Descending_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_Desc is new Traverse_Desc_G (Compare);
begin
Number := 0;
Traverse_Desc (Set);
exception
when Order_Number_Error =>
Display_Error_Location (Step, 40);
when Value_Error =>
Display_Error_Location (Step, 45);
end;
declare
procedure Traverse_Desc is new Traverse_Desc_G (Stop_At_Number);
begin
Number := 1;
Traverse_Desc (Set);
Number := (Last + 1) / 2;
Traverse_Desc (Set);
Number := Last - 1;
if Number > 0 then
Traverse_Desc (Set);
end if;
Number := Last;
Traverse_Desc (Set);
exception
when Stop_Error =>
Display_Error_Location (Step, 50);
end;
exception
when others =>
Display_Error_Location (Step, 70);
-- Presence of an undefined error!
end Check_Desc_Traversal;
-------------------------------------------------------------------------------
procedure Check_Disorder_Traversal (Structure : in out Set_Type) is
-- Check procedures
-- DISORDER_TRAVERSE_G
procedure Act (Item : in Item_Type;
Order_Number : in Positive;
Continue : in out Boolean) is
begin
if not Is_Present (Structure, Item) or
Order_Number > Size (Structure) then
Continue := False;
Display_Error_Location (Step, 5);
end if;
end Act;
procedure Disorder_Traverse is new Disorder_Traverse_G (Act);
begin
Disorder_Traverse (Structure);
exception
when others =>
Display_Error_Location (Step, 10);
end Check_Disorder_Traversal;
-------------------------------------------------------------------------------
procedure Preliminary_Tests is
-- Preliminary verification of each exported procedure.
Source, Dest, Structure : Set_Type;
Found, Duplicate_Item : Boolean;
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_Max (Structure, Item);
if Size (Structure) /= Vector_Size - I then
Display_Error_Location (Step, 10);
exit;
end if;
end loop;
Initialize (Structure, Vector_Size);
for I in Vector'Range loop
Remove_Min (Structure, Item);
if Size (Structure) /= Vector_Size - I then
Display_Error_Location (Step, 15);
exit;
end if;
end loop;
--/ DESTROY test
Initialize (Structure, Vector_Size);
Destroy (Structure);
if Size (Structure) /= 0 then
Display_Error_Location (Step, 20);
end if;
--/ INSERT/REMOVE(...ITEM) and SET content test
Initialize (Structure, Vector_Size);
Remove_Max (Structure, Item);
if Item /= Ascending_Vector (Vector_Size) then
Display_Error_Location (Step, 25);
end if;
Remove_Min (Structure, Item);
if Item /= Ascending_Vector (1) then
Display_Error_Location (Step, 30);
end if;
--/ REMOVE tests
Initialize (Structure, Vector_Size);
for I in 1 .. Vector_Size loop
Get_Max (Structure, Item);
if Item /= Ascending_Vector (Vector_Size + 1 - I) then
Display_Error_Location (Step, 35);
exit;
end if;
Assign (Item, Max (Structure));
if Item /= Ascending_Vector (Vector_Size + 1 - I) then
Display_Error_Location (Step, 40);
exit;
end if;
Remove_Max (Structure);
if Size (Structure) /= Vector_Size - I then
Display_Error_Location (Step, 45);
exit;
end if;
end loop;
Initialize (Structure, Vector_Size);
for I in 1 .. Vector_Size loop
Get_Min (Structure, Item);
if Item /= Ascending_Vector (I) then
Display_Error_Location (Step, 50);
exit;
end if;
Assign (Item, Min (Structure));
if Item /= Ascending_Vector (I) then
Display_Error_Location (Step, 55);
exit;
end if;
Remove_Min (Structure);
if Size (Structure) /= Vector_Size - I then
Display_Error_Location (Step, 60);
exit;
end if;
end loop;
Initialize (Structure, Vector_Size);
for I in 1 .. Vector_Size loop
Remove (Structure, Vector (I));
if Size (Structure) /= Vector_Size - I then
Display_Error_Location (Step, 65);
exit;
end if;
end loop;
Initialize (Structure, Vector_Size);
for I in 1 .. Vector_Size loop
Remove (Structure, Vector (I), Found);
if Size (Structure) /= Vector_Size - I or Found = False then
Display_Error_Location (Step, 70);
exit;
end if;
end loop;
--/ ADD, DELETE TESTS
Destroy (Structure);
for I in Vector'Range loop
begin
Add (Structure, Vector (I));
Add (Structure, Vector (I));
exception
when others =>
Display_Error_Location (Step, 71);
end;
begin
Delete (Structure, Vector (I));
Delete (Structure, Vector (I));
exception
when others =>
Display_Error_Location (Step, 72);
end;
end loop;
if Size (Structure) /= 0 then
Display_Error_Location (Step, 73);
end if;
--/ ASSIGN TEST
Initialize (Source, Vector_Size);
Assign (Dest, Source);
if Dest /= Source then
Display_Error_Location (Step, 75);
end if;
if Dest < Source then
Display_Error_Location (Step, 80);
end if;
if Dest > Source then
Display_Error_Location (Step, 85);
end if;
if not (Dest >= Source) then
Display_Error_Location (Step, 90);
end if;
if not (Dest <= Source) then
Display_Error_Location (Step, 95);
end if;
--/ GET_... tests
Initialize (Structure, Vector_Size);
Get_Max (Structure, Item);
if Item /= Ascending_Vector (Vector_Size) then
Display_Error_Location (Step, 100);
end if;
Get_Min (Structure, Item);
if Item /= Ascending_Vector (1) then
Display_Error_Location (Step, 105);
end if;
--/ "=", "<", ">", ">=", "<=" tests
Initialize (Source, Vector_Size);
Initialize (Dest, Vector_Size);
if Source /= Dest then
Display_Error_Location (Step, 120);
end if;
if Source < Dest then
Display_Error_Location (Step, 125);
end if;
if Source > Dest then
Display_Error_Location (Step, 130);
end if;
if not (Source >= Dest) then
Display_Error_Location (Step, 135);
end if;
if not (Source <= Dest) then
Display_Error_Location (Step, 140);
end if;
--/ IS_PRESENT tests
if not Is_Present (Structure, Ascending_Vector (Vector_Size / 2)) then
Display_Error_Location (Step, 150);
end if;
Initialize (Structure, Vector_Size - 1);
Assign (Item, Vector (Vector'Last));
if Is_Present (Structure, Item) then
Display_Error_Location (Step, 180);
end if;
Insert (Structure, Item, Duplicate_Item);
if Duplicate_Item then
Display_Error_Location (Step, 195);
end if;
Insert (Structure, Item, Duplicate_Item);
if not Duplicate_Item then
Display_Error_Location (Step, 200);
end if;
if Size (Structure) /= Vector_Size then
Display_Error_Location (Step, 210);
end if;
--/ tests of ITERATORS
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 SET with corresponding
-- element of the ASCENDING_VECTOR.
begin
if Item /= Ascending_Vector (Order_Number) then
raise Compare_Error;
end if;
end Compare_Each;
procedure Traverse_Asc_Test is new Traverse_Asc_G (Compare_Each);
begin
Initialize (Structure, Vector_Size);
Traverse_Asc_Test (Structure);
exception
when Compare_Error =>
Display_Error_Location (Step, 240);
end;
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 SET with corresponding
-- element of the DESCENDING_VECTOR.
begin
if Item /= Descending_Vector (Order_Number) then
raise Compare_Error;
end if;
end Compare_Each;
procedure Traverse_Desc_Test is new Traverse_Desc_G (Compare_Each);
begin
Initialize (Structure, Vector_Size);
Traverse_Desc_Test (Structure);
exception
when Compare_Error =>
Display_Error_Location (Step, 245);
end;
exception
when others =>
Display_Error_Location (Step, 250);
-- Presence of an undefined error!
end Preliminary_Tests;
-------------------------------------------------------------------------------
procedure Check_Exceptions is
Structure : Set_Type;
begin
--/ EMPTY_STRUCTURE_ERROR tests:
Initialize (Structure, Vector_Size);
Destroy (Structure);
begin
Remove_Max (Structure);
Display_Error_Location (Step, 5); -- exception not raised
exception
when Empty_Structure_Error =>
null;
end;
begin
Remove_Max (Structure, Item);
Display_Error_Location (Step, 10); -- exception not raised
exception
when Empty_Structure_Error =>
null;
end;
begin
Remove_Min (Structure);
Display_Error_Location (Step, 15); -- exception not raised
exception
when Empty_Structure_Error =>
null;
end;
begin
Remove_Min (Structure, Item);
Display_Error_Location (Step, 20); -- exception not raised
exception
when Empty_Structure_Error =>
null;
end;
begin
Get_Min (Structure, Item);
Display_Error_Location (Step, 25); -- exception not raised
exception
when Empty_Structure_Error =>
null;
end;
begin
Assign (Item, Min (Structure));
Display_Error_Location (Step, 30); -- exception not raised
exception
when Empty_Structure_Error =>
null;
end;
begin
Get_Max (Structure, Item);
Display_Error_Location (Step, 35); -- exception not raised
exception
when Empty_Structure_Error =>
null;
end;
begin
Assign (Item, Max (Structure));
Display_Error_Location (Step, 40); -- exception not raised
exception
when Empty_Structure_Error =>
null;
end;
Insert (Structure, Ascending_Vector (1));
Remove_Min (Structure);
begin
Remove_Max (Structure);
Display_Error_Location (Step, 45); -- exception not raised
exception
when Empty_Structure_Error =>
null;
end;
begin
Remove_Max (Structure, Item);
Display_Error_Location (Step, 50); -- exception not raised
exception
when Empty_Structure_Error =>
null;
end;
begin
Remove_Min (Structure);
Display_Error_Location (Step, 55); -- exception not raised
exception
when Empty_Structure_Error =>
null;
end;
begin
Remove_Min (Structure, Item);
Display_Error_Location (Step, 60); -- exception not raised
exception
when Empty_Structure_Error =>
null;
end;
begin
Get_Min (Structure, Item);
Display_Error_Location (Step, 65); -- exception not raised
exception
when Empty_Structure_Error =>
null;
end;
begin
Get_Max (Structure, Item);
Display_Error_Location (Step, 70); -- exception not raised
exception
when Empty_Structure_Error =>
null;
end;
--/ MISSING_ITEM_ERROR tests
Destroy (Structure);
Assign (Item, Vector (1));
begin
Remove (Structure, Item);
Display_Error_Location (Step, 170);-- exception not raised
exception
when Missing_Item_Error =>
null;
end;
Initialize (Structure, Vector_Size - 1);
Assign (Item, Vector (Vector_Size));
begin
Remove (Structure, Item);
Display_Error_Location (Step, 180);-- exception not raised
exception
when Missing_Item_Error =>
null;
end;
Destroy (Structure);
Initialize (Structure, 1);
Assign (Item, Vector (Vector_Size));
begin
Remove (Structure, Item);
Display_Error_Location (Step, 185);-- exception not raised
exception
when Missing_Item_Error =>
null;
end;
Destroy (Structure);
Insert (Structure, Ascending_Vector (Vector'Last));
begin
Assign (Item, Ascending_Vector (Vector'First));
Get_Less (Structure, Item);
Display_Error_Location (Step, 205);-- exception not raised
exception
when Missing_Item_Error =>
null;
end;
begin
Assign (Item, Ascending_Vector (Vector'Last));
Get_Less (Structure, Item);
Display_Error_Location (Step, 210);-- exception not raised
exception
when Missing_Item_Error =>
null;
end;
begin
Assign (Item, Ascending_Vector (Vector'First));
Assign (Item2, Less (Structure, Item));
Display_Error_Location (Step, 220);-- exception not raised
exception
when Missing_Item_Error =>
null;
end;
begin
Assign (Item, Ascending_Vector (Vector'Last));
Assign (Item2, Less (Structure, Item));
Display_Error_Location (Step, 225);-- exception not raised
exception
when Missing_Item_Error =>
null;
end;
Initialize (Structure, Vector_Size);
Assign (Item, Min (Structure));
begin
Assign (Item2, Less (Structure, Item));
Display_Error_Location (Step, 230);-- exception not raised
exception
when Missing_Item_Error =>
null;
end;
begin
Get_Less (Structure, Item);
Display_Error_Location (Step, 235);-- exception not raised
exception
when Missing_Item_Error =>
null;
end;
Remove_Min (Structure);
begin
Assign (Item2, Less (Structure, Item));
Display_Error_Location (Step, 240);-- exception not raised
exception
when Missing_Item_Error =>
null;
end;
begin
Get_Less (Structure, Item);
Display_Error_Location (Step, 245);-- exception not raised
exception
when Missing_Item_Error =>
null;
end;
Destroy (Structure);
Insert (Structure, Ascending_Vector (Vector'Last));
Assign (Item, Ascending_Vector (Vector'First));
begin
Assign (Item2, Less_Or_Equal (Structure, Item));
Display_Error_Location (Step, 250);-- exception not raised
exception
when Missing_Item_Error =>
null;
end;
begin
Get_Less_Or_Equal (Structure, Item);
Display_Error_Location (Step, 255);-- exception not raised
exception
when Missing_Item_Error =>
null;
end;
Initialize (Structure, Vector_Size);
Assign (Item, Min (Structure));
Remove_Min (Structure);
begin
Assign (Item, Less_Or_Equal (Structure, Item));
Display_Error_Location (Step, 260);-- exception not raised
exception
when Missing_Item_Error =>
null;
end;
begin
Get_Less_Or_Equal (Structure, Item);
Display_Error_Location (Step, 265);-- exception not raised
exception
when Missing_Item_Error =>
null;
end;
Destroy (Structure);
Insert (Structure, Ascending_Vector (Vector'First));
Assign (Item, Ascending_Vector (Vector'First));
begin
Assign (Item, Greater (Structure, Item));
Display_Error_Location (Step, 270);-- exception not raised
exception
when Missing_Item_Error =>
null;
end;
begin
Get_Greater (Structure, Item);
Display_Error_Location (Step, 275);-- exception not raised
exception
when Missing_Item_Error =>
null;
end;
Assign (Item, Ascending_Vector (Vector'Last));
begin
Assign (Item, Greater (Structure, Item));
Display_Error_Location (Step, 280);-- exception not raised
exception
when Missing_Item_Error =>
null;
end;
begin
Get_Greater (Structure, Item);
Display_Error_Location (Step, 285);-- exception not raised
exception
when Missing_Item_Error =>
null;
end;
Initialize (Structure, Vector_Size);
Assign (Item, Max (Structure));
Remove_Min (Structure);
begin
Assign (Item2, Greater (Structure, Item));
Display_Error_Location (Step, 290);-- exception not raised
exception
when Missing_Item_Error =>
null;
end;
begin
Get_Greater (Structure, Item);
Display_Error_Location (Step, 295);-- exception not raised
exception
when Missing_Item_Error =>
null;
end;
Remove_Max (Structure);
begin
Assign (Item2, Greater (Structure, Item));
Display_Error_Location (Step, 300);-- exception not raised
exception
when Missing_Item_Error =>
null;
end;
begin
Get_Greater (Structure, Item);
Display_Error_Location (Step, 305);-- exception not raised
exception
when Missing_Item_Error =>
null;
end;
Destroy (Structure);
Insert (Structure, Ascending_Vector (Vector'First));
Assign (Item, Ascending_Vector (Vector'Last));
begin
Assign (Item2, Greater_Or_Equal (Structure, Item));
Display_Error_Location (Step, 310);-- exception not raised
exception
when Missing_Item_Error =>
null;
end;
begin
Get_Greater_Or_Equal (Structure, Item);
Display_Error_Location (Step, 315);-- exception not raised
exception
when Missing_Item_Error =>
null;
end;
Initialize (Structure, Vector_Size);
Assign (Item, Max (Structure));
Remove_Max (Structure);
begin
Assign (Item2, Greater_Or_Equal (Structure, Item));
Display_Error_Location (Step, 320);-- exception not raised
exception
when Missing_Item_Error =>
null;
end;
begin
Get_Greater_Or_Equal (Structure, Item);
Display_Error_Location (Step, 325);-- exception not raised
exception
when Missing_Item_Error =>
null;
end;
--/ DUPLICATE_ITEM_ERROR tests
Initialize (Structure, Vector_Size);
Assign (Item, Vector (Vector'First));
begin
Insert (Structure, Item);
Display_Error_Location (Step, 330);-- exception not raised
exception
when Duplicate_Item_Error =>
null;
end;
end Check_Exceptions;
-------------------------------------------------------------------------------
-------------------------------------------------------------------------------
--/ MAIN TEST PROCEDURE:
begin
Put ("Tests for SET_OF_DYNAMIC_ITEMS_G...");
New_Line;
Generate_Descending (Descending_Vector);
Generate_Ascending (Ascending_Vector);
Generate (Vector);
Generate2 (Vector2);
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 : Set_Type;
-- SETs 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 SET of size 1:
Step := 5;
Destroy (Structure);
Insert (Structure, Ascending_Vector (1));
Check_Unary_Operations (1, Ascending_Vector (1),
Ascending_Vector (1), Structure);
if Error then
raise Test_Error;
end if;
--/Check unary operations on the SET of size VECTOR_SIZE:
Step := 6;
Initialize (Structure, Vector_Size);
Check_Unary_Operations (Vector_Size, Ascending_Vector (1),
Ascending_Vector (Vector_Size), Structure);
if Error then
raise Test_Error;
end if;
--/ A SET 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 REMOVEs must leave the SET empty:
Step := 8;
Initialize (Structure, Vector_Size); -- INSERT(STRUCTURE...);
for I in 1 .. Vector_Size / 2 loop
Remove_Min (Structure);
Remove_Max (Structure);
end loop;
Check_Empty_Structure (Structure);
if Error then
raise Test_Error;
end if;
--/ Destroy must leave the SET 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);
Assign (Item, Vector (1));
Remove (Source, Item);
Insert (Source, Item);
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);
Remove_Min (Dest);
Check_Not_Equal_Structures (Dest, Source);
if Error then
raise Test_Error;
end if;
--/ Check of not equal structures:
--/ same number of elements; greatest element is different.
Step := 13;
Initialize (Source, Vector_Size);
Initialize (Dest, Vector_Size);
Remove (Source, Ascending_Vector (Vector_Size - 1));
Remove (Dest, Ascending_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;
Initialize (Source, Vector_Size);
Initialize (Dest, Vector_Size);
Remove (Source, Ascending_Vector (Vector_Size / 2 - 1));
Remove (Dest, Ascending_Vector (Vector_Size / 2));
Check_Not_Equal_Structures (Dest, Source);
if Error then
raise Test_Error;
end if;
--/ Check of not equal structures;
--/ same number of elements; smallest element is different.
Step := 15;
Initialize (Source, Vector_Size);
Initialize (Dest, Vector_Size);
Remove_Min (Source);
Remove (Dest, Ascending_Vector (2));
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 of set operations;
Step := 18;
Check_Set_Operations;
if Error then
raise Test_Error;
end if;
--/ Check traversal; 1 elements in the SET.
Step := 19;
Destroy (Structure);
Insert (Structure, Ascending_Vector (1));
Check_Asc_Traversal (Structure, 1, Ascending_Vector);
if Error then
raise Test_Error;
end if;
--/ Check traversal; All elements in the SET.
Step := 20;
Initialize (Structure, Vector_Size);
Check_Asc_Traversal (Structure, Vector_Size, Ascending_Vector);
if Error then
raise Test_Error;
end if;
Destroy (Structure);
Destroy (Source);
Destroy (Dest);
--/ Check traversal; 1 elements in the SET.
Step := 21;
Destroy (Structure);
Insert (Structure, Descending_Vector (1));
Check_Desc_Traversal (Structure, 1, Descending_Vector);
if Error then
raise Test_Error;
end if;
--/ Check traversal; All elements in the SET.
Step := 22;
Initialize (Structure, Vector_Size);
Check_Desc_Traversal (Structure, Vector_Size, Descending_Vector);
if Error then
raise Test_Error;
end if;
--/ check disorder traversal, SET is empty.
Step := 23;
Destroy (Structure);
Check_Disorder_Traversal (Structure);
if Error then
raise Test_Error;
end if;
--/ check disorder traversal, 1 element in the SET.
Step := 24;
Insert (Structure, Vector (Vector'First));
Check_Disorder_Traversal (Structure);
if Error then
raise Test_Error;
end if;
--/ check disorder traversal, all elements in the SET.
Step := 25;
Initialize (Structure, Vector_Size);
Check_Disorder_Traversal (Structure);
if Error then
raise Test_Error;
end if;
Destroy (Structure);
Destroy (Source);
Destroy (Dest);
end;
end loop;
--/HEAP MANAGEMENT TESTS:
declare
Structure, Dest, Source : Set_Type;
-- SETs 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 := 26;
declare
Free_List_Size_Error : exception;
begin
for I in 1 .. Vector_Size loop
Remove_Min (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, Ascending_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 := 27;
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_Min (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_Min (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, Ascending_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 := 28;
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_Min (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 := 29;
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 := 30;
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;
begin
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;
exception
when others =>
Display_Error_Location (Step, 15);
-- presence of an undefined error!
end;
if Error then
raise Test_Error;
end if;
end;
Put_Line ("successfuly completed.");
exception
when Test_Error =>
Put_Line ("Test procedure cannot continue.");
end Set_Of_Dynamic_Items_Test;