-- Copyright 1994 Grady Booch
-- Copyright 1998-2002 Simon Wright <simon@pushface.org>
-- This package is free software; you can redistribute it and/or
-- modify it under terms of the GNU General Public License as
-- published by the Free Software Foundation; either version 2, or
-- (at your option) any later version. This package 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 distributed with this package; see file COPYING. If not,
-- write to the Free Software Foundation, 59 Temple Place - Suite
-- 330, Boston, MA 02111-1307, USA.
-- $Id: set_test.adb,v 1.10.2.2 2003/02/04 06:21:45 simon Exp $
with Ada.Exceptions;
with Ada.Text_IO;
with Assertions;
with BC;
with Set_Test_Support;
procedure Set_Test is
use Ada.Text_IO;
use Assertions;
use Set_Test_Support;
procedure Print_Set (S : in out Sets.Abstract_Set'Class; Named : String);
pragma Warnings (Off, Print_Set);
procedure Process (Item : Character; OK : out Boolean);
procedure Process_Modifiable (Item : in out Character; OK : out Boolean);
procedure Test (S1, S2 : in out Sets.Abstract_Set'Class);
procedure Test_Active_Iterator (S : in out Sets.Abstract_Set'Class);
procedure Test_Passive_Iterator (S : in out Containers.Container'Class);
procedure Test_Passive_Modifying_Iterator
(S : in out Containers.Container'Class);
package Iteration_Check is
procedure Reset;
procedure Register (C : Character);
procedure Check (Expected : String; Message : String);
end Iteration_Check;
package body Iteration_Check is
Last_Char : Integer := 0;
Results : String (1 .. 32);
procedure Reset is
begin
Last_Char := 0;
end Reset;
procedure Register (C : Character) is
begin
Last_Char := Last_Char + 1;
Results (Last_Char) := C;
end Register;
procedure Check (Expected : String; Message : String) is
begin
Assertion (Expected'Length = Last_Char,
Message & ", length error");
if Expected'Length = Last_Char then
Assertion (Expected = Results (1 .. Last_Char),
Message & ", mismatch");
end if;
end Check;
end Iteration_Check;
procedure Print_Set (S : in out Sets.Abstract_Set'Class; Named : String) is
procedure Print (Item : Character; OK : out Boolean);
procedure Print (Item : Character; OK : out Boolean) is
begin
Put (" " & Item);
OK := True;
end Print;
procedure Visitor is new Containers.Visit (Print);
It : Containers.Iterator'Class
:= Containers.New_Iterator (Containers.Container'Class (S));
begin
Put ("Set " & Named);
Visitor (It);
New_Line;
end Print_Set;
procedure Test (S1, S2 : in out Sets.Abstract_Set'Class) is
Status : Boolean;
begin
Assertion (Sets.Is_Empty (S1),
"** P01: Set is not initially empty");
Assertion (Sets.Extent (S1) = 0,
"** P02: Set Extent is not initially zero");
Sets.Add (S1, '1');
Sets.Add (S1, '2');
Sets.Add (S1, '3');
Assertion (not Sets.Is_Empty (S1), "** P03: Set is empty");
Assertion (Sets.Extent (S1) = 3, "** P04: Set extent is not correct");
Assertion (Sets.Is_Member (S1, '1'),
"** P05: Set membership is not correct");
Assertion (Sets.Is_Member (S1, '2'),
"** P06: Set membership is not correct");
Assertion (Sets.Is_Member (S1, '3'),
"** P07: Set membership is not correct");
Sets.Clear (S1);
Assertion (Sets.Is_Empty (S1), "** P08: Set is not empty");
Assertion (Sets.Extent (S1) = 0, "** P09: Set extent is not zero");
Sets.Add (S1, '4');
Sets.Add (S1, '5');
Sets.Add (S1, '6');
Assertion (not Sets.Is_Empty (S1), "** P10: Set is empty");
Assertion (Sets.Extent (S1) = 3, "** P11: Set extent is not correct");
Assertion (Sets.Is_Member (S1, '4'),
"** P12: Set membership is not correct");
Assertion (Sets.Is_Member (S1, '5'),
"** P13: Set membership is not correct");
Assertion (Sets.Is_Member (S1, '6'),
"** P14: Set membership is not correct");
Sets.Remove (S1, '4');
Sets.Remove (S1, '6');
Assertion (not Sets.Is_Empty (S1), "** P15: Set is empty");
Assertion (Sets.Extent (S1) = 1, "** P16: Set extent is not correct");
Assertion (not Sets.Is_Member (S1, '4'),
"** P17: Set membership is not correct");
Assertion (Sets.Is_Member (S1, '5'),
"** P18: Set membership is not correct");
Assertion (not Sets.Is_Member (S1, '6'),
"** P19: Set membership is not correct");
Sets.Remove (S1, '5');
Assertion (Sets.Is_Empty (S1), "** P20: Set is not empty");
Assertion (Sets.Extent (S1) = 0, "** P21: Set extent is not zero");
Sets.Add (S1, '7');
Sets.Add (S1, '8');
Sets.Add (S1, '9');
Sets.Remove (S1, '8');
Sets.Remove (S1, '9');
Assertion (not Sets.Is_Empty (S1), "** P22: Set is empty");
Assertion (Sets.Extent (S1) = 1, "** P23: Set extent is not correct");
Assertion (Sets.Is_Member (S1, '7'),
"** P24: Set membership is not correct");
S2 := S1;
Assertion (not Sets.Is_Empty (S1), "** P25: Set is empty");
Assertion (Sets.Extent (S1) = 1, "** P26: Set extent is not correct");
Assertion (Sets.Is_Member (S1, '7'),
"** P27: Set membership is not correct");
Assertion (not Sets.Is_Empty (S2), "** P28: Set is empty");
Assertion (Sets.Extent (S2) = 1, "** P29: Set extent is not correct");
Assertion (Sets.Is_Member (S2, '7'),
"** P30: Set membership is not correct");
Assertion (Sets.Are_Equal (S1, S2), "** P31: Sets are not equal");
Assertion (Sets.Is_Subset (S2, S1), "** P32: Sets are not subsets");
Assertion (not Sets.Is_Proper_Subset (S2, S1),
"** P33: Sets are proper subsets");
Sets.Add (S1, '1');
Sets.Add (S1, '2');
Sets.Add (S1, '3');
Assertion (Sets.Is_Subset (S2, S1), "** P34: Sets are not subsets");
Assertion (Sets.Is_Proper_Subset (S2, S1),
"** P35: Sets are not proper subsets");
Sets.Add (S2, '8');
Sets.Add (S2, '9');
Sets.Union (S1, S2);
Assertion (Sets.Extent (S1) = 6, "** P36: Set extent is not correct");
Assertion (Sets.Is_Member (S1, '8'),
"** P37: Set membership is not correct");
Assertion (Sets.Is_Member (S1, '9'),
"** P38: Set membership is not correct");
Sets.Remove (S1, '9');
Assertion (not Sets.Is_Subset (S2, S1),
"** P39: Sets are subsets");
Assertion (not Sets.Is_Proper_Subset (S2, S1),
"** P40: Sets are proper subsets");
Sets.Intersection (S1, S2);
Assertion (Sets.Extent (S1) = 2, "** P41: Set extent is not correct");
Assertion (Sets.Is_Member (S1, '7'),
"** P42: Set membership is not correct");
Assertion (Sets.Is_Member (S1, '8'),
"** P43: Set membership is not correct");
Sets.Add (S1, '1');
Sets.Add (S1, '2');
Sets.Add (S1, '3');
Sets.Difference (S1, S2);
Assertion (Sets.Extent (S1) = 3, "** P44: Set extent is not correct");
Assertion (Sets.Is_Member (S1, '1'),
"** P45: Set membership is not correct");
Assertion (Sets.Is_Member (S1, '2'),
"** P46: Set membership is not correct");
Assertion (Sets.Is_Member (S1, '3'),
"** P47: Set membership is not correct");
Sets.Remove (S1, '2');
Sets.Remove (S1, '3');
Sets.Add (S1, '3', Added => Status);
if not Status then
Put_Line ("** P48: Set add is not correct");
end if;
Sets.Add (S1, '3', Added => Status);
if Status then
Put_Line ("** P49: Set add is not correct");
end if;
begin
Sets.Remove (S1, '3');
exception
when others =>
Put_Line ("** P50: Set remove is not correct");
end;
begin
Sets.Remove (S1, '3');
Put_Line ("** P51: Set remove is not correct");
exception
when BC.Not_Found => null;
when others => Put_Line ("** P51: Set remove is not correct");
end;
Sets.Add (S1, 'z', Added => Status);
end Test;
procedure Test_Active_Iterator (S : in out Sets.Abstract_Set'Class) is
use Containers; use Sets; use SB;
Iter : Containers.Iterator'Class := New_Iterator (S);
Dummy : Boolean;
begin
Iteration_Check.Reset;
while not Containers.Is_Done (Iter) loop
Process (Current_Item (Iter), Dummy);
Containers.Next (Iter);
end loop;
Iteration_Check.Check ("1z", "I01: active iterator");
end Test_Active_Iterator;
procedure Process (Item : Character; OK : out Boolean) is
begin
Iteration_Check.Register (Item);
OK := True;
end Process;
procedure Process_Modifiable (Item : in out Character; OK : out Boolean) is
begin
Iteration_Check.Register (Item);
OK := True;
end Process_Modifiable;
procedure Test_Passive_Iterator (S : in out Containers.Container'Class) is
procedure Visitor is new Containers.Visit (Process);
Iter : Containers.Iterator'Class := Containers.New_Iterator (S);
begin
Iteration_Check.Reset;
Visitor (Using => Iter);
Iteration_Check.Check ("1z", "I02: passive iterator");
end Test_Passive_Iterator;
procedure Test_Passive_Modifying_Iterator
(S : in out Containers.Container'Class) is
procedure Modifier is new Containers.Modify (Process_Modifiable);
Iter : Containers.Iterator'Class := Containers.New_Iterator (S);
begin
Iteration_Check.Reset;
Modifier (Using => Iter);
Iteration_Check.Check ("1z", "I03: passive modifying iterator");
end Test_Passive_Modifying_Iterator;
Set_B_Pu1, Set_B_Pu2 : SB.Set;
Set_D_Pu1, Set_D_Pu2 : SD.Set;
Set_U_Pu1, Set_U_Pu2 : SU.Set;
Set_UM_Pu1, Set_UM_Pu2 : SUM.Set;
begin
Put_Line ("Starting set tests");
Put_Line ("...Bounded Set");
Test (Set_B_Pu1, Set_B_Pu2);
Put_Line ("...Dynamic Set");
SD.Preallocate (Set_D_Pu1, 50);
Test (Set_D_Pu1, Set_D_Pu2);
Put_Line ("...Unbounded Set");
Test (Set_U_Pu1, Set_U_Pu2);
Put_Line ("...Unmanaged Set");
Test (Set_UM_Pu1, Set_UM_Pu2);
Put_Line ("...Set Active Iterator");
Put_Line (" Bounded:");
Test_Active_Iterator (Set_B_Pu1);
Put_Line (" Dynamic:");
Test_Active_Iterator (Set_D_Pu1);
Put_Line (" Unbounded:");
Test_Active_Iterator (Set_U_Pu1);
Put_Line (" Unmanaged:");
Test_Active_Iterator (Set_UM_Pu1);
Put_Line ("...Set Passive Iterator");
Put_Line (" Bounded:");
Test_Passive_Iterator (Set_B_Pu1);
Test_Passive_Modifying_Iterator (Set_B_Pu1);
Put_Line (" Dynamic:");
Test_Passive_Iterator (Set_D_Pu1);
Test_Passive_Modifying_Iterator (Set_D_Pu1);
Put_Line (" Unbounded:");
Test_Passive_Iterator (Set_U_Pu1);
Test_Passive_Modifying_Iterator (Set_U_Pu1);
Put_Line (" Unmanaged:");
Test_Passive_Iterator (Set_UM_Pu1);
Test_Passive_Modifying_Iterator (Set_UM_Pu1);
Assertion (SB.Is_Member (Set_B_Pu1, '1'),
"** M01: Set membership is not correct");
Assertion (SB.Extent (Set_B_Pu2) = 3, "** M02: Set extent is not correct");
Assertion (SD.Is_Member (Set_D_Pu1, '1'),
"** M05: Set membership is not correct");
Assertion (SD.Extent (Set_D_Pu2) = 3, "** M06: Set extent is not correct");
Assertion (SU.Is_Member (Set_U_Pu1, '1'),
"** M09: Set membership is not correct");
Assertion (SU.Is_Member (Set_U_Pu1, 'z'),
"** M10: Set membership is not correct");
Assertion (SU.Extent (Set_U_Pu2) = 3, "** M10: Set extent is not correct");
Assertion (SB.Available (Set_B_Pu1) = 98,
"** M13: Available space is not correct");
Assertion (SB.Available (Set_B_Pu2) = 97,
"** M14: Available space is not correct");
Put_Line ("Completed set tests");
Assertions.Report;
exception
when E : others =>
Put_Line (" EXCEPTION "
& Ada.Exceptions.Exception_Name (E)
& " OCCURRED.");
end Set_Test;
syntax highlighted by Code2HTML, v. 0.9.1