#!/usr/bin/perl
use strict;
use warnings;
use Test::More tests => 34;
use Test::Exception;
use Scalar::Util 'isweak';
BEGIN {
use_ok('Moose');
}
{
package BinaryTree;
use Moose;
has 'node' => (is => 'rw', isa => 'Any');
has 'parent' => (
is => 'rw',
isa => 'BinaryTree',
predicate => 'has_parent',
weak_ref => 1,
);
has 'left' => (
is => 'rw',
isa => 'BinaryTree',
predicate => 'has_left',
lazy => 1,
default => sub { BinaryTree->new(parent => $_[0]) },
);
has 'right' => (
is => 'rw',
isa => 'BinaryTree',
predicate => 'has_right',
lazy => 1,
default => sub { BinaryTree->new(parent => $_[0]) },
);
before 'right', 'left' => sub {
my ($self, $tree) = @_;
$tree->parent($self) if defined $tree;
};
__PACKAGE__->meta->make_immutable(debug => 0);
}
my $root = BinaryTree->new(node => 'root');
isa_ok($root, 'BinaryTree');
is($root->node, 'root', '... got the right node value');
ok(!$root->has_left, '... no left node yet');
ok(!$root->has_right, '... no right node yet');
ok(!$root->has_parent, '... no parent for root node');
# make a left node
my $left = $root->left;
isa_ok($left, 'BinaryTree');
is($root->left, $left, '... got the same node (and it is $left)');
ok($root->has_left, '... we have a left node now');
ok($left->has_parent, '... lefts has a parent');
is($left->parent, $root, '... lefts parent is the root');
ok(isweak($left->{parent}), '... parent is a weakened ref');
ok(!$left->has_left, '... $left no left node yet');
ok(!$left->has_right, '... $left no right node yet');
is($left->node, undef, '... left has got no node value');
lives_ok {
$left->node('left')
} '... assign to lefts node';
is($left->node, 'left', '... left now has a node value');
# make a right node
ok(!$root->has_right, '... still no right node yet');
is($root->right->node, undef, '... right has got no node value');
ok($root->has_right, '... now we have a right node');
my $right = $root->right;
isa_ok($right, 'BinaryTree');
lives_ok {
$right->node('right')
} '... assign to rights node';
is($right->node, 'right', '... left now has a node value');
is($root->right, $right, '... got the same node (and it is $right)');
ok($root->has_right, '... we have a right node now');
ok($right->has_parent, '... rights has a parent');
is($right->parent, $root, '... rights parent is the root');
ok(isweak($right->{parent}), '... parent is a weakened ref');
my $left_left = $left->left;
isa_ok($left_left, 'BinaryTree');
ok($left_left->has_parent, '... left does have a parent');
is($left_left->parent, $left, '... got a parent node (and it is $left)');
ok($left->has_left, '... we have a left node now');
is($left->left, $left_left, '... got a left node (and it is $left_left)');
ok(isweak($left_left->{parent}), '... parent is a weakened ref');