[gitmo/Moose.git] / t / cmop / BinaryTree_test.t

use strict;
use warnings;

use FindBin;
use File::Spec::Functions;

use Test::More;
use Test::Fatal;

use Class::Load qw( is_class_loaded load_class );

use lib catdir($FindBin::Bin, 'lib');

## ----------------------------------------------------------------------------
## These are all tests which are derived from the Tree::Binary test suite
## ----------------------------------------------------------------------------

ok(!is_class_loaded('BinaryTree'), '... the binary tree class is not loaded');

is( exception {
    load_class('BinaryTree');
}, undef, '... loaded the BinaryTree class without dying' );

ok(is_class_loaded('BinaryTree'), '... the binary tree class is now loaded');

## ----------------------------------------------------------------------------
## t/10_Tree_Binary_test.t

can_ok("BinaryTree", 'new');
can_ok("BinaryTree", 'setLeft');
can_ok("BinaryTree", 'setRight');

my $btree = BinaryTree->new("/")
                        ->setLeft(
                            BinaryTree->new("+")
                                        ->setLeft(
                                            BinaryTree->new("2")
                                        )
                                        ->setRight(
                                            BinaryTree->new("2")
                                        )
                        )
                        ->setRight(
                            BinaryTree->new("*")
                                        ->setLeft(
                                            BinaryTree->new("4")
                                        )
                                        ->setRight(
                                            BinaryTree->new("5")
                                        )
                        );
isa_ok($btree, 'BinaryTree');

## informational methods

can_ok($btree, 'isRoot');
ok($btree->isRoot(), '... this is the root');

can_ok($btree, 'isLeaf');
ok(!$btree->isLeaf(), '... this is not a leaf node');
ok($btree->getLeft()->getLeft()->isLeaf(), '... this is a leaf node');

can_ok($btree, 'hasLeft');
ok($btree->hasLeft(), '... this has a left node');

can_ok($btree, 'hasRight');
ok($btree->hasRight(), '... this has a right node');

## accessors

can_ok($btree, 'getUID');

{
    my $UID = $btree->getUID();
    is(("$btree" =~ /\((.*?)\)$/)[0], $UID, '... our UID is derived from the stringified object');
}

can_ok($btree, 'getNodeValue');
is($btree->getNodeValue(), '/', '... got what we expected');

{
    can_ok($btree, 'getLeft');
    my $left = $btree->getLeft();

    isa_ok($left, 'BinaryTree');

    is($left->getNodeValue(), '+', '... got what we expected');

    can_ok($left, 'getParent');

    my $parent = $left->getParent();
    isa_ok($parent, 'BinaryTree');

    is($parent, $btree, '.. got what we expected');
}

{
    can_ok($btree, 'getRight');
    my $right = $btree->getRight();

    isa_ok($right, 'BinaryTree');

    is($right->getNodeValue(), '*', '... got what we expected');

    can_ok($right, 'getParent');

    my $parent = $right->getParent();
    isa_ok($parent, 'BinaryTree');

    is($parent, $btree, '.. got what we expected');
}

## mutators

can_ok($btree, 'setUID');
$btree->setUID("Our UID for this tree");

is($btree->getUID(), 'Our UID for this tree', '... our UID is not what we expected');

can_ok($btree, 'setNodeValue');
$btree->setNodeValue('*');

is($btree->getNodeValue(), '*', '... got what we expected');


{
    can_ok($btree, 'removeLeft');
    my $left = $btree->removeLeft();
    isa_ok($left, 'BinaryTree');

    ok(!$btree->hasLeft(), '... we dont have a left node anymore');
    ok(!$btree->isLeaf(), '... and we are not a leaf node');

    $btree->setLeft($left);

    ok($btree->hasLeft(), '... we have our left node again');
    is($btree->getLeft(), $left, '... and it is what we told it to be');
}

