fix t/082_get_code_info.t for bleadperl
[gitmo/Class-MOP.git] / t / 100_BinaryTree_test.t
CommitLineData
c50c603e 1use strict;
2use warnings;
3
448b6e55 4use FindBin;
5use File::Spec::Functions;
6
efd3d14c 7use Test::More tests => 69;
448b6e55 8use Test::Exception;
c50c603e 9
efd3d14c 10use Class::MOP;
c50c603e 11
448b6e55 12use lib catdir($FindBin::Bin, 'lib');
13
c50c603e 14## ----------------------------------------------------------------------------
15## These are all tests which are derived from the Tree::Binary test suite
16## ----------------------------------------------------------------------------
17
448b6e55 18ok(!Class::MOP::is_class_loaded('BinaryTree'), '... the binary tree class is not loaded');
19
20lives_ok {
21 Class::MOP::load_class('BinaryTree');
22} '... loaded the BinaryTree class without dying';
23
24ok(Class::MOP::is_class_loaded('BinaryTree'), '... the binary tree class is now loaded');
25
c50c603e 26## ----------------------------------------------------------------------------
27## t/10_Tree_Binary_test.t
28
29can_ok("BinaryTree", 'new');
30can_ok("BinaryTree", 'setLeft');
31can_ok("BinaryTree", 'setRight');
32
33my $btree = BinaryTree->new("/")
34 ->setLeft(
35 BinaryTree->new("+")
36 ->setLeft(
37 BinaryTree->new("2")
38 )
39 ->setRight(
40 BinaryTree->new("2")
41 )
42 )
43 ->setRight(
44 BinaryTree->new("*")
45 ->setLeft(
46 BinaryTree->new("4")
47 )
48 ->setRight(
49 BinaryTree->new("5")
50 )
51 );
52isa_ok($btree, 'BinaryTree');
53
54## informational methods
55
56can_ok($btree, 'isRoot');
57ok($btree->isRoot(), '... this is the root');
58
59can_ok($btree, 'isLeaf');
60ok(!$btree->isLeaf(), '... this is not a leaf node');
61ok($btree->getLeft()->getLeft()->isLeaf(), '... this is a leaf node');
62
63can_ok($btree, 'hasLeft');
64ok($btree->hasLeft(), '... this has a left node');
65
66can_ok($btree, 'hasRight');
67ok($btree->hasRight(), '... this has a right node');
68
69## accessors
70
71can_ok($btree, 'getUID');
72
73{
74 my $UID = $btree->getUID();
8d2d4c67 75 is(("$btree" =~ /\((.*?)\)$/)[0], $UID, '... our UID is derived from the stringified object');
c50c603e 76}
77
78can_ok($btree, 'getNodeValue');
79is($btree->getNodeValue(), '/', '... got what we expected');
80
81{
82 can_ok($btree, 'getLeft');
83 my $left = $btree->getLeft();
8d2d4c67 84
c50c603e 85 isa_ok($left, 'BinaryTree');
8d2d4c67 86
c50c603e 87 is($left->getNodeValue(), '+', '... got what we expected');
8d2d4c67 88
89 can_ok($left, 'getParent');
90
c50c603e 91 my $parent = $left->getParent();
92 isa_ok($parent, 'BinaryTree');
8d2d4c67 93
94 is($parent, $btree, '.. got what we expected');
c50c603e 95}
96
97{
98 can_ok($btree, 'getRight');
99 my $right = $btree->getRight();
8d2d4c67 100
c50c603e 101 isa_ok($right, 'BinaryTree');
8d2d4c67 102
c50c603e 103 is($right->getNodeValue(), '*', '... got what we expected');
104
105 can_ok($right, 'getParent');
8d2d4c67 106
c50c603e 107 my $parent = $right->getParent();
108 isa_ok($parent, 'BinaryTree');
8d2d4c67 109
110 is($parent, $btree, '.. got what we expected');
c50c603e 111}
112
113## mutators
114
115can_ok($btree, 'setUID');
116$btree->setUID("Our UID for this tree");
117
118is($btree->getUID(), 'Our UID for this tree', '... our UID is not what we expected');
119
120can_ok($btree, 'setNodeValue');
121$btree->setNodeValue('*');
122
123is($btree->getNodeValue(), '*', '... got what we expected');
124
125
126{
127 can_ok($btree, 'removeLeft');
128 my $left = $btree->removeLeft();
129 isa_ok($left, 'BinaryTree');
8d2d4c67 130
c50c603e 131 ok(!$btree->hasLeft(), '... we dont have a left node anymore');
132 ok(!$btree->isLeaf(), '... and we are not a leaf node');
8d2d4c67 133
c50c603e 134 $btree->setLeft($left);
8d2d4c67 135
136 ok($btree->hasLeft(), '... we have our left node again');
c50c603e 137 is($btree->getLeft(), $left, '... and it is what we told it to be');
138}
139
140{
141 # remove left leaf
142 my $left_leaf = $btree->getLeft()->removeLeft();
143 isa_ok($left_leaf, 'BinaryTree');
8d2d4c67 144
c50c603e 145 ok($left_leaf->isLeaf(), '... our left leaf is a leaf');
8d2d4c67 146
c50c603e 147 ok(!$btree->getLeft()->hasLeft(), '... we dont have a left leaf node anymore');
8d2d4c67 148
c50c603e 149 $btree->getLeft()->setLeft($left_leaf);
8d2d4c67 150
151 ok($btree->getLeft()->hasLeft(), '... we have our left leaf node again');
c50c603e 152 is($btree->getLeft()->getLeft(), $left_leaf, '... and it is what we told it to be');
153}
154
155{
156 can_ok($btree, 'removeRight');
157 my $right = $btree->removeRight();
158 isa_ok($right, 'BinaryTree');
8d2d4c67 159
c50c603e 160 ok(!$btree->hasRight(), '... we dont have a right node anymore');
8d2d4c67 161 ok(!$btree->isLeaf(), '... and we are not a leaf node');
162
c50c603e 163 $btree->setRight($right);
8d2d4c67 164
165 ok($btree->hasRight(), '... we have our right node again');
166 is($btree->getRight(), $right, '... and it is what we told it to be')
c50c603e 167}
168
169{
170 # remove right leaf
171 my $right_leaf = $btree->getRight()->removeRight();
172 isa_ok($right_leaf, 'BinaryTree');
8d2d4c67 173
c50c603e 174 ok($right_leaf->isLeaf(), '... our right leaf is a leaf');
8d2d4c67 175
c50c603e 176 ok(!$btree->getRight()->hasRight(), '... we dont have a right leaf node anymore');
8d2d4c67 177
c50c603e 178 $btree->getRight()->setRight($right_leaf);
8d2d4c67 179
180 ok($btree->getRight()->hasRight(), '... we have our right leaf node again');
c50c603e 181 is($btree->getRight()->getRight(), $right_leaf, '... and it is what we told it to be');
182}
183
184# some of the recursive informational methods
185
186{
187
188 my $btree = BinaryTree->new("o")
189 ->setLeft(
190 BinaryTree->new("o")
191 ->setLeft(
192 BinaryTree->new("o")
193 )
194 ->setRight(
195 BinaryTree->new("o")
196 ->setLeft(
197 BinaryTree->new("o")
198 ->setLeft(
199 BinaryTree->new("o")
200 ->setRight(BinaryTree->new("o"))
201 )
202 )
203 )
204 )
205 ->setRight(
206 BinaryTree->new("o")
207 ->setLeft(
208 BinaryTree->new("o")
209 ->setRight(
210 BinaryTree->new("o")
211 ->setLeft(
212 BinaryTree->new("o")
213 )
214 ->setRight(
215 BinaryTree->new("o")
216 )
217 )
218 )
219 ->setRight(
220 BinaryTree->new("o")
221 ->setRight(BinaryTree->new("o"))
222 )
223 );
224 isa_ok($btree, 'BinaryTree');
8d2d4c67 225
c50c603e 226 can_ok($btree, 'size');
227 cmp_ok($btree->size(), '==', 14, '... we have 14 nodes in the tree');
8d2d4c67 228
c50c603e 229 can_ok($btree, 'height');
230 cmp_ok($btree->height(), '==', 6, '... the tree is 6 nodes tall');
231
232}
233
234## ----------------------------------------------------------------------------
235## t/13_Tree_Binary_mirror_test.t
236
237sub inOrderTraverse {
238 my $tree = shift;
239 my @results;
240 my $_inOrderTraverse = sub {
241 my ($tree, $traversal_function) = @_;
8d2d4c67 242 $traversal_function->($tree->getLeft(), $traversal_function) if $tree->hasLeft();
243 push @results => $tree->getNodeValue();
c50c603e 244 $traversal_function->($tree->getRight(), $traversal_function) if $tree->hasRight();
245 };
246 $_inOrderTraverse->($tree, $_inOrderTraverse);
247 @results;
248}
249
250# test it on a simple well balanaced tree
251{
252 my $btree = BinaryTree->new(4)
253 ->setLeft(
254 BinaryTree->new(2)
255 ->setLeft(
8d2d4c67 256 BinaryTree->new(1)
c50c603e 257 )
258 ->setRight(
259 BinaryTree->new(3)
260 )
261 )
262 ->setRight(
263 BinaryTree->new(6)
264 ->setLeft(
8d2d4c67 265 BinaryTree->new(5)
c50c603e 266 )
267 ->setRight(
268 BinaryTree->new(7)
269 )
270 );
271 isa_ok($btree, 'BinaryTree');
8d2d4c67 272
c50c603e 273 is_deeply(
274 [ inOrderTraverse($btree) ],
275 [ 1 .. 7 ],
276 '... check that our tree starts out correctly');
8d2d4c67 277
c50c603e 278 can_ok($btree, 'mirror');
279 $btree->mirror();
8d2d4c67 280
c50c603e 281 is_deeply(
282 [ inOrderTraverse($btree) ],
283 [ reverse(1 .. 7) ],
284 '... check that our tree ends up correctly');
285}
286
287# test is on a more chaotic tree
288{
289 my $btree = BinaryTree->new(4)
290 ->setLeft(
291 BinaryTree->new(20)
292 ->setLeft(
293 BinaryTree->new(1)
294 ->setRight(
8d2d4c67 295 BinaryTree->new(10)
c50c603e 296 ->setLeft(
8d2d4c67 297 BinaryTree->new(5)
298 )
c50c603e 299 )
300 )
301 ->setRight(
302 BinaryTree->new(3)
303 )
304 )
305 ->setRight(
306 BinaryTree->new(6)
307 ->setLeft(
8d2d4c67 308 BinaryTree->new(5)
c50c603e 309 ->setRight(
310 BinaryTree->new(7)
311 ->setLeft(
312 BinaryTree->new(90)
8d2d4c67 313 )
c50c603e 314 ->setRight(
315 BinaryTree->new(91)
8d2d4c67 316 )
317 )
c50c603e 318 )
319 );
320 isa_ok($btree, 'BinaryTree');
8d2d4c67 321
c50c603e 322 my @results = inOrderTraverse($btree);
8d2d4c67 323
c50c603e 324 $btree->mirror();
8d2d4c67 325
c50c603e 326 is_deeply(
327 [ inOrderTraverse($btree) ],
328 [ reverse(@results) ],
329 '... this should be the reverse of the original');
330}
331