t/001_cmop/100_BinaryTree_test.t

   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
  10 use Class::MOP;
  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
  18 ok(!Class::MOP::is_class_loaded('BinaryTree'), '... the binary tree class is not loaded');
  19
  20 is( exception {
  21     Class::MOP::load_class('BinaryTree');
  22 }, undef, '... loaded the BinaryTree class without dying' );
  23
  24 ok(Class::MOP::is_class_loaded('BinaryTree'), '... the binary tree class is now loaded');
  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;