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