complete re-organization of the test suite
[gitmo/Moose.git] / t / 000_recipes / 003_recipe.t
CommitLineData
e5ebe4ce 1#!/usr/bin/perl
2
3use strict;
4use warnings;
5
8597d950 6use Test::More tests => 34;
e5ebe4ce 7use Test::Exception;
8
a15dff8d 9use Scalar::Util 'isweak';
10
e5ebe4ce 11BEGIN {
12 use_ok('Moose');
13}
14
15{
16 package BinaryTree;
e5ebe4ce 17 use Moose;
18
8597d950 19 has 'node' => (is => 'rw', isa => 'Any');
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',
7c6cacb4 31 predicate => 'has_left',
32 lazy => 1,
33 default => sub { BinaryTree->new(parent => $_[0]) },
e5ebe4ce 34 );
35
a15dff8d 36 has 'right' => (
cc65ead0 37 is => 'rw',
29db16a9 38 isa => 'BinaryTree',
7c6cacb4 39 predicate => 'has_right',
40 lazy => 1,
41 default => sub { BinaryTree->new(parent => $_[0]) },
e5ebe4ce 42 );
43
44 before 'right', 'left' => sub {
45 my ($self, $tree) = @_;
46 $tree->parent($self) if defined $tree;
47 };
5cf3dbcf 48
49 __PACKAGE__->meta->make_immutable(debug => 0);
e5ebe4ce 50}
51
8597d950 52my $root = BinaryTree->new(node => 'root');
e5ebe4ce 53isa_ok($root, 'BinaryTree');
54
8597d950 55is($root->node, 'root', '... got the right node value');
56
e5ebe4ce 57ok(!$root->has_left, '... no left node yet');
58ok(!$root->has_right, '... no right node yet');
59
a15dff8d 60ok(!$root->has_parent, '... no parent for root node');
61
7c6cacb4 62# make a left node
e5ebe4ce 63
7c6cacb4 64my $left = $root->left;
65isa_ok($left, 'BinaryTree');
e5ebe4ce 66
7c6cacb4 67is($root->left, $left, '... got the same node (and it is $left)');
e5ebe4ce 68ok($root->has_left, '... we have a left node now');
69
70ok($left->has_parent, '... lefts has a parent');
71is($left->parent, $root, '... lefts parent is the root');
72
a15dff8d 73ok(isweak($left->{parent}), '... parent is a weakened ref');
74
7c6cacb4 75ok(!$left->has_left, '... $left no left node yet');
76ok(!$left->has_right, '... $left no right node yet');
e5ebe4ce 77
8597d950 78is($left->node, undef, '... left has got no node value');
79
80lives_ok {
81 $left->node('left')
82} '... assign to lefts node';
83
84is($left->node, 'left', '... left now has a node value');
85
7c6cacb4 86# make a right node
e5ebe4ce 87
8597d950 88ok(!$root->has_right, '... still no right node yet');
89
90is($root->right->node, undef, '... right has got no node value');
91
92ok($root->has_right, '... now we have a right node');
93
7c6cacb4 94my $right = $root->right;
95isa_ok($right, 'BinaryTree');
e5ebe4ce 96
8597d950 97lives_ok {
98 $right->node('right')
99} '... assign to rights node';
100
101is($right->node, 'right', '... left now has a node value');
102
7c6cacb4 103is($root->right, $right, '... got the same node (and it is $right)');
e5ebe4ce 104ok($root->has_right, '... we have a right node now');
105
106ok($right->has_parent, '... rights has a parent');
107is($right->parent, $root, '... rights parent is the root');
a15dff8d 108
109ok(isweak($right->{parent}), '... parent is a weakened ref');
6ba6d68c 110
7c6cacb4 111my $left_left = $left->left;
6ba6d68c 112isa_ok($left_left, 'BinaryTree');
113
114ok($left_left->has_parent, '... left does have a parent');
115
116is($left_left->parent, $left, '... got a parent node (and it is $left)');
117ok($left->has_left, '... we have a left node now');
118is($left->left, $left_left, '... got a left node (and it is $left_left)');
119
120ok(isweak($left_left->{parent}), '... parent is a weakened ref');
121