t/000_recipes/003_recipe.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 34;
   7 use Test::Exception;
   8
   9 use Scalar::Util 'isweak';
  10
  11 BEGIN {
  12     use_ok('Moose');
  13 }
  14
  15 {
  16     package BinaryTree;
  17     use Moose;
  18
  19     has 'node' => (is => 'rw', isa => 'Any');
  20
  21     has 'parent' => (
  22                 is        => 'rw',
  23                 isa       => 'BinaryTree',
  24         predicate => 'has_parent',
  25                 weak_ref  => 1,
  26     );
  27
  28     has 'left' => (
  29                 is        => 'rw',
  30                 isa       => 'BinaryTree',
  31         predicate => 'has_left',
  32         lazy      => 1,
  33         default   => sub { BinaryTree->new(parent => $_[0]) },
  34     );
  35
  36     has 'right' => (
  37                 is        => 'rw',
  38                 isa       => 'BinaryTree',
  39         predicate => 'has_right',
  40         lazy      => 1,
  41         default   => sub { BinaryTree->new(parent => $_[0]) },
  42     );
  43
  44     before 'right', 'left' => sub {
  45         my ($self, $tree) = @_;
  46             $tree->parent($self) if defined $tree;
  47         };
  48
  49     metaclass->make_immutable(debug => 0);
  50 }
  51
  52 my $root = BinaryTree->new(node => 'root');
  53 isa_ok($root, 'BinaryTree');
  54
  55 is($root->node, 'root', '... got the right node value');
  56
  57 ok(!$root->has_left, '... no left node yet');
  58 ok(!$root->has_right, '... no right node yet');
  59
  60 ok(!$root->has_parent, '... no parent for root node');
  61
  62 # make a left node
  63
  64 my $left = $root->left;
  65 isa_ok($left, 'BinaryTree');
  66
  67 is($root->left, $left, '... got the same node (and it is $left)');
  68 ok($root->has_left, '... we have a left node now');
  69
  70 ok($left->has_parent, '... lefts has a parent');
  71 is($left->parent, $root, '... lefts parent is the root');
  72
  73 ok(isweak($left->{parent}), '... parent is a weakened ref');
  74
  75 ok(!$left->has_left, '... $left no left node yet');
  76 ok(!$left->has_right, '... $left no right node yet');
  77
  78 is($left->node, undef, '... left has got no node value');
  79
  80 lives_ok {
  81     $left->node('left')
  82 } '... assign to lefts node';
  83
  84 is($left->node, 'left', '... left now has a node value');
  85
  86 # make a right node
  87
  88 ok(!$root->has_right, '... still no right node yet');
  89
  90 is($root->right->node, undef, '... right has got no node value');
  91
  92 ok($root->has_right, '... now we have a right node');
  93
  94 my $right = $root->right;
  95 isa_ok($right, 'BinaryTree');
  96
  97 lives_ok {
  98     $right->node('right')
  99 } '... assign to rights node';
 100
 101 is($right->node, 'right', '... left now has a node value');
 102
 103 is($root->right, $right, '... got the same node (and it is $right)');
 104 ok($root->has_right, '... we have a right node now');
 105
 106 ok($right->has_parent, '... rights has a parent');
 107 is($right->parent, $root, '... rights parent is the root');
 108
 109 ok(isweak($right->{parent}), '... parent is a weakened ref');
 110
 111 my $left_left = $left->left;
 112 isa_ok($left_left, 'BinaryTree');
 113
 114 ok($left_left->has_parent, '... left does have a parent');
 115
 116 is($left_left->parent, $left, '... got a parent node (and it is $left)');
 117 ok($left->has_left, '... we have a left node now');
 118 is($left->left, $left_left, '... got a left node (and it is $left_left)');
 119
 120 ok(isweak($left_left->{parent}), '... parent is a weakened ref');
 121