t/000_recipes/moose_cookbook_basics_recipe3.t

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4 use Test::More 'no_plan';
   5 use Test::Exception;
   6 $| = 1;
   7
   8
   9
  10 # =begin testing SETUP
  11 {
  12
  13   package BinaryTree;
  14   use Mouse;
  15
  16   has 'node' => ( is => 'rw', isa => 'Any' );
  17
  18   has 'parent' => (
  19       is        => 'rw',
  20       isa       => 'BinaryTree',
  21       predicate => 'has_parent',
  22       weak_ref  => 1,
  23   );
  24
  25   has 'left' => (
  26       is        => 'rw',
  27       isa       => 'BinaryTree',
  28       predicate => 'has_left',
  29       lazy      => 1,
  30       default   => sub { BinaryTree->new( parent => $_[0] ) },
  31       trigger   => \&_set_parent_for_child
  32   );
  33
  34   has 'right' => (
  35       is        => 'rw',
  36       isa       => 'BinaryTree',
  37       predicate => 'has_right',
  38       lazy      => 1,
  39       default   => sub { BinaryTree->new( parent => $_[0] ) },
  40       trigger   => \&_set_parent_for_child
  41   );
  42
  43   sub _set_parent_for_child {
  44       my ( $self, $child ) = @_;
  45
  46       confess "You cannot insert a tree which already has a parent"
  47           if $child->has_parent;
  48
  49       $child->parent($self);
  50   }
  51 }
  52
  53
  54
  55 # =begin testing
  56 {
  57 use Scalar::Util 'isweak';
  58
  59 my $root = BinaryTree->new(node => 'root');
  60 isa_ok($root, 'BinaryTree');
  61
  62 is($root->node, 'root', '... got the right node value');
  63
  64 ok(!$root->has_left, '... no left node yet');
  65 ok(!$root->has_right, '... no right node yet');
  66
  67 ok(!$root->has_parent, '... no parent for root node');
  68
  69 # make a left node
  70
  71 my $left = $root->left;
  72 isa_ok($left, 'BinaryTree');
  73
  74 is($root->left, $left, '... got the same node (and it is $left)');
  75 ok($root->has_left, '... we have a left node now');
  76
  77 ok($left->has_parent, '... lefts has a parent');
  78 is($left->parent, $root, '... lefts parent is the root');
  79
  80 ok(isweak($left->{parent}), '... parent is a weakened ref');
  81
  82 ok(!$left->has_left, '... $left no left node yet');
  83 ok(!$left->has_right, '... $left no right node yet');
  84
  85 is($left->node, undef, '... left has got no node value');
  86
  87 lives_ok {
  88     $left->node('left')
  89 } '... assign to lefts node';
  90
  91 is($left->node, 'left', '... left now has a node value');
  92
  93 # make a right node
  94
  95 ok(!$root->has_right, '... still no right node yet');
  96
  97 is($root->right->node, undef, '... right has got no node value');
  98
  99 ok($root->has_right, '... now we have a right node');
 100
 101 my $right = $root->right;
 102 isa_ok($right, 'BinaryTree');
 103
 104 lives_ok {
 105     $right->node('right')
 106 } '... assign to rights node';
 107
 108 is($right->node, 'right', '... left now has a node value');
 109
 110 is($root->right, $right, '... got the same node (and it is $right)');
 111 ok($root->has_right, '... we have a right node now');
 112
 113 ok($right->has_parent, '... rights has a parent');
 114 is($right->parent, $root, '... rights parent is the root');
 115
 116 ok(isweak($right->{parent}), '... parent is a weakened ref');
 117
 118 # make a left node of the left node
 119
 120 my $left_left = $left->left;
 121 isa_ok($left_left, 'BinaryTree');
 122
 123 ok($left_left->has_parent, '... left does have a parent');
 124
 125 is($left_left->parent, $left, '... got a parent node (and it is $left)');
 126 ok($left->has_left, '... we have a left node now');
 127 is($left->left, $left_left, '... got a left node (and it is $left_left)');
 128
 129 ok(isweak($left_left->{parent}), '... parent is a weakened ref');
 130
 131 # make a right node of the left node
 132
 133 my $left_right = BinaryTree->new;
 134 isa_ok($left_right, 'BinaryTree');
 135
 136 lives_ok {
 137     $left->right($left_right)
 138 } '... assign to rights node';
 139
 140 ok($left_right->has_parent, '... left does have a parent');
 141
 142 is($left_right->parent, $left, '... got a parent node (and it is $left)');
 143 ok($left->has_right, '... we have a left node now');
 144 is($left->right, $left_right, '... got a left node (and it is $left_left)');
 145
 146 ok(isweak($left_right->{parent}), '... parent is a weakened ref');
 147
 148 # and check the error
 149
 150 dies_ok {
 151     $left_right->right($left_left)
 152 } '... cant assign a node which already has a parent';
 153 }
 154
 155
 156
 157
 158 1;