has 'left' => (
is => 'rw',
isa => 'BinaryTree',
- predicate => 'has_left',
+ predicate => 'has_left',
+ lazy => 1,
+ default => sub { BinaryTree->new(parent => $_[0]) },
);
has 'right' => (
is => 'rw',
isa => 'BinaryTree',
- predicate => 'has_right',
+ predicate => 'has_right',
+ lazy => 1,
+ default => sub { BinaryTree->new(parent => $_[0]) },
);
before 'right', 'left' => sub {
use warnings;
use Moose;
- has 'name' => (is => 'rw', isa => 'Str');
+ has 'name' => (is => 'rw', isa => 'Str', required => 1);
has 'address' => (is => 'rw', isa => 'Address');
has 'employees' => (is => 'rw', isa => subtype ArrayRef => where {
($_->isa('Employee') || return) for @$_; 1
use warnings;
use Moose;
- has 'first_name' => (is => 'rw', isa => 'Str');
- has 'last_name' => (is => 'rw', isa => 'Str');
+ has 'first_name' => (is => 'rw', isa => 'Str', required => 1);
+ has 'last_name' => (is => 'rw', isa => 'Str', required => 1);
has 'middle_initial' => (is => 'rw', isa => 'Str', predicate => 'has_middle_initial');
has 'address' => (is => 'rw', isa => 'Address');
extends 'Person';
- has 'title' => (is => 'rw', isa => 'Str');
+ has 'title' => (is => 'rw', isa => 'Str', required => 1);
has 'company' => (is => 'rw', isa => 'Company', weak_ref => 1);
override 'full_name' => sub {
my $self = shift;
super() . ', ' . $self->title
};
-
+
=head1 DESCRIPTION
=head1 AUTHOR
use strict;
use warnings;
-use Test::More tests => 27;
+use Test::More tests => 25;
use Test::Exception;
use Scalar::Util 'isweak';
has 'left' => (
is => 'rw',
isa => 'BinaryTree',
- predicate => 'has_left',
+ predicate => 'has_left',
+ lazy => 1,
+ default => sub { BinaryTree->new(parent => $_[0]) },
);
has 'right' => (
is => 'rw',
isa => 'BinaryTree',
- predicate => 'has_right',
+ predicate => 'has_right',
+ lazy => 1,
+ default => sub { BinaryTree->new(parent => $_[0]) },
);
before 'right', 'left' => sub {
my ($self, $tree) = @_;
$tree->parent($self) if defined $tree;
};
-
- sub BUILD {
- my ($self, $params) = @_;
- if ($params->{parent}) {
- # yeah this is a little
- # weird I know, but I wanted
- # to check the weaken stuff
- # in the constructor :)
- if ($params->{parent}->has_left) {
- $params->{parent}->right($self);
- }
- else {
- $params->{parent}->left($self);
- }
- }
- }
}
my $root = BinaryTree->new();
isa_ok($root, 'BinaryTree');
-is($root->left, undef, '... no left node yet');
-is($root->right, undef, '... no right node yet');
-
ok(!$root->has_left, '... no left node yet');
ok(!$root->has_right, '... no right node yet');
ok(!$root->has_parent, '... no parent for root node');
-my $left = BinaryTree->new();
-isa_ok($left, 'BinaryTree');
-
-ok(!$left->has_parent, '... left does not have a parent');
+# make a left node
-$root->left($left);
+my $left = $root->left;
+isa_ok($left, 'BinaryTree');
-is($root->left, $left, '... got a left node now (and it is $left)');
+is($root->left, $left, '... got the same node (and it is $left)');
ok($root->has_left, '... we have a left node now');
ok($left->has_parent, '... lefts has a parent');
ok(isweak($left->{parent}), '... parent is a weakened ref');
-my $right = BinaryTree->new();
-isa_ok($right, 'BinaryTree');
+ok(!$left->has_left, '... $left no left node yet');
+ok(!$left->has_right, '... $left no right node yet');
-ok(!$right->has_parent, '... right does not have a parent');
+# make a right node
-$root->right($right);
+my $right = $root->right;
+isa_ok($right, 'BinaryTree');
-is($root->right, $right, '... got a right node now (and it is $right)');
+is($root->right, $right, '... got the same node (and it is $right)');
ok($root->has_right, '... we have a right node now');
ok($right->has_parent, '... rights has a parent');
ok(isweak($right->{parent}), '... parent is a weakened ref');
-my $left_left = BinaryTree->new(parent => $left);
+my $left_left = $left->left;
isa_ok($left_left, 'BinaryTree');
ok($left_left->has_parent, '... left does have a parent');
BEGIN {
eval "use Regexp::Common; use Locale::US;";
plan skip_all => "Regexp::Common & Locale::US required for this test" if $@;
- plan tests => 70;
+ plan tests => 72;
}
use Test::Exception;
use warnings;
use Moose;
- has 'name' => (is => 'rw', isa => 'Str');
+ has 'name' => (is => 'rw', isa => 'Str', required => 1);
has 'address' => (is => 'rw', isa => 'Address');
has 'employees' => (is => 'rw', isa => subtype ArrayRef => where {
($_->isa('Employee') || return) for @$_; 1
use warnings;
use Moose;
- has 'first_name' => (is => 'rw', isa => 'Str');
- has 'last_name' => (is => 'rw', isa => 'Str');
+ has 'first_name' => (is => 'rw', isa => 'Str', required => 1);
+ has 'last_name' => (is => 'rw', isa => 'Str', required => 1);
has 'middle_initial' => (is => 'rw', isa => 'Str', predicate => 'has_middle_initial');
has 'address' => (is => 'rw', isa => 'Address');
extends 'Person';
- has 'title' => (is => 'rw', isa => 'Str');
+ has 'title' => (is => 'rw', isa => 'Str', required => 1);
has 'company' => (is => 'rw', isa => 'Company', weak_ref => 1);
override 'full_name' => sub {
} '... we live correctly with good args';
dies_ok {
- Company->new(employees => [ Person->new ]),
+ Company->new(),
+} '... we die correctly without good args';
+
+lives_ok {
+ Company->new(name => 'Foo'),
+} '... we live correctly without good args';
+
+dies_ok {
+ Company->new(name => 'Foo', employees => [ Person->new ]),
} '... we die correctly with good args';
lives_ok {
- Company->new(employees => []),
+ Company->new(name => 'Foo', employees => []),
} '... we live correctly with good args';