-- Copyright 1994 Grady Booch
-- Copyright 1994-1997 David Weller
-- 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: tree_test.adb,v 1.7.2.1 2002/12/29 17:21:25 simon Exp $
with Ada.Exceptions;
with Ada.Text_IO;
with BC.Containers.Trees.Binary.In_Order;
with BC.Containers.Trees.Binary.Pre_Order;
with BC.Containers.Trees.Binary.Post_Order;
with BC.Containers.Trees.Multiway.Pre_Order;
with BC.Containers.Trees.Multiway.Post_Order;
with Tree_Test_Support;
procedure Tree_Test is
use Ada.Text_IO;
use Tree_Test_Support;
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;
-- I used this while trying to figure out my booboos. An example
-- (not particularly good) of how to approach tree traversal,
-- using the functional interfaces Left_Child, Right_Child rather
-- than the procedural ones.
procedure Print_Tree (T : TB.Binary_Tree;
Message : String := "";
Depth : Natural := 0);
procedure Print_Tree (T : TB.Binary_Tree;
Message : String := "";
Depth : Natural := 0) is
use TB;
procedure Indent (To : Natural := Depth);
procedure Indent (To : Natural := Depth) is
begin
for N in 1 .. Integer (To) loop
Put (" ");
end loop;
end Indent;
begin
if Depth = 0 then
Put ("Binary tree: " & Message & " ");
end if;
if Is_Null (T) then
Put_Line ("(null)");
else
if Is_Root (T) then
Put ("(root) ");
end if;
Put_Line (":= " & Item_At (T));
if (Has_Children (T)) then
Indent;
Put ("L ");
Print_Tree (Left_Child (T), Depth => Depth + 1);
Indent;
Put ("R ");
Print_Tree (Right_Child (T), Depth => Depth + 1);
end if;
end if;
end Print_Tree;
procedure Test_Primitive (T1, T2 : in out TB.Binary_Tree);
procedure Test_Primitive (T1, T2 : in out TB.Binary_Tree) is
use TB;
Tt1, Tt2, Tt3 : Binary_Tree;
begin
Clear (T1);
Assertion (Is_Null (T1), "** B01: Tree is not initially null");
Assertion (not Is_Shared (T1), "** B02: Tree is initially shared");
Insert (T1, '1', Left);
Insert (T1, '2', Right);
Insert (T1, '3', Left);
Insert (T1, '4', Right);
Assertion (not Is_Null (T1), "** B03: Tree is empty");
Assertion (Item_At (T1) = '4', "** B04: Tree item is not correct");
Assertion (not Is_Shared (T1), "** B05: Tree is shared");
Right_Child (T1);
Assertion (Item_At (T1) = '3', "** B06: Tree item is not correct");
Left_Child (T1);
Assertion (Item_At (T1) = '2', "** B07: Tree item is not correct");
Right_Child (T1);
Assertion (Item_At (T1) = '1', "** B08: Tree item is not correct");
Left_Child (T1);
Assertion (Is_Null (T1), "** B09: Tree is not empty");
Append (T1, '4', Left, Left);
Append (T1, '1', Left, Left);
Append (T1, '2', Left, Left);
Append (T1, '3', Right, Left);
Tt1 := T1;
Tt2 := T1;
Clear (Tt1);
-- I know the next test number is out-of-order; this is a copy
-- of the C++ test
Assertion (Item_At (T1) = '4', "** B09: Tree item is not correct");
Child (T1, Left);
Assertion (Item_At (T1) = '3', "** B10: Tree item is not correct");
Child (T1, Right);
Assertion (Item_At (T1) = '2', "** B11: Tree item is not correct");
Child (T1, Left);
Assertion (Item_At (T1) = '1', "** B12: Tree item is not correct");
Child (T1, Right);
Assertion (Is_Null (T1), "** B13: Tree is not empty");
Assertion (Is_Null (Tt1), "** B14: Tree is not empty");
Assertion (not Is_Null (Tt2), "** B15: Tree is empty");
T2 := Tt2;
Share (Tt3, T2, Left);
Share (Tt3, Tt3, Right);
Share (Tt3, Tt3, Left);
Assertion (T2 = Tt2, "** B16: Trees are not equal");
Assertion (T2 /= Tt3, "** B17: Trees are equal");
Assertion (Item_At (T2) = '4', "** B18: Tree item is not correct");
Assertion (Item_At (Tt3) = '1', "** B19: Tree item is not correct");
Assertion (Has_Children (T2), "** B20: Tree has no children");
Assertion (not Has_Children (Tt3), "** B21: Tree has children");
Assertion (Is_Root (T2), "** B22: Tree is not root");
Assertion (not Is_Root (Tt3), "** B23: Tree is root");
Clear (Tt2);
T1 := Tt3;
Clear (Tt3);
Parent (T1);
Assertion (Item_At (T1) = '2', "** B24: Tree item is not correct");
Parent (T1);
Assertion (Item_At (T1) = '3', "** B25: Tree item is not correct");
Parent (T1);
Assertion (Item_At (T1) = '4', "** B26: Tree item is not correct");
Set_Item (T1, '7');
Parent (T1);
Assertion (Is_Null (T1), "** B27: Tree is not null");
Assertion (Item_At (T2) = '7', "** B27: Tree item is not correct");
Insert (T1, '5', Left);
Append (T1, '6', Left, Left);
Append (T1, '7', Right, Right);
Tt2 := T1;
Assertion (Item_At (Tt2) = '5', "** B28: Tree item is not correct");
Child (Tt2, Left);
Assertion (Item_At (Tt2) = '6', "** B29: Tree item is not correct");
Remove (T1, Left);
Assertion (Item_At (Tt2) = '6', "** B30: Tree item is not correct");
Tt2 := T1;
Child (Tt2, Right);
Assertion (Item_At (Tt2) = '7', "** B31: Tree item is not correct");
Remove (T1, Right);
Assertion (Item_At (Tt2) = '7', "** B32: Tree item is not correct");
Clear (Tt2);
Append (T1, '6', Left, Left);
Append (T1, '7', Right, Right);
Swap_Child (T1, T2, Left);
Tt1 := T1;
Child (Tt1, Left);
Assertion (Item_At (T2) = '6', "** B33: Tree item is not correct");
Assertion (not Has_Children (T2), "** B34: Tree has children");
Assertion (Is_Root (T2), "** B35: Tree is not root");
Assertion (Item_At (Tt1) = '7', "** B36: Tree item is not correct");
Assertion (Has_Children (Tt1), "** B37: Tree has no children");
Assertion (not Is_Root (Tt1), "** B38: Tree is not root");
Parent (Tt1);
Assertion (T1 = Tt1, "** B39: Trees are not equal");
Child (Tt1, Left);
Assertion (Item_At (Tt1) = '7', "** B40: Tree item is not correct");
end Test_Primitive;
B_Tree_P1, B_Tree_P2 : TB.Binary_Tree;
procedure Test_Primitive (T1, T2 : in out TM.Multiway_Tree);
procedure Test_Primitive (T1, T2 : in out TM.Multiway_Tree) is
use TM;
Tt1, Tt2, Tt3 : Multiway_Tree;
begin
Assertion (Is_Null (T1), "** M01: Tree is not initially null");
Assertion (not Is_Shared (T1), "** M02: Tree is initially shared");
Insert (T1, '1');
Insert (T1, '2');
Insert (T1, '3');
Insert (T1, '4');
Assertion (not Is_Null (T1), "** M03: Tree is empty");
Assertion (Item_At (T1) = '4', "** M04: Tree item is not correct");
Assertion (not Is_Shared (T1), "** M05: Tree is shared");
Assertion (Arity (T1) = 1, "** M06: Tree arity is not correct");
Child (T1, 1);
Assertion (Item_At (T1) = '3', "** M07: Tree item is not correct");
Assertion (Arity (T1) = 1, "** M08: Tree arity is not correct");
Child (T1, 1);
Assertion (Item_At (T1) = '2', "** M09: Tree item is not correct");
Assertion (Arity (T1) = 1, "** M10: Tree arity is not correct");
Child (T1, 1);
Assertion (Item_At (T1) = '1', "** M11: Tree item is not correct");
Assertion (Arity (T1) = 0, "** M12: Tree arity is not correct");
Clear (T1);
Assertion (Is_Null (T1), "** M13: Tree is not empty");
Append (T1, '6');
Append (T1, '2');
Append (T1, '3');
Append (T1, '5');
Tt1 := T1;
Tt2 := T1;
Clear (Tt2);
Assertion (Item_At (T1) = '6', "** M14: Tree item is not correct");
Assertion (Arity (T1) = 3, "** M15: Tree arity is not correct");
Child (T1, 1);
Assertion (Item_At (T1) = '5', "** M16: Tree item is not correct");
Parent (T1);
Assertion (Item_At (T1) = '6', "** M17: Tree item is not correct");
Child (T1, 2);
Assertion (Item_At (T1) = '3', "** M18: Tree item is not correct");
Parent (T1);
Assertion (Item_At (T1) = '6', "** M19: Tree item is not correct");
Child (T1, 3);
Assertion (Item_At (T1) = '2', "** M20: Tree item is not correct");
T2 := Tt1;
Append (T2, '4', 1);
Append (T2, '1', 4);
Parent (T1);
Child (T1, 2);
Assertion (Item_At (T1) = '4', "** M21: Tree item is not correct");
Parent (T1);
Child (T1, 5);
Assertion (Item_At (T1) = '1', "** M22: Tree item is not correct");
Assertion (not Is_Root (T1), "** M23: Tree is root");
Assertion (not Has_Children (T1), "** M24: Tree has children");
Parent (T1);
Clear (T2);
Assertion (Tt1 = T1, "** M25: Trees are not equal");
Set_Item (Tt1, '7');
Assertion (Item_At (T1) = '7', "** M26: Tree item is not correct");
Clear (Tt1);
Assertion (Tt1 /= T1, "** M27: Trees are equal");
Assertion (Is_Root (T1), "** M28: Tree is root"); -- hmm
Assertion (Has_Children (T1), "** M29: Tree has children"); -- hmm
Share (T2, T1, 3);
Assertion (Item_At (T2) = '3', "** M30: Tree item is not correct");
Share (Tt1, T1, 1);
Assertion (Item_At (Tt1) = '5', "** M31: Tree item is not correct");
Share (Tt2, T1, 5);
Assertion (Item_At (Tt2) = '1', "** M32: Tree item is not correct");
Append (T2, '8');
Append (T2, '9');
Insert (Tt3, '1');
Insert (Tt3, '2');
Insert (Tt3, '3');
Swap_Child (T1, Tt3, 1);
Assertion (Tt1 = Tt3, "** M33: Trees are not equal");
Tt1 := T1;
Child (Tt1, 1);
Assertion (Item_At (Tt1) = '3', "** M34: Tree item is not correct");
Assertion (Has_Children (Tt1), "** M35: Tree has no children");
Assertion (not Has_Children (Tt3), "** M36: Tree has children");
Assertion (Item_At (Tt3) = '5', "** M37: Tree item is not correct");
Clear (Tt3);
Remove (T1, 2);
Tt3 := T1;
Child (Tt3, 2);
Assertion (Tt3 = T2, "** M38: Trees are not equal");
Clear (Tt3);
Assertion (not Is_Root (Tt1), "** M39: Tree is root");
Remove (T1, 1);
Assertion (Is_Root (Tt1), "** M40: Tree is root"); -- hmm
Assertion (Arity (T1) = 3, "** M41: Tree arity is not correct");
Tt3 := T1;
Child (Tt3, 1);
Assertion (Tt3 = T2, "** M42: Trees are not equal");
Clear (Tt3);
Clear (T1);
Assertion (Is_Null (T1), "** M43: Tree is not null");
Assertion (Is_Root (T2), "** M44: Tree is not root");
Assertion (Item_At (T2) = '3', "** M45: Tree item is not correct");
Assertion (Is_Root (Tt2), "** M46: Tree is not root");
Assertion (Item_At (Tt2) = '1', "** M47: Tree item is not correct");
end Test_Primitive;
M_Tree_P1, M_Tree_P2 : TM.Multiway_Tree;
-- procedure Print_Tree is new TA.Print (Character'Image);
procedure Test_Primitive (T : in out TA.AVL_Tree);
procedure Test_Primitive (T : in out TA.AVL_Tree) is
procedure Process (C : Character; Result : out Boolean);
procedure Process (C : Character; Result : out Boolean) is
begin
Put_Line (" Item: " & C);
Result := True;
end Process;
procedure Visit is new TA.Visit (Process);
T2 : TA.AVL_Tree;
use TA;
Result : Boolean;
begin
Assertion (Is_Null (T), "** A01: Tree is not null");
Insert (T, '4', Result);
Assertion (Result, "** A02: Tree insertion not correct");
Insert (T, '5', Result);
Assertion (Result, "** A03: Tree insertion not correct");
Insert (T, '7', Result);
Assertion (Result, "** A04: Tree insertion not correct");
Insert (T, '2', Result);
Assertion (Result, "** A05: Tree insertion not correct");
Insert (T, '1', Result);
Assertion (Result, "** A06: Tree insertion not correct");
Insert (T, '3', Result);
Assertion (Result, "** A07: Tree insertion not correct");
Insert (T, '6', Result);
Assertion (Result, "** A08: Tree insertion not correct");
Assertion (Is_Member (T, '3'), "** A09: Tree membership is not correct");
Assertion (Is_Member (T, '7'), "** A10: Tree membership is not correct");
Assertion (not Is_Member (T, 'g'),
"** A11: Tree membership is not correct");
Assertion (not Is_Null (T), "** A12: Tree is null");
Insert (T, '8', Result);
Assertion (Result, "** A13: Tree insertion not correct");
Insert (T, '9', Result);
Assertion (Result, "** A14: Tree insertion not correct");
Insert (T, 'A', Result);
Assertion (Result, "** A15: Tree insertion not correct");
Insert (T, 'B', Result);
Assertion (Result, "** A16: Tree insertion not correct");
Visit (T);
T2 := T;
Delete (T, '3', Result);
Assertion (Result, "** A17: Tree deletion is not correct");
Delete (T, 'g', Result);
Assertion (not Result, "** A18: Tree deletion is not correct");
Delete (T, '5', Result);
Assertion (Result, "** A19: Tree deletion is not correct");
Delete (T, 'A', Result);
Assertion (Result, "** A20: Tree deletion is not correct");
Delete (T, 'A', Result);
Assertion (not Result, "** A21: Tree deletion is not correct");
Delete (T, '8', Result);
Assertion (Result, "** A22: Tree deletion is not correct");
Delete (T, '4', Result);
Assertion (Result, "** A23: Tree deletion is not correct");
Delete (T, '9', Result);
Assertion (Result, "** A24: Tree deletion is not correct");
Delete (T, '2', Result);
Assertion (Result, "** A25: Tree deletion is not correct");
Delete (T, '6', Result);
Assertion (Result, "** A26: Tree deletion is not correct");
Delete (T, '1', Result);
Assertion (Result, "** A27: Tree deletion is not correct");
Delete (T, 'B', Result);
Assertion (Result, "** A28: Tree deletion is not correct");
Delete (T, '7', Result);
Assertion (Result, "** A29: Tree deletion is not correct");
Assertion (Is_Null (T), "** A30: Tree is not null");
Insert (T, '4', Result);
Insert (T, '5', Result);
Insert (T, '7', Result);
Insert (T, '2', Result);
Assertion (Extent (T) = 4, "** A31: Tree extent is not correct");
Delete (T, '4', Result);
Assertion (Result, "** A32: Tree deletion is not correct");
Clear (T);
Assertion (Extent (T) = 0, "** A33: Tree extent is not correct");
Assertion (Is_Null (T), "** A34: Tree is not null");
Assertion (T /= T2, "** A35: Trees are equal");
for C in Character'('1') .. Character'('9') loop
Insert (T, C, Result);
end loop;
for C in Character'('a') .. Character'('b') loop
Insert (T, C, Result);
end loop;
Assertion (T /= T2, "** A36: Trees are equal");
for C in Character'('A') .. Character'('B') loop
Insert (T, C, Result);
end loop;
Assertion (T /= T2, "** A37: Trees are equal");
for C in Character'('a') .. Character'('b') loop
Delete (T, C, Result);
end loop;
Assertion (T = T2, "** A38: Trees are not equal");
Delete (T2, 'B', Result);
Assertion (T /= T2, "** A39: Trees are equal");
Clear (T2);
Assertion (T /= T2, "** A40: Trees are equal");
Clear (T);
Assertion (T = T2, "** A41: Trees are not equal");
end Test_Primitive;
A_Tree_P1 : TA.AVL_Tree;
procedure Test_Binary_Iteration;
procedure Test_Binary_Iteration is
T, T1, T2 : TB.Binary_Tree;
procedure Process_Item (C : Character; Success : out Boolean);
procedure Process_Item (C : Character; Success : out Boolean) is
begin
Put_Line (" Visit " & C);
Success := True;
end Process_Item;
procedure Binary_Pre_Order is new TB.Pre_Order (Process_Item);
procedure Binary_In_Order is new TB.In_Order (Process_Item);
procedure Binary_Post_Order is new TB.Post_Order (Process_Item);
Success : Boolean;
use TB;
begin
Insert (T1, 'h', Right);
Insert (T1, 'g', Right);
Insert (T1, 'e', Right);
Insert (T2, 'f', Left);
Swap_Child (T1, T2, Left);
Insert (T, 'd', Left);
Insert (T, 'c', Left);
Insert (T, 'b', Left);
Swap_Child (T, T1, Right);
Insert (T, 'a', Left);
Insert (T1, 'k', Right);
Insert (T1, 'i', Right);
Insert (T2, 'j', Left);
Swap_Child (T1, T2, Left);
Swap_Child (T, T1, Right);
Put_Line ("...Binary Pre-Order Scan");
Binary_Pre_Order (T, Success);
Put_Line ("...Binary In-Order Scan");
Binary_In_Order (T, Success);
Put_Line ("...Binary Post-Order Scan");
Binary_Post_Order (T, Success);
end Test_Binary_Iteration;
procedure Test_Multiway_Iteration;
procedure Test_Multiway_Iteration is
T, T1, T2 : TM.Multiway_Tree;
procedure Process_Item (C : Character; Success : out Boolean);
procedure Process_Item (C : Character; Success : out Boolean) is
begin
Put_Line (" Visit " & C);
Success := True;
end Process_Item;
procedure Multiway_Pre_Order is new TM.Pre_Order (Process_Item);
procedure Multiway_Post_Order is new TM.Post_Order (Process_Item);
Success : Boolean;
use TM;
begin
Insert (T, 'd');
Insert (T, 'c');
Insert (T1, 'e');
Append (T, T1);
Clear (T1);
Insert (T1, 'f');
Append (T, T1);
Clear (T1);
Insert (T, 'b');
Insert (T1, 'g');
Append (T, T1);
Clear (T1);
Insert (T1, 'h');
Append (T, T1);
Clear (T1);
Insert (T1, 'i');
Append (T, T1);
Clear (T1);
Insert (T, 'a');
Insert (T1, 'l');
Insert (T1, 'k');
Insert (T2, 'm');
Append (T1, T2);
Clear (T2);
Insert (T1, 'j');
Insert (T2, 'n');
Append (T1, T2);
Clear (T2);
Insert (T2, 'p');
Insert (T2, 'o');
Append (T1, T2);
Clear (T2);
Append (T, T1);
Clear (T1);
Put_Line ("...Multiway Pre-Order Scan");
Multiway_Pre_Order (T, Success);
Put_Line ("...Multiway Post-Order Scan");
Multiway_Post_Order (T, Success);
end Test_Multiway_Iteration;
begin
Put_Line ("Starting Tree tests");
Put_Line ("...Binary Tree");
Test_Primitive (B_Tree_P1, B_Tree_P2);
Test_Binary_Iteration;
Print_Tree (B_Tree_P1);
Put_Line ("...Multiway Tree");
Test_Primitive (M_Tree_P1, M_Tree_P2);
Test_Multiway_Iteration;
Put_Line ("...AVL Tree");
Test_Primitive (A_Tree_P1);
Put_Line ("Completed Tree tests");
exception
when E : others =>
Put_Line (" EXCEPTION "
& Ada.Exceptions.Exception_Name (E)
& " OCCURRED.");
end Tree_Test;
syntax highlighted by Code2HTML, v. 0.9.1