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