#!perl
BEGIN {
use_ok(
'UNIVERSAL::Object'
);
}
{
our
@ISA
; BEGIN {
@ISA
= (
'UNIVERSAL::Object'
) }
our
%HAS
; BEGIN {
%HAS
= (
node
=>
sub
{
undef
},
parent
=>
sub
{
undef
},
left
=>
sub
{
undef
},
right
=>
sub
{
undef
},
)
}
sub
node {
my
$self
=
$_
[0];
$self
->{node} =
$_
[1]
if
$_
[1];
$self
->{node};
}
sub
parent {
$_
[0]->{parent} }
sub
has_parent {
defined
$_
[0]->{parent} }
sub
left {
$_
[0]->{left} ||=
ref
(
$_
[0])->new(
parent
=>
$_
[0] ) }
sub
has_left {
defined
$_
[0]->{left} }
sub
right {
$_
[0]->{right} ||=
ref
(
$_
[0])->new(
parent
=>
$_
[0] ) }
sub
has_right {
defined
$_
[0]->{right} }
}
{
my
$t
= BinaryTree->new;
ok(
$t
->isa(
'BinaryTree'
),
'... this is a BinaryTree object'
);
ok(!
$t
->has_parent,
'... this tree has no parent'
);
ok(!
$t
->has_left,
'... left node has not been created yet'
);
ok(!
$t
->has_right,
'... right node has not been created yet'
);
ok(
$t
->left->isa(
'BinaryTree'
),
'... left is a BinaryTree object'
);
ok(
$t
->right->isa(
'BinaryTree'
),
'... right is a BinaryTree object'
);
ok(
$t
->has_left,
'... left node has now been created'
);
ok(
$t
->has_right,
'... right node has now been created'
);
ok(
$t
->left->has_parent,
'... left has a parent'
);
is(
$t
->left->parent,
$t
,
'... and it is us'
);
ok(
$t
->right->has_parent,
'... right has a parent'
);
is(
$t
->right->parent,
$t
,
'... and it is us'
);
}
{
our
@ISA
; BEGIN {
@ISA
= (
'BinaryTree'
) }
}
{
my
$t
= MyBinaryTree->new;
ok(
$t
->isa(
'MyBinaryTree'
),
'... this is a MyBinaryTree object'
);
ok(
$t
->isa(
'BinaryTree'
),
'... this is a BinaryTree object'
);
ok(!
$t
->has_parent,
'... this tree has no parent'
);
ok(!
$t
->has_left,
'... left node has not been created yet'
);
ok(!
$t
->has_right,
'... right node has not been created yet'
);
ok(
$t
->left->isa(
'BinaryTree'
),
'... left is a BinaryTree object'
);
ok(
$t
->right->isa(
'BinaryTree'
),
'... right is a BinaryTree object'
);
ok(
$t
->has_left,
'... left node has now been created'
);
ok(
$t
->has_right,
'... right node has now been created'
);
}