-- Copyright 1994 Grady Booch
-- Copyright 1994-1997 David Weller
-- Copyright 1998-2003 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.
-- $RCSfile: queue_test.adb,v $
-- $Revision: 1.9.2.2 $
-- $Date: 2003/02/08 16:28:05 $
-- $Author: simon $
with Ada.Exceptions;
with Ada.Text_IO;
with BC;
with Queue_Test_Support;
procedure Queue_Test is
use Ada.Text_IO;
use Queue_Test_Support;
use Containers;
use Queues;
use QB;
use QD;
use QU;
use QUM;
procedure Process (C : Character; OK : out Boolean);
procedure Process (C : Character; OK : out Boolean) is
begin
Put_Line ("Item: " & C);
OK := True;
end Process;
procedure Assertion (Cond : Boolean; Message : String);
procedure Assertion (Cond : Boolean; Message : String) is
begin
if not Cond then
Put_Line (Message);
end if;
end Assertion;
procedure Test_Active_Iterator (Q : Container'Class);
procedure Test_Active_Iterator (Q : Container'Class) is
Iter : Iterator'Class := New_Iterator (Q);
Success : Boolean;
Temp : Character;
begin
while not Is_Done (Iter) loop
Temp := Current_Item (Iter);
Process (Temp, Success);
Next (Iter);
end loop;
end Test_Active_Iterator;
procedure Test_Primitive (Q1, Q2 : in out Abstract_Queue'Class);
procedure Test_Primitive (Q1, Q2 : in out Abstract_Queue'Class) is
begin
Assertion (Is_Empty (Q1), "** P01: Queue is not initially empty");
Assertion (Length (Q1) = 0,
"** P02: Queue length is not initially zero");
Append (Q1, '1');
Append (Q1, '2');
Append (Q1, '3');
Assertion (not (Is_Empty (Q1)), "** P03: Queue is empty");
Assertion ((Length (Q1) = 3), "** P04: Queue length is not correct");
Assertion ((Front (Q1) = '1'), "** P05: Queue front is not correct");
Clear (Q1);
Assertion (Is_Empty (Q1), "** P06: Queue is not empty");
Assertion ((Length (Q1) = 0), "** P07: Queue length is not zero");
Append (Q1, '4');
Append (Q1, '5');
Append (Q1, '6');
Assertion (not (Is_Empty (Q1)), "** P08: Queue is empty");
Assertion ((Length (Q1) = 3), "** P09: Queue length is not correct");
Assertion ((Front (Q1) = '4'), "** P10: Queue front is not correct");
Pop (Q1);
Pop (Q1);
Assertion (not (Is_Empty (Q1)), "** P11: Queue is empty");
Assertion ((Length (Q1) = 1), "** P12: Queue length is not correct");
Assertion ((Front (Q1) = '6'), "** P13: Queue front is not correct");
Pop (Q1);
Assertion (Is_Empty (Q1), "** P14: Queue is not empty");
Assertion ((Length (Q1) = 0), "** P15: Queue length is not zero");
Append (Q1, '7');
Append (Q1, '8');
Append (Q1, '9');
Pop (Q1);
Pop (Q1);
Assertion (not (Is_Empty (Q1)), "** P16: Queue is empty");
Assertion ((Length (Q1) = 1), "** P17: Queue length is not correct");
Assertion ((Front (Q1) = '9'), "** P18: Queue front is not correct");
Q2 := Q1;
Assertion (not (Is_Empty (Q1)), "** P19: Queue is empty");
Assertion ((Length (Q1) = 1), "** P20: Queue length is not correct");
Assertion ((Front (Q1) = '9'), "** P21: Queue front is not correct");
Assertion (not (Is_Empty (Q2)), "** P22: Queue is empty");
Assertion ((Length (Q2) = 1), "** P23: Queue length is not correct");
Assertion ((Front (Q2) = '9'), "** P24: Queue front is not correct");
Assertion ((Q1 = Q2), "** P25: Queues are not equal");
Clear (Q2);
Assertion ((not (Is_Empty (Q1))), "** P26: Queue is empty");
Assertion (Is_Empty (Q2), "** P29: Queue is not empty");
Assertion ((Length (Q1) = 1), "** P27: Queue length is not correct");
Assertion ((Front (Q1) = '9'), "** P28: Queue front is not correct");
Assertion ((Length (Q2) = 0), "** P30: Queue length is not correct");
Assertion ((Q1 /= Q2), "** P31: Queues not equal");
Append (Q2, '1');
Append (Q2, '2');
Append (Q2, '3');
Append (Q2, '4');
Assertion (Location (Q2, '1') = 1,
"** P32: Queue location is not correct");
Assertion (Location (Q2, '2') = 2,
"** P33: Queue location is not correct");
Assertion (Location (Q2, '4') = 4,
"** P34: Queue location is not correct");
Remove (Q2, 1);
Remove (Q2, 2);
Remove (Q2, 2);
Assertion ((Length (Q2) = 1), "** P35: Queue length is not correct");
Assertion ((Front (Q2) = '2'), "** P36: Queue front is not correct");
Remove (Q2, 1);
Assertion ((Length (Q2) = 0), "** P37: Queue length is not correct");
Append (Q2, 'a');
Append (Q2, 'z');
declare
procedure P (Ch : in out Character);
procedure P (Ch : in out Character) is
begin
Ch := Character'Succ (Ch);
end P;
procedure Acc is new Queues.Process_Front (P);
begin
Acc (Q2);
end;
Assertion (Length (Q2) = 2, "** P38: Queue length is not correct");
Assertion (Front (Q2) = 'b', "** P39: Queue front is not correct");
Remove (Q2, 1);
Assertion (Front (Q2) = 'z', "** P40: Queue front is not correct");
Remove (Q2, 1);
Append (Q1, 'z');
end Test_Primitive;
procedure Test_Passive_Iterator (Q : Container'Class);
procedure Test_Passive_Iterator (Q : Container'Class) is
procedure Iterate is new Visit (Apply => Process);
Iter : Iterator'Class := New_Iterator (Q);
begin
Iterate (Using => Iter);
end Test_Passive_Iterator;
procedure Test_Iterator_Deletion (Q : in out Abstract_Queue'Class);
procedure Test_Iterator_Deletion (Q : in out Abstract_Queue'Class) is
Iter : Iterator'Class := New_Iterator (Q);
Delete : Boolean;
begin
Clear (Q);
Append (Q, '1');
Append (Q, '2');
Append (Q, '3');
Append (Q, '4');
Append (Q, '5');
Append (Q, '6');
Delete := False;
Reset (Iter);
while not Is_Done (Iter) loop
if Delete then
Delete_Item_At (Iter);
Delete := False;
else
Next (Iter);
Delete := True;
end if;
end loop;
begin
Delete_Item_At (Iter);
Assertion (False, "** I01: Deletion succeeded");
exception
when BC.Not_Found => null;
when others =>
Assertion (False, "** I02: Unexpected exception");
end;
Assertion (Length (Q) = 3, "** I03: Queue length is not correct");
Assertion (Front (Q) = '1', "** I04: Queue item is not correct");
Pop (Q);
Assertion (Front (Q) = '3', "** I05: Queue item is not correct");
Pop (Q);
Assertion (Front (Q) = '5', "** I06: Queue item is not correct");
Pop (Q);
Assertion (Length (Q) = 0, "** I07: Queue length is not zero");
end Test_Iterator_Deletion;
Queue_B_P1, Queue_B_P2 : QB.Queue;
Queue_D_P1, Queue_D_P2 : QD.Queue;
Queue_U_P1, Queue_U_P2 : QU.Queue;
Queue_UM_P1, Queue_UM_P2 : QUM.Queue;
begin
Put_Line ("Starting queue tests");
Put_Line ("...Bounded Queue");
Test_Primitive (Queue_B_P1, Queue_B_P2);
Put_Line ("...Dynamic Queue");
QD.Preallocate (Queue_D_P1, 50);
Test_Primitive (Queue_D_P1, Queue_D_P2);
Put_Line ("...Unbounded Queue");
Test_Primitive (Queue_U_P1, Queue_U_P2);
Put_Line ("...Unmanaged Queue");
Test_Primitive (Queue_UM_P1, Queue_UM_P2);
Put_Line ("...Queue Active Iterator");
Put_Line (" Bounded:");
Test_Active_Iterator (Queue_B_P1);
Put_Line (" Dynamic:");
Test_Active_Iterator (Queue_D_P1);
Put_Line (" Unbounded:");
Test_Active_Iterator (Queue_U_P1);
Put_Line (" Unmanaged:");
Test_Active_Iterator (Queue_UM_P1);
Put_Line ("...Queue Passive Iterator");
Put_Line (" Bounded:");
Test_Passive_Iterator (Queue_B_P1);
Put_Line (" Dynamic:");
Test_Passive_Iterator (Queue_D_P1);
Put_Line (" Unbounded:");
Test_Passive_Iterator (Queue_U_P1);
Put_Line (" Unmanaged:");
Test_Passive_Iterator (Queue_UM_P1);
Assertion ((Front (Queue_B_P1) = '9'),
"** M01: Queue front is not correct");
Assertion ((Length (Queue_B_P2) = 0),
"** M02: Queue length is not correct");
Assertion ((Front (Queue_D_P1) = '9'),
"** M05: Queue front is not correct");
Assertion ((Length (Queue_D_P2) = 0),
"** M06: Queue length is not correct");
Assertion ((Front (Queue_U_P1) = '9'),
"** M09: Queue front is not correct");
Assertion ((Length (Queue_U_P2) = 0),
"** M10: Queue length is not correct");
Assertion (Available (Queue_B_P1) = 98,
"** M13: Available space not correct");
Assertion (Available (Queue_B_P2) = 100,
"** M14: Available space not correct");
Put_Line ("...Queue Iterator Deletion");
Put_Line (" Bounded:");
Test_Iterator_Deletion (Queue_B_P1);
Put_Line (" Dynamic:");
Test_Iterator_Deletion (Queue_D_P1);
Put_Line (" Unbounded:");
Test_Iterator_Deletion (Queue_U_P1);
Put_Line (" Unmanaged:");
Test_Iterator_Deletion (Queue_UM_P1);
Put_Line ("Completed queue tests");
exception
when E : others =>
Put_Line (" EXCEPTION "
& Ada.Exceptions.Exception_Name (E)
& " OCCURRED.");
end Queue_Test;
syntax highlighted by Code2HTML, v. 0.9.1