Commit | Line | Data |
e5ebe4ce |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
6ba6d68c |
6 | use Test::More tests => 27; |
e5ebe4ce |
7 | use Test::Exception; |
8 | |
a15dff8d |
9 | use Scalar::Util 'isweak'; |
10 | |
e5ebe4ce |
11 | BEGIN { |
12 | use_ok('Moose'); |
13 | } |
14 | |
15 | { |
16 | package BinaryTree; |
17 | use strict; |
18 | use warnings; |
19 | use Moose; |
20 | |
a15dff8d |
21 | has 'parent' => ( |
cc65ead0 |
22 | is => 'rw', |
29db16a9 |
23 | isa => 'BinaryTree', |
24 | predicate => 'has_parent', |
29db16a9 |
25 | weak_ref => 1, |
e5ebe4ce |
26 | ); |
27 | |
a15dff8d |
28 | has 'left' => ( |
cc65ead0 |
29 | is => 'rw', |
29db16a9 |
30 | isa => 'BinaryTree', |
31 | predicate => 'has_left', |
e5ebe4ce |
32 | ); |
33 | |
a15dff8d |
34 | has 'right' => ( |
cc65ead0 |
35 | is => 'rw', |
29db16a9 |
36 | isa => 'BinaryTree', |
37 | predicate => 'has_right', |
e5ebe4ce |
38 | ); |
39 | |
40 | before 'right', 'left' => sub { |
41 | my ($self, $tree) = @_; |
42 | $tree->parent($self) if defined $tree; |
43 | }; |
6ba6d68c |
44 | |
45 | sub BUILD { |
d7f17ebb |
46 | my ($self, $params) = @_; |
47 | if ($params->{parent}) { |
6ba6d68c |
48 | # yeah this is a little |
49 | # weird I know, but I wanted |
50 | # to check the weaken stuff |
51 | # in the constructor :) |
d7f17ebb |
52 | if ($params->{parent}->has_left) { |
53 | $params->{parent}->right($self); |
6ba6d68c |
54 | } |
55 | else { |
d7f17ebb |
56 | $params->{parent}->left($self); |
6ba6d68c |
57 | } |
58 | } |
59 | } |
e5ebe4ce |
60 | } |
61 | |
62 | my $root = BinaryTree->new(); |
63 | isa_ok($root, 'BinaryTree'); |
64 | |
65 | is($root->left, undef, '... no left node yet'); |
66 | is($root->right, undef, '... no right node yet'); |
67 | |
68 | ok(!$root->has_left, '... no left node yet'); |
69 | ok(!$root->has_right, '... no right node yet'); |
70 | |
a15dff8d |
71 | ok(!$root->has_parent, '... no parent for root node'); |
72 | |
e5ebe4ce |
73 | my $left = BinaryTree->new(); |
74 | isa_ok($left, 'BinaryTree'); |
75 | |
76 | ok(!$left->has_parent, '... left does not have a parent'); |
77 | |
78 | $root->left($left); |
79 | |
80 | is($root->left, $left, '... got a left node now (and it is $left)'); |
81 | ok($root->has_left, '... we have a left node now'); |
82 | |
83 | ok($left->has_parent, '... lefts has a parent'); |
84 | is($left->parent, $root, '... lefts parent is the root'); |
85 | |
a15dff8d |
86 | ok(isweak($left->{parent}), '... parent is a weakened ref'); |
87 | |
e5ebe4ce |
88 | my $right = BinaryTree->new(); |
89 | isa_ok($right, 'BinaryTree'); |
90 | |
91 | ok(!$right->has_parent, '... right does not have a parent'); |
92 | |
93 | $root->right($right); |
94 | |
95 | is($root->right, $right, '... got a right node now (and it is $right)'); |
96 | ok($root->has_right, '... we have a right node now'); |
97 | |
98 | ok($right->has_parent, '... rights has a parent'); |
99 | is($right->parent, $root, '... rights parent is the root'); |
a15dff8d |
100 | |
101 | ok(isweak($right->{parent}), '... parent is a weakened ref'); |
6ba6d68c |
102 | |
103 | my $left_left = BinaryTree->new(parent => $left); |
104 | isa_ok($left_left, 'BinaryTree'); |
105 | |
106 | ok($left_left->has_parent, '... left does have a parent'); |
107 | |
108 | is($left_left->parent, $left, '... got a parent node (and it is $left)'); |
109 | ok($left->has_left, '... we have a left node now'); |
110 | is($left->left, $left_left, '... got a left node (and it is $left_left)'); |
111 | |
112 | ok(isweak($left_left->{parent}), '... parent is a weakened ref'); |
113 | |