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