[gitmo/Class-MOP.git] / t / 100_BinaryTree_test.t

use strict;
use warnings;

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

use Test::More tests => 69;
use Test::Exception;

use Class::MOP;

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

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

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

lives_ok {
    Class::MOP::load_class('BinaryTree');
} '... loaded the BinaryTree class without dying';

ok(Class::MOP::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');
}
Commit	Line	Data
c50c603e	1	use strict;
	2	use warnings;
	3
448b6e55	4	use FindBin;
	5	use File::Spec::Functions;
	6
efd3d14c	7	use Test::More tests => 69;
448b6e55	8	use Test::Exception;
c50c603e	9
efd3d14c	10	use Class::MOP;
c50c603e	11
448b6e55	12	use lib catdir($FindBin::Bin, 'lib');
448b6e55	13
c50c603e	14	## ----------------------------------------------------------------------------
	15	## These are all tests which are derived from the Tree::Binary test suite
	16	## ----------------------------------------------------------------------------
	17
448b6e55	18	ok(!Class::MOP::is_class_loaded('BinaryTree'), '... the binary tree class is not loaded');
	19
	20	lives_ok {
	21	Class::MOP::load_class('BinaryTree');
	22	} '... loaded the BinaryTree class without dying';
	23
	24	ok(Class::MOP::is_class_loaded('BinaryTree'), '... the binary tree class is now loaded');
	25
c50c603e	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();
8d2d4c67	75	is(("$btree" =~ /\((.*?)\)$/)[0], $UID, '... our UID is derived from the stringified object');
c50c603e	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();
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();
c50c603e	92	isa_ok($parent, 'BinaryTree');
8d2d4c67	93
8d2d4c67	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();
c50c603e	108	isa_ok($parent, 'BinaryTree');
8d2d4c67	109
8d2d4c67	110	is($parent, $btree, '.. got what we expected');
c50c603e	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');
8d2d4c67	130
c50c603e	131	ok(!$btree->hasLeft(), '... we dont have a left node anymore');
c50c603e	132	ok(!$btree->isLeaf(), '... and we are not a leaf node');
8d2d4c67	133
c50c603e	134	$btree->setLeft($left);
8d2d4c67	135
8d2d4c67	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
8d2d4c67	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');
8d2d4c67	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
8d2d4c67	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');
c50c603e	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
	237	sub 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();
8d2d4c67	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');
c50c603e	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)
8d2d4c67	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(
c50c603e	315	BinaryTree->new(91)
8d2d4c67	316	)
8d2d4c67	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