7 use File::Spec::Functions;
9 use Test::More tests => 69;
14 use lib catdir($FindBin::Bin, 'lib');
16 ## ----------------------------------------------------------------------------
17 ## These are all tests which are derived from the Tree::Binary test suite
18 ## ----------------------------------------------------------------------------
20 ok(!Class::MOP::is_class_loaded('BinaryTree'), '... the binary tree class is not loaded');
23 Class::MOP::load_class('BinaryTree');
24 } '... loaded the BinaryTree class without dying';
26 ok(Class::MOP::is_class_loaded('BinaryTree'), '... the binary tree class is now loaded');
28 ## ----------------------------------------------------------------------------
29 ## t/10_Tree_Binary_test.t
31 can_ok("BinaryTree", 'new');
32 can_ok("BinaryTree", 'setLeft');
33 can_ok("BinaryTree", 'setRight');
35 my $btree = BinaryTree->new("/")
54 isa_ok($btree, 'BinaryTree');
56 ## informational methods
58 can_ok($btree, 'isRoot');
59 ok($btree->isRoot(), '... this is the root');
61 can_ok($btree, 'isLeaf');
62 ok(!$btree->isLeaf(), '... this is not a leaf node');
63 ok($btree->getLeft()->getLeft()->isLeaf(), '... this is a leaf node');
65 can_ok($btree, 'hasLeft');
66 ok($btree->hasLeft(), '... this has a left node');
68 can_ok($btree, 'hasRight');
69 ok($btree->hasRight(), '... this has a right node');
73 can_ok($btree, 'getUID');
76 my $UID = $btree->getUID();
77 is(("$btree" =~ /\((.*?)\)$/)[0], $UID, '... our UID is derived from the stringified object');
80 can_ok($btree, 'getNodeValue');
81 is($btree->getNodeValue(), '/', '... got what we expected');
84 can_ok($btree, 'getLeft');
85 my $left = $btree->getLeft();
87 isa_ok($left, 'BinaryTree');
89 is($left->getNodeValue(), '+', '... got what we expected');
91 can_ok($left, 'getParent');
93 my $parent = $left->getParent();
94 isa_ok($parent, 'BinaryTree');
96 is($parent, $btree, '.. got what we expected');
100 can_ok($btree, 'getRight');
101 my $right = $btree->getRight();
103 isa_ok($right, 'BinaryTree');
105 is($right->getNodeValue(), '*', '... got what we expected');
107 can_ok($right, 'getParent');
109 my $parent = $right->getParent();
110 isa_ok($parent, 'BinaryTree');
112 is($parent, $btree, '.. got what we expected');
117 can_ok($btree, 'setUID');
118 $btree->setUID("Our UID for this tree");
120 is($btree->getUID(), 'Our UID for this tree', '... our UID is not what we expected');
122 can_ok($btree, 'setNodeValue');
123 $btree->setNodeValue('*');
125 is($btree->getNodeValue(), '*', '... got what we expected');
129 can_ok($btree, 'removeLeft');
130 my $left = $btree->removeLeft();
131 isa_ok($left, 'BinaryTree');
133 ok(!$btree->hasLeft(), '... we dont have a left node anymore');
134 ok(!$btree->isLeaf(), '... and we are not a leaf node');
136 $btree->setLeft($left);
138 ok($btree->hasLeft(), '... we have our left node again');
139 is($btree->getLeft(), $left, '... and it is what we told it to be');
144 my $left_leaf = $btree->getLeft()->removeLeft();
145 isa_ok($left_leaf, 'BinaryTree');
147 ok($left_leaf->isLeaf(), '... our left leaf is a leaf');
149 ok(!$btree->getLeft()->hasLeft(), '... we dont have a left leaf node anymore');
151 $btree->getLeft()->setLeft($left_leaf);
153 ok($btree->getLeft()->hasLeft(), '... we have our left leaf node again');
154 is($btree->getLeft()->getLeft(), $left_leaf, '... and it is what we told it to be');
158 can_ok($btree, 'removeRight');
159 my $right = $btree->removeRight();
160 isa_ok($right, 'BinaryTree');
162 ok(!$btree->hasRight(), '... we dont have a right node anymore');
163 ok(!$btree->isLeaf(), '... and we are not a leaf node');
165 $btree->setRight($right);
167 ok($btree->hasRight(), '... we have our right node again');
168 is($btree->getRight(), $right, '... and it is what we told it to be')
173 my $right_leaf = $btree->getRight()->removeRight();
174 isa_ok($right_leaf, 'BinaryTree');
176 ok($right_leaf->isLeaf(), '... our right leaf is a leaf');
178 ok(!$btree->getRight()->hasRight(), '... we dont have a right leaf node anymore');
180 $btree->getRight()->setRight($right_leaf);
182 ok($btree->getRight()->hasRight(), '... we have our right leaf node again');
183 is($btree->getRight()->getRight(), $right_leaf, '... and it is what we told it to be');
186 # some of the recursive informational methods
190 my $btree = BinaryTree->new("o")
202 ->setRight(BinaryTree->new("o"))
223 ->setRight(BinaryTree->new("o"))
226 isa_ok($btree, 'BinaryTree');
228 can_ok($btree, 'size');
229 cmp_ok($btree->size(), '==', 14, '... we have 14 nodes in the tree');
231 can_ok($btree, 'height');
232 cmp_ok($btree->height(), '==', 6, '... the tree is 6 nodes tall');
236 ## ----------------------------------------------------------------------------
237 ## t/13_Tree_Binary_mirror_test.t
239 sub inOrderTraverse {
242 my $_inOrderTraverse = sub {
243 my ($tree, $traversal_function) = @_;
244 $traversal_function->($tree->getLeft(), $traversal_function) if $tree->hasLeft();
245 push @results => $tree->getNodeValue();
246 $traversal_function->($tree->getRight(), $traversal_function) if $tree->hasRight();
248 $_inOrderTraverse->($tree, $_inOrderTraverse);
252 # test it on a simple well balanaced tree
254 my $btree = BinaryTree->new(4)
273 isa_ok($btree, 'BinaryTree');
276 [ inOrderTraverse($btree) ],
278 '... check that our tree starts out correctly');
280 can_ok($btree, 'mirror');
284 [ inOrderTraverse($btree) ],
286 '... check that our tree ends up correctly');
289 # test is on a more chaotic tree
291 my $btree = BinaryTree->new(4)
322 isa_ok($btree, 'BinaryTree');
324 my @results = inOrderTraverse($btree);
329 [ inOrderTraverse($btree) ],
330 [ reverse(@results) ],
331 '... this should be the reverse of the original');