t/100_BinaryTree_test.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use FindBin;
   7 use File::Spec::Functions;
   8
   9 use Test::More tests => 70;
  10 use Test::Exception;
  11
  12 BEGIN {
  13     use_ok('Class::MOP');
  14 }
  15
  16 use lib catdir($FindBin::Bin, 'lib');
  17
  18 ## ----------------------------------------------------------------------------
  19 ## These are all tests which are derived from the Tree::Binary test suite
  20 ## ----------------------------------------------------------------------------
  21
  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
  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();
  79     is(("$btree" =~ /\((.*?)\)$/), $UID, '... our UID is derived from the stringified object');
  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();
  88
  89     isa_ok($left, 'BinaryTree');
  90
  91     is($left->getNodeValue(), '+', '... got what we expected');
  92
  93     can_ok($left, 'getParent');
  94
  95     my $parent = $left->getParent();
  96     isa_ok($parent, 'BinaryTree');
  97
  98     is($parent, $btree, '.. got what we expected');
  99 }
 100
 101 {
 102     can_ok($btree, 'getRight');
 103     my $right = $btree->getRight();
 104
 105     isa_ok($right, 'BinaryTree');
 106
 107     is($right->getNodeValue(), '*', '... got what we expected');
 108
 109     can_ok($right, 'getParent');
 110
 111     my $parent = $right->getParent();
 112     isa_ok($parent, 'BinaryTree');
 113
 114     is($parent, $btree, '.. got what we expected');
 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');
 134
 135     ok(!$btree->hasLeft(), '... we dont have a left node anymore');
 136     ok(!$btree->isLeaf(), '... and we are not a leaf node');
 137
 138     $btree->setLeft($left);
 139
 140     ok($btree->hasLeft(), '... we have our left node again');
 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');
 148
 149     ok($left_leaf->isLeaf(), '... our left leaf is a leaf');
 150
 151     ok(!$btree->getLeft()->hasLeft(), '... we dont have a left leaf node anymore');
 152
 153     $btree->getLeft()->setLeft($left_leaf);
 154
 155     ok($btree->getLeft()->hasLeft(), '... we have our left leaf node again');
 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');
 163
 164     ok(!$btree->hasRight(), '... we dont have a right node anymore');
 165     ok(!$btree->isLeaf(), '... and we are not a leaf node');
 166
 167     $btree->setRight($right);
 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')
 171 }
 172
 173 {
 174     # remove right leaf
 175     my $right_leaf = $btree->getRight()->removeRight();
 176     isa_ok($right_leaf, 'BinaryTree');
 177
 178     ok($right_leaf->isLeaf(), '... our right leaf is a leaf');
 179
 180     ok(!$btree->getRight()->hasRight(), '... we dont have a right leaf node anymore');
 181
 182     $btree->getRight()->setRight($right_leaf);
 183
 184     ok($btree->getRight()->hasRight(), '... we have our right leaf node again');
 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');
 229
 230     can_ok($btree, 'size');
 231     cmp_ok($btree->size(), '==', 14, '... we have 14 nodes in the tree');
 232
 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) = @_;
 246         $traversal_function->($tree->getLeft(), $traversal_function) if $tree->hasLeft();
 247         push @results => $tree->getNodeValue();
 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(
 260                                 BinaryTree->new(1)
 261                                 )
 262                             ->setRight(
 263                                 BinaryTree->new(3)
 264                                 )
 265                         )
 266                     ->setRight(
 267                         BinaryTree->new(6)
 268                             ->setLeft(
 269                                 BinaryTree->new(5)
 270                                 )
 271                             ->setRight(
 272                                 BinaryTree->new(7)
 273                                 )
 274                         );
 275     isa_ok($btree, 'BinaryTree');
 276
 277     is_deeply(
 278         [ inOrderTraverse($btree) ],
 279         [ 1 .. 7 ],
 280         '... check that our tree starts out correctly');
 281
 282     can_ok($btree, 'mirror');
 283     $btree->mirror();
 284
 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(
 299                                             BinaryTree->new(10)
 300                                                 ->setLeft(
 301                                                     BinaryTree->new(5)
 302                                                 )
 303                                         )
 304                                 )
 305                             ->setRight(
 306                                 BinaryTree->new(3)
 307                                 )
 308                         )
 309                     ->setRight(
 310                         BinaryTree->new(6)
 311                             ->setLeft(
 312                                 BinaryTree->new(5)
 313                                     ->setRight(
 314                                         BinaryTree->new(7)
 315                                             ->setLeft(
 316                                                 BinaryTree->new(90)
 317                                             )
 318                                             ->setRight(
 319                                                 BinaryTree->new(91)
 320                                             )
 321                                         )
 322                                 )
 323                         );
 324     isa_ok($btree, 'BinaryTree');
 325
 326     my @results = inOrderTraverse($btree);
 327
 328     $btree->mirror();
 329
 330     is_deeply(
 331         [ inOrderTraverse($btree) ],
 332         [ reverse(@results) ],
 333         '... this should be the reverse of the original');
 334 }
 335