{
    # remove left leaf
    my $left_leaf = $btree->getLeft()->removeLeft();
    isa_ok($left_leaf, 'BinaryTree');

    ok($left_leaf->isLeaf(), '... our left leaf is a leaf');

    ok(!$btree->getLeft()->hasLeft(), '... we dont have a left leaf node anymore');

    $btree->getLeft()->setLeft($left_leaf);

    ok($btree->getLeft()->hasLeft(), '... we have our left leaf node again');
    is($btree->getLeft()->getLeft(), $left_leaf, '... and it is what we told it to be');
}

{
    can_ok($btree, 'removeRight');
    my $right = $btree->removeRight();
    isa_ok($right, 'BinaryTree');

    ok(!$btree->hasRight(), '... we dont have a right node anymore');
    ok(!$btree->isLeaf(), '... and we are not a leaf node');

    $btree->setRight($right);

    ok($btree->hasRight(), '... we have our right node again');
    is($btree->getRight(), $right, '... and it is what we told it to be')
}

{
    # remove right leaf
    my $right_leaf = $btree->getRight()->removeRight();
    isa_ok($right_leaf, 'BinaryTree');

    ok($right_leaf->isLeaf(), '... our right leaf is a leaf');

    ok(!$btree->getRight()->hasRight(), '... we dont have a right leaf node anymore');

    $btree->getRight()->setRight($right_leaf);

    ok($btree->getRight()->hasRight(), '... we have our right leaf node again');
    is($btree->getRight()->getRight(), $right_leaf, '... and it is what we told it to be');
}

# some of the recursive informational methods

{

    my $btree = BinaryTree->new("o")
                            ->setLeft(
                                BinaryTree->new("o")
                                    ->setLeft(
                                        BinaryTree->new("o")
                                    )
                                    ->setRight(
                                        BinaryTree->new("o")
                                            ->setLeft(
                                                BinaryTree->new("o")
                                                    ->setLeft(
                                                        BinaryTree->new("o")
                                                            ->setRight(BinaryTree->new("o"))
                                                    )
                                            )
                                    )
                            )
                            ->setRight(
                                BinaryTree->new("o")
                                            ->setLeft(
                                                BinaryTree->new("o")
                                                    ->setRight(
                                                        BinaryTree->new("o")
                                                            ->setLeft(
                                                                BinaryTree->new("o")
                                                            )
                                                            ->setRight(
                                                                BinaryTree->new("o")
                                                            )
                                                    )
                                            )
                                            ->setRight(
                                                BinaryTree->new("o")
                                                    ->setRight(BinaryTree->new("o"))
                                            )
                            );
    isa_ok($btree, 'BinaryTree');

    can_ok($btree, 'size');
    cmp_ok($btree->size(), '==', 14, '... we have 14 nodes in the tree');

    can_ok($btree, 'height');
    cmp_ok($btree->height(), '==', 6, '... the tree is 6 nodes tall');

}

## ----------------------------------------------------------------------------
## t/13_Tree_Binary_mirror_test.t

sub inOrderTraverse {
    my $tree = shift;
    my @results;
    my $_inOrderTraverse = sub {
        my ($tree, $traversal_function) = @_;
        $traversal_function->($tree->getLeft(), $traversal_function) if $tree->hasLeft();
        push @results => $tree->getNodeValue();
        $traversal_function->($tree->getRight(), $traversal_function) if $tree->hasRight();
    };
    $_inOrderTraverse->($tree, $_inOrderTraverse);
    @results;
}

# test it on a simple well balanaced tree
{
    my $btree = BinaryTree->new(4)
                    ->setLeft(
                        BinaryTree->new(2)
                            ->setLeft(
                                BinaryTree->new(1)
                                )
                            ->setRight(
                                BinaryTree->new(3)
                                )
                        )
                    ->setRight(
                        BinaryTree->new(6)
                            ->setLeft(
                                BinaryTree->new(5)
                                )
                            ->setRight(
                                BinaryTree->new(7)
                                )
                        );
    isa_ok($btree, 'BinaryTree');

    is_deeply(
        [ inOrderTraverse($btree) ],
        [ 1 .. 7 ],
        '... check that our tree starts out correctly');

    can_ok($btree, 'mirror');
    $btree->mirror();

    is_deeply(
        [ inOrderTraverse($btree) ],
        [ reverse(1 .. 7) ],
        '... check that our tree ends up correctly');
}

