4 use Test::More 'no_plan';
10 # =begin testing SETUP
16 has 'node' => ( is => 'rw', isa => 'Any' );
21 predicate => 'has_parent',
28 predicate => 'has_left',
30 default => sub { BinaryTree->new( parent => $_[0] ) },
31 trigger => \&_set_parent_for_child
37 predicate => 'has_right',
39 default => sub { BinaryTree->new( parent => $_[0] ) },
40 trigger => \&_set_parent_for_child
43 sub _set_parent_for_child {
44 my ( $self, $child ) = @_;
46 confess "You cannot insert a tree which already has a parent"
47 if $child->has_parent;
49 $child->parent($self);
57 use Scalar::Util 'isweak';
59 my $root = BinaryTree->new(node => 'root');
60 isa_ok($root, 'BinaryTree');
62 is($root->node, 'root', '... got the right node value');
64 ok(!$root->has_left, '... no left node yet');
65 ok(!$root->has_right, '... no right node yet');
67 ok(!$root->has_parent, '... no parent for root node');
71 my $left = $root->left;
72 isa_ok($left, 'BinaryTree');
74 is($root->left, $left, '... got the same node (and it is $left)');
75 ok($root->has_left, '... we have a left node now');
77 ok($left->has_parent, '... lefts has a parent');
78 is($left->parent, $root, '... lefts parent is the root');
80 ok(isweak($left->{parent}), '... parent is a weakened ref');
82 ok(!$left->has_left, '... $left no left node yet');
83 ok(!$left->has_right, '... $left no right node yet');
85 is($left->node, undef, '... left has got no node value');
89 } '... assign to lefts node';
91 is($left->node, 'left', '... left now has a node value');
95 ok(!$root->has_right, '... still no right node yet');
97 is($root->right->node, undef, '... right has got no node value');
99 ok($root->has_right, '... now we have a right node');
101 my $right = $root->right;
102 isa_ok($right, 'BinaryTree');
105 $right->node('right')
106 } '... assign to rights node';
108 is($right->node, 'right', '... left now has a node value');
110 is($root->right, $right, '... got the same node (and it is $right)');
111 ok($root->has_right, '... we have a right node now');
113 ok($right->has_parent, '... rights has a parent');
114 is($right->parent, $root, '... rights parent is the root');
116 ok(isweak($right->{parent}), '... parent is a weakened ref');
118 # make a left node of the left node
120 my $left_left = $left->left;
121 isa_ok($left_left, 'BinaryTree');
123 ok($left_left->has_parent, '... left does have a parent');
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)');
129 ok(isweak($left_left->{parent}), '... parent is a weakened ref');
131 # make a right node of the left node
133 my $left_right = BinaryTree->new;
134 isa_ok($left_right, 'BinaryTree');
137 $left->right($left_right)
138 } '... assign to rights node';
140 ok($left_right->has_parent, '... left does have a parent');
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)');
146 ok(isweak($left_right->{parent}), '... parent is a weakened ref');
148 # and check the error
151 $left_right->right($left_left)
152 } '... cant assign a node which already has a parent';