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