7 use File::Spec::Functions;
9 use Test::More tests => 70;
16 use lib catdir($FindBin::Bin, 'lib');
18 ## ----------------------------------------------------------------------------
19 ## These are all tests which are derived from the Tree::Binary test suite
20 ## ----------------------------------------------------------------------------
22 ok(!Class::MOP::is_class_loaded('BinaryTree'), '... the binary tree class is not loaded');
25 Class::MOP::load_class('BinaryTree');
26 } '... loaded the BinaryTree class without dying';
28 ok(Class::MOP::is_class_loaded('BinaryTree'), '... the binary tree class is now loaded');
30 ## ----------------------------------------------------------------------------
31 ## t/10_Tree_Binary_test.t
33 can_ok("BinaryTree", 'new');
34 can_ok("BinaryTree", 'setLeft');
35 can_ok("BinaryTree", 'setRight');
37 my $btree = BinaryTree->new("/")
56 isa_ok($btree, 'BinaryTree');
58 ## informational methods
60 can_ok($btree, 'isRoot');
61 ok($btree->isRoot(), '... this is the root');
63 can_ok($btree, 'isLeaf');
64 ok(!$btree->isLeaf(), '... this is not a leaf node');
65 ok($btree->getLeft()->getLeft()->isLeaf(), '... this is a leaf node');
67 can_ok($btree, 'hasLeft');
68 ok($btree->hasLeft(), '... this has a left node');
70 can_ok($btree, 'hasRight');
71 ok($btree->hasRight(), '... this has a right node');
75 can_ok($btree, 'getUID');
78 my $UID = $btree->getUID();
79 is(("$btree" =~ /\((.*?)\)$/)[0], $UID, '... our UID is derived from the stringified object');
82 can_ok($btree, 'getNodeValue');
83 is($btree->getNodeValue(), '/', '... got what we expected');
86 can_ok($btree, 'getLeft');
87 my $left = $btree->getLeft();
89 isa_ok($left, 'BinaryTree');
91 is($left->getNodeValue(), '+', '... got what we expected');
93 can_ok($left, 'getParent');
95 my $parent = $left->getParent();
96 isa_ok($parent, 'BinaryTree');
98 is($parent, $btree, '.. got what we expected');
102 can_ok($btree, 'getRight');
103 my $right = $btree->getRight();
105 isa_ok($right, 'BinaryTree');
107 is($right->getNodeValue(), '*', '... got what we expected');
109 can_ok($right, 'getParent');
111 my $parent = $right->getParent();
112 isa_ok($parent, 'BinaryTree');
114 is($parent, $btree, '.. got what we expected');
119 can_ok($btree, 'setUID');
120 $btree->setUID("Our UID for this tree");
122 is($btree->getUID(), 'Our UID for this tree', '... our UID is not what we expected');
124 can_ok($btree, 'setNodeValue');
125 $btree->setNodeValue('*');
127 is($btree->getNodeValue(), '*', '... got what we expected');
131 can_ok($btree, 'removeLeft');
132 my $left = $btree->removeLeft();
133 isa_ok($left, 'BinaryTree');
135 ok(!$btree->hasLeft(), '... we dont have a left node anymore');
136 ok(!$btree->isLeaf(), '... and we are not a leaf node');
138 $btree->setLeft($left);
140 ok($btree->hasLeft(), '... we have our left node again');
141 is($btree->getLeft(), $left, '... and it is what we told it to be');
146 my $left_leaf = $btree->getLeft()->removeLeft();
147 isa_ok($left_leaf, 'BinaryTree');
149 ok($left_leaf->isLeaf(), '... our left leaf is a leaf');
151 ok(!$btree->getLeft()->hasLeft(), '... we dont have a left leaf node anymore');
153 $btree->getLeft()->setLeft($left_leaf);
155 ok($btree->getLeft()->hasLeft(), '... we have our left leaf node again');
156 is($btree->getLeft()->getLeft(), $left_leaf, '... and it is what we told it to be');
160 can_ok($btree, 'removeRight');
161 my $right = $btree->removeRight();
162 isa_ok($right, 'BinaryTree');
164 ok(!$btree->hasRight(), '... we dont have a right node anymore');
165 ok(!$btree->isLeaf(), '... and we are not a leaf node');
167 $btree->setRight($right);
169 ok($btree->hasRight(), '... we have our right node again');
170 is($btree->getRight(), $right, '... and it is what we told it to be')
175 my $right_leaf = $btree->getRight()->removeRight();
176 isa_ok($right_leaf, 'BinaryTree');
178 ok($right_leaf->isLeaf(), '... our right leaf is a leaf');
180 ok(!$btree->getRight()->hasRight(), '... we dont have a right leaf node anymore');
182 $btree->getRight()->setRight($right_leaf);
184 ok($btree->getRight()->hasRight(), '... we have our right leaf node again');
185 is($btree->getRight()->getRight(), $right_leaf, '... and it is what we told it to be');
188 # some of the recursive informational methods
192 my $btree = BinaryTree->new("o")
204 ->setRight(BinaryTree->new("o"))
225 ->setRight(BinaryTree->new("o"))
228 isa_ok($btree, 'BinaryTree');
230 can_ok($btree, 'size');
231 cmp_ok($btree->size(), '==', 14, '... we have 14 nodes in the tree');
233 can_ok($btree, 'height');
234 cmp_ok($btree->height(), '==', 6, '... the tree is 6 nodes tall');
238 ## ----------------------------------------------------------------------------
239 ## t/13_Tree_Binary_mirror_test.t
241 sub inOrderTraverse {
244 my $_inOrderTraverse = sub {
245 my ($tree, $traversal_function) = @_;
246 $traversal_function->($tree->getLeft(), $traversal_function) if $tree->hasLeft();
247 push @results => $tree->getNodeValue();
248 $traversal_function->($tree->getRight(), $traversal_function) if $tree->hasRight();
250 $_inOrderTraverse->($tree, $_inOrderTraverse);
254 # test it on a simple well balanaced tree
256 my $btree = BinaryTree->new(4)
275 isa_ok($btree, 'BinaryTree');
278 [ inOrderTraverse($btree) ],
280 '... check that our tree starts out correctly');
282 can_ok($btree, 'mirror');
286 [ inOrderTraverse($btree) ],
288 '... check that our tree ends up correctly');
291 # test is on a more chaotic tree
293 my $btree = BinaryTree->new(4)
324 isa_ok($btree, 'BinaryTree');
326 my @results = inOrderTraverse($btree);
331 [ inOrderTraverse($btree) ],
332 [ reverse(@results) ],
333 '... this should be the reverse of the original');