t/003_basic.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 21;
   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                 isa       => 'BinaryTree',
  23         predicate => 'has_parent',
  24         accessor  => 'parent',
  25                 weak_ref  => 1,
  26     );
  27
  28     has 'left' => (
  29                 isa       => 'BinaryTree',
  30         predicate => 'has_left',
  31         accessor  => 'left',
  32     );
  33
  34     has 'right' => (
  35                 isa       => 'BinaryTree',
  36         predicate => 'has_right',
  37         accessor  => 'right',
  38     );
  39
  40     before 'right', 'left' => sub {
  41         my ($self, $tree) = @_;
  42             $tree->parent($self) if defined $tree;
  43         };
  44 }
  45
  46 my $root = BinaryTree->new();
  47 isa_ok($root, 'BinaryTree');
  48
  49 is($root->left, undef, '... no left node yet');
  50 is($root->right, undef, '... no right node yet');
  51
  52 ok(!$root->has_left, '... no left node yet');
  53 ok(!$root->has_right, '... no right node yet');
  54
  55 ok(!$root->has_parent, '... no parent for root node');
  56
  57 my $left = BinaryTree->new();
  58 isa_ok($left, 'BinaryTree');
  59
  60 ok(!$left->has_parent, '... left does not have a parent');
  61
  62 $root->left($left);
  63
  64 is($root->left, $left, '... got a left node now (and it is $left)');
  65 ok($root->has_left, '... we have a left node now');
  66
  67 ok($left->has_parent, '... lefts has a parent');
  68 is($left->parent, $root, '... lefts parent is the root');
  69
  70 ok(isweak($left->{parent}), '... parent is a weakened ref');
  71
  72 my $right = BinaryTree->new();
  73 isa_ok($right, 'BinaryTree');
  74
  75 ok(!$right->has_parent, '... right does not have a parent');
  76
  77 $root->right($right);
  78
  79 is($root->right, $right, '... got a right node now (and it is $right)');
  80 ok($root->has_right, '... we have a right node now');
  81
  82 ok($right->has_parent, '... rights has a parent');
  83 is($right->parent, $root, '... rights parent is the root');
  84
  85 ok(isweak($right->{parent}), '... parent is a weakened ref');