# test is on a more chaotic tree
{
    my $btree = BinaryTree->new(4)
                    ->setLeft(
                        BinaryTree->new(20)
                            ->setLeft(
                                BinaryTree->new(1)
                                        ->setRight(
                                            BinaryTree->new(10)
                                                ->setLeft(
                                                    BinaryTree->new(5)
                                                )
                                        )
                                )
                            ->setRight(
                                BinaryTree->new(3)
                                )
                        )
                    ->setRight(
                        BinaryTree->new(6)
                            ->setLeft(
                                BinaryTree->new(5)
                                    ->setRight(
                                        BinaryTree->new(7)
                                            ->setLeft(
                                                BinaryTree->new(90)
                                            )
                                            ->setRight(
                                                BinaryTree->new(91)
                                            )
                                        )
                                )
                        );
    isa_ok($btree, 'BinaryTree');

    my @results = inOrderTraverse($btree);

    $btree->mirror();

    is_deeply(
        [ inOrderTraverse($btree) ],
        [ reverse(@results) ],
        '... this should be the reverse of the original');
}

done_testing;
Commit	Line	Data
38bf2a25	1	use strict;
	2	use warnings;
	3
	4	use FindBin;
	5	use File::Spec::Functions;
	6
	7	use Test::More;
	8	use Test::Fatal;
	9
b5ae7c00	10	use Class::Load qw( is_class_loaded load_class );
38bf2a25	11
	12	use lib catdir($FindBin::Bin, 'lib');
	13
	14	## ----------------------------------------------------------------------------
	15	## These are all tests which are derived from the Tree::Binary test suite
	16	## ----------------------------------------------------------------------------
	17
