5 use File::Spec::Functions;
12 use lib catdir($FindBin::Bin, 'lib');
14 ## ----------------------------------------------------------------------------
15 ## These are all tests which are derived from the Tree::Binary test suite
16 ## ----------------------------------------------------------------------------
18 ok(!Class::MOP::is_class_loaded('BinaryTree'), '... the binary tree class is not loaded');
21 Class::MOP::load_class('BinaryTree');
22 }, undef, '... loaded the BinaryTree class without dying' );
24 ok(Class::MOP::is_class_loaded('BinaryTree'), '... the binary tree class is now loaded');
26 ## ----------------------------------------------------------------------------
27 ## t/10_Tree_Binary_test.t
29 can_ok("BinaryTree", 'new');
30 can_ok("BinaryTree", 'setLeft');
31 can_ok("BinaryTree", 'setRight');
33 my $btree = BinaryTree->new("/")
52 isa_ok($btree, 'BinaryTree');
54 ## informational methods
56 can_ok($btree, 'isRoot');
57 ok($btree->isRoot(), '... this is the root');
59 can_ok($btree, 'isLeaf');
60 ok(!$btree->isLeaf(), '... this is not a leaf node');
61 ok($btree->getLeft()->getLeft()->isLeaf(), '... this is a leaf node');
63 can_ok($btree, 'hasLeft');
64 ok($btree->hasLeft(), '... this has a left node');
66 can_ok($btree, 'hasRight');
67 ok($btree->hasRight(), '... this has a right node');
71 can_ok($btree, 'getUID');
74 my $UID = $btree->getUID();
75 is(("$btree" =~ /\((.*?)\)$/)[0], $UID, '... our UID is derived from the stringified object');
78 can_ok($btree, 'getNodeValue');
79 is($btree->getNodeValue(), '/', '... got what we expected');
82 can_ok($btree, 'getLeft');
83 my $left = $btree->getLeft();
85 isa_ok($left, 'BinaryTree');
87 is($left->getNodeValue(), '+', '... got what we expected');
89 can_ok($left, 'getParent');
91 my $parent = $left->getParent();
92 isa_ok($parent, 'BinaryTree');
94 is($parent, $btree, '.. got what we expected');
98 can_ok($btree, 'getRight');
99 my $right = $btree->getRight();
101 isa_ok($right, 'BinaryTree');
103 is($right->getNodeValue(), '*', '... got what we expected');
105 can_ok($right, 'getParent');
107 my $parent = $right->getParent();
108 isa_ok($parent, 'BinaryTree');
110 is($parent, $btree, '.. got what we expected');
115 can_ok($btree, 'setUID');
116 $btree->setUID("Our UID for this tree");
118 is($btree->getUID(), 'Our UID for this tree', '... our UID is not what we expected');
120 can_ok($btree, 'setNodeValue');
121 $btree->setNodeValue('*');
123 is($btree->getNodeValue(), '*', '... got what we expected');
127 can_ok($btree, 'removeLeft');
128 my $left = $btree->removeLeft();
129 isa_ok($left, 'BinaryTree');
131 ok(!$btree->hasLeft(), '... we dont have a left node anymore');
132 ok(!$btree->isLeaf(), '... and we are not a leaf node');
134 $btree->setLeft($left);
136 ok($btree->hasLeft(), '... we have our left node again');
137 is($btree->getLeft(), $left, '... and it is what we told it to be');
142 my $left_leaf = $btree->getLeft()->removeLeft();
143 isa_ok($left_leaf, 'BinaryTree');
145 ok($left_leaf->isLeaf(), '... our left leaf is a leaf');
147 ok(!$btree->getLeft()->hasLeft(), '... we dont have a left leaf node anymore');
149 $btree->getLeft()->setLeft($left_leaf);
151 ok($btree->getLeft()->hasLeft(), '... we have our left leaf node again');
152 is($btree->getLeft()->getLeft(), $left_leaf, '... and it is what we told it to be');
156 can_ok($btree, 'removeRight');
157 my $right = $btree->removeRight();
158 isa_ok($right, 'BinaryTree');
160 ok(!$btree->hasRight(), '... we dont have a right node anymore');
161 ok(!$btree->isLeaf(), '... and we are not a leaf node');
163 $btree->setRight($right);
165 ok($btree->hasRight(), '... we have our right node again');
166 is($btree->getRight(), $right, '... and it is what we told it to be')
171 my $right_leaf = $btree->getRight()->removeRight();
172 isa_ok($right_leaf, 'BinaryTree');
174 ok($right_leaf->isLeaf(), '... our right leaf is a leaf');
176 ok(!$btree->getRight()->hasRight(), '... we dont have a right leaf node anymore');
178 $btree->getRight()->setRight($right_leaf);
180 ok($btree->getRight()->hasRight(), '... we have our right leaf node again');
181 is($btree->getRight()->getRight(), $right_leaf, '... and it is what we told it to be');
184 # some of the recursive informational methods
188 my $btree = BinaryTree->new("o")
200 ->setRight(BinaryTree->new("o"))
221 ->setRight(BinaryTree->new("o"))
224 isa_ok($btree, 'BinaryTree');
226 can_ok($btree, 'size');
227 cmp_ok($btree->size(), '==', 14, '... we have 14 nodes in the tree');
229 can_ok($btree, 'height');
230 cmp_ok($btree->height(), '==', 6, '... the tree is 6 nodes tall');
234 ## ----------------------------------------------------------------------------
235 ## t/13_Tree_Binary_mirror_test.t
237 sub inOrderTraverse {
240 my $_inOrderTraverse = sub {
241 my ($tree, $traversal_function) = @_;
242 $traversal_function->($tree->getLeft(), $traversal_function) if $tree->hasLeft();
243 push @results => $tree->getNodeValue();
244 $traversal_function->($tree->getRight(), $traversal_function) if $tree->hasRight();
246 $_inOrderTraverse->($tree, $_inOrderTraverse);
250 # test it on a simple well balanaced tree
252 my $btree = BinaryTree->new(4)
271 isa_ok($btree, 'BinaryTree');
274 [ inOrderTraverse($btree) ],
276 '... check that our tree starts out correctly');
278 can_ok($btree, 'mirror');
282 [ inOrderTraverse($btree) ],
284 '... check that our tree ends up correctly');
287 # test is on a more chaotic tree
289 my $btree = BinaryTree->new(4)
320 isa_ok($btree, 'BinaryTree');
322 my @results = inOrderTraverse($btree);
327 [ inOrderTraverse($btree) ],
328 [ reverse(@results) ],
329 '... this should be the reverse of the original');