t/003_basic.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 27;
   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 strict;
  18     use warnings;
  19     use Moose;
  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     );
  33
  34     has 'right' => (
  35                 is        => 'rw',
  36                 isa       => 'BinaryTree',
  37         predicate => 'has_right',
  38     );
  39
  40     before 'right', 'left' => sub {
  41         my ($self, $tree) = @_;
  42             $tree->parent($self) if defined $tree;
  43         };
  44
  45         sub BUILD {
  46             my ($self, $params) = @_;
  47             if ($params->{parent}) {
  48                 # yeah this is a little
  49                 # weird I know, but I wanted
  50                 # to check the weaken stuff
  51                 # in the constructor :)
  52                 if ($params->{parent}->has_left) {
  53                     $params->{parent}->right($self);
  54                 }
  55                 else {
  56                     $params->{parent}->left($self);
  57                 }
  58             }
  59         }
  60 }
  61
  62 my $root = BinaryTree->new();
  63 isa_ok($root, 'BinaryTree');
  64
  65 is($root->left, undef, '... no left node yet');
  66 is($root->right, undef, '... no right node yet');
  67
  68 ok(!$root->has_left, '... no left node yet');
  69 ok(!$root->has_right, '... no right node yet');
  70
  71 ok(!$root->has_parent, '... no parent for root node');
  72
  73 my $left = BinaryTree->new();
  74 isa_ok($left, 'BinaryTree');
  75
  76 ok(!$left->has_parent, '... left does not have a parent');
  77
  78 $root->left($left);
  79
  80 is($root->left, $left, '... got a left node now (and it is $left)');
  81 ok($root->has_left, '... we have a left node now');
  82
  83 ok($left->has_parent, '... lefts has a parent');
  84 is($left->parent, $root, '... lefts parent is the root');
  85
  86 ok(isweak($left->{parent}), '... parent is a weakened ref');
  87
  88 my $right = BinaryTree->new();
  89 isa_ok($right, 'BinaryTree');
  90
  91 ok(!$right->has_parent, '... right does not have a parent');
  92
  93 $root->right($right);
  94
  95 is($root->right, $right, '... got a right node now (and it is $right)');
  96 ok($root->has_right, '... we have a right node now');
  97
  98 ok($right->has_parent, '... rights has a parent');
  99 is($right->parent, $root, '... rights parent is the root');
 100
 101 ok(isweak($right->{parent}), '... parent is a weakened ref');
 102
 103 my $left_left = BinaryTree->new(parent => $left);
 104 isa_ok($left_left, 'BinaryTree');
 105
 106 ok($left_left->has_parent, '... left does have a parent');
 107
 108 is($left_left->parent, $left, '... got a parent node (and it is $left)');
 109 ok($left->has_left, '... we have a left node now');
 110 is($left->left, $left_left, '... got a left node (and it is $left_left)');
 111
 112 ok(isweak($left_left->{parent}), '... parent is a weakened ref');
 113