#!perl
use strict;
use Test::More qw[no_plan];
BEGIN {
use_ok('UNIVERSAL::Object');
}
=pod
TODO:
Make the parent a weak-ref ... it is not right now.
=cut
{
package BinaryTree;
use strict;
use warnings;
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($parent_attr->is_data_in_slot_weak_for($t->left), '... the value is weakened');
ok($t->right->has_parent, '... right has a parent');
is($t->right->parent, $t, '... and it is us');
#ok($parent_attr->is_data_in_slot_weak_for($t->right), '... the value is weakened');
}
{
package MyBinaryTree;
use strict;
use warnings;
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');
}