b5ae7c00	18	ok(!is_class_loaded('BinaryTree'), '... the binary tree class is not loaded');
38bf2a25	19
38bf2a25	20	is( exception {
b5ae7c00	21	load_class('BinaryTree');
38bf2a25	22	}, undef, '... loaded the BinaryTree class without dying' );
38bf2a25	23
b5ae7c00	24	ok(is_class_loaded('BinaryTree'), '... the binary tree class is now loaded');
38bf2a25	25
	26	## ----------------------------------------------------------------------------
	27	## t/10_Tree_Binary_test.t
	28
	29	can_ok("BinaryTree", 'new');
	30	can_ok("BinaryTree", 'setLeft');
	31	can_ok("BinaryTree", 'setRight');
	32
	33	my $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	);
	52	isa_ok($btree, 'BinaryTree');
	53
	54	## informational methods
	55
	56	can_ok($btree, 'isRoot');
	57	ok($btree->isRoot(), '... this is the root');
	58
	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');
	62
	63	can_ok($btree, 'hasLeft');
	64	ok($btree->hasLeft(), '... this has a left node');
	65
	66	can_ok($btree, 'hasRight');
	67	ok($btree->hasRight(), '... this has a right node');
	68
	69	## accessors
	70
	71	can_ok($btree, 'getUID');
	72
	73	{
	74	my $UID = $btree->getUID();
	75	is(("$btree" =~ /\((.*?)\)$/)[0], $UID, '... our UID is derived from the stringified object');
	76	}
	77
	78	can_ok($btree, 'getNodeValue');
	79	is($btree->getNodeValue(), '/', '... got what we expected');
	80
	81	{
	82	can_ok($btree, 'getLeft');
	83	my $left = $btree->getLeft();
	84
	85	isa_ok($left, 'BinaryTree');
	86
	87	is($left->getNodeValue(), '+', '... got what we expected');
	88
89	can_ok($left, 'getParent');
90
91	my $parent = $left->getParent();
92	isa_ok($parent, 'BinaryTree');
93
94	is($parent, $btree, '.. got what we expected');
95	}
96
97	{
98	can_ok($btree, 'getRight');
99	my $right = $btree->getRight();
100
101	isa_ok($right, 'BinaryTree');
102
103	is($right->getNodeValue(), '*', '... got what we expected');
104
105	can_ok($right, 'getParent');
106
107	my $parent = $right->getParent();
108	isa_ok($parent, 'BinaryTree');
109
110	is($parent, $btree, '.. got what we expected');
111	}
112
113	## mutators
114
115	can_ok($btree, 'setUID');
116	$btree->setUID("Our UID for this tree");
117
118	is($btree->getUID(), 'Our UID for this tree', '... our UID is not what we expected');
119
120	can_ok($btree, 'setNodeValue');
121	$btree->setNodeValue('*');
122
123	is($btree->getNodeValue(), '*', '... got what we expected');
124
125
126	{
127	can_ok($btree, 'removeLeft');
128	my $left = $btree->removeLeft();
129	isa_ok($left, 'BinaryTree');
130
131	ok(!$btree->hasLeft(), '... we dont have a left node anymore');
132	ok(!$btree->isLeaf(), '... and we are not a leaf node');
133
134	$btree->setLeft($left);
135
136	ok($btree->hasLeft(), '... we have our left node again');
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');
144
145	ok($left_leaf->isLeaf(), '... our left leaf is a leaf');
146
147	ok(!$btree->getLeft()->hasLeft(), '... we dont have a left leaf node anymore');
148
149	$btree->getLeft()->setLeft($left_leaf);
150
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');
153	}
154
155	{
156	can_ok($btree, 'removeRight');
157	my $right = $btree->removeRight();
158	isa_ok($right, 'BinaryTree');
159
160	ok(!$btree->hasRight(), '... we dont have a right node anymore');
161	ok(!$btree->isLeaf(), '... and we are not a leaf node');
162
163	$btree->setRight($right);
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')
167	}
168
169	{
170	# remove right leaf
171	my $right_leaf = $btree->getRight()->removeRight();
172	isa_ok($right_leaf, 'BinaryTree');
173
174	ok($right_leaf->isLeaf(), '... our right leaf is a leaf');
175
176	ok(!$btree->getRight()->hasRight(), '... we dont have a right leaf node anymore');
177
178	$btree->getRight()->setRight($right_leaf);
179
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');
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');
225
226	can_ok($btree, 'size');
227	cmp_ok($btree->size(), '==', 14, '... we have 14 nodes in the tree');
228
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
237	sub inOrderTraverse {
238	my $tree = shift;
239	my @results;
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();
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(
256	BinaryTree->new(1)
257	)
258	->setRight(
259	BinaryTree->new(3)
260	)
261	)
262	->setRight(
263	BinaryTree->new(6)
264	->setLeft(
265	BinaryTree->new(5)
266	)
267	->setRight(
268	BinaryTree->new(7)
269	)
270	);
271	isa_ok($btree, 'BinaryTree');
272
273	is_deeply(
274	[ inOrderTraverse($btree) ],
275	[ 1 .. 7 ],
276	'... check that our tree starts out correctly');
277
278	can_ok($btree, 'mirror');
279	$btree->mirror();
280
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(
295	BinaryTree->new(10)
296	->setLeft(
297	BinaryTree->new(5)
298	)
299	)
300	)
301	->setRight(
302	BinaryTree->new(3)
303	)
304	)
305	->setRight(
306	BinaryTree->new(6)
307	->setLeft(
308	BinaryTree->new(5)
309	->setRight(
310	BinaryTree->new(7)
311	->setLeft(
312	BinaryTree->new(90)
313	)
314	->setRight(
315	BinaryTree->new(91)
316	)
317	)
318	)
319	);
320	isa_ok($btree, 'BinaryTree');
321
322	my @results = inOrderTraverse($btree);
323
324	$btree->mirror();
325
326	is_deeply(
327	[ inOrderTraverse($btree) ],
328	[ reverse(@results) ],
329	'... this should be the reverse of the original');
330	}
331
332	done_testing;