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

#!/usr/bin/perl

use strict;
use warnings;

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

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

BEGIN {
    use_ok('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	#!/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 {
8d2d4c67	13	use_ok('Class::MOP');
c50c603e	14	}
c50c603e	15
448b6e55	16	use lib catdir($FindBin::Bin, 'lib');
448b6e55	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();
c50c603e	96	isa_ok($parent, 'BinaryTree');
8d2d4c67	97
8d2d4c67	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();
c50c603e	112	isa_ok($parent, 'BinaryTree');
8d2d4c67	113
8d2d4c67	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');
c50c603e	136	ok(!$btree->isLeaf(), '... and we are not a leaf node');
8d2d4c67	137
c50c603e	138	$btree->setLeft($left);
8d2d4c67	139
8d2d4c67	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
8d2d4c67	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');
8d2d4c67	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
8d2d4c67	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');
c50c603e	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();
8d2d4c67	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');
c50c603e	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)
8d2d4c67	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(
c50c603e	319	BinaryTree->new(91)
8d2d4c67	320	)
8d2d4c67	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