merging the immutable branch into trunk

[gitmo/Class-MOP.git] / t / 106_LazyClass_test.t

#!/usr/bin/perl

use strict;
use warnings;

use Test::More tests => 26;
use File::Spec;

BEGIN { 
    use_ok('Class::MOP');    
    require_ok(File::Spec->catdir('examples', 'LazyClass.pod'));
}

{
    package BinaryTree;
    
    use metaclass (
        'attribute_metaclass' => 'LazyClass::Attribute',
        'instance_metaclass'  => 'LazyClass::Instance',        
    );

    BinaryTree->meta->add_attribute('$:node' => (
        accessor => 'node',
        init_arg => 'node'
    ));
    
    BinaryTree->meta->add_attribute('$:left' => (
        reader  => 'left',
        default => sub { BinaryTree->new() }
    ));
    
    BinaryTree->meta->add_attribute('$:right' => (
        reader  => 'right',
        default => sub { BinaryTree->new() }    
    ));    

    sub new {
        my $class = shift;
        bless $class->meta->construct_instance(@_) => $class;
    }
}

my $root = BinaryTree->new('node' => 0);
isa_ok($root, 'BinaryTree');

ok(exists($root->{'$:node'}), '... node attribute has been initialized yet');
ok(!exists($root->{'$:left'}), '... left attribute has not been initialized yet');
ok(!exists($root->{'$:right'}), '... right attribute has not been initialized yet');

isa_ok($root->left, 'BinaryTree');
isa_ok($root->right, 'BinaryTree');

ok(exists($root->{'$:left'}), '... left attribute has now been initialized');
ok(exists($root->{'$:right'}), '... right attribute has now been initialized');

ok(!exists($root->left->{'$:node'}), '... node attribute has not been initialized yet');
ok(!exists($root->left->{'$:left'}), '... left attribute has not been initialized yet');
ok(!exists($root->left->{'$:right'}), '... right attribute has not been initialized yet');

ok(!exists($root->right->{'$:node'}), '... node attribute has not been initialized yet');
ok(!exists($root->right->{'$:left'}), '... left attribute has not been initialized yet');
ok(!exists($root->right->{'$:right'}), '... right attribute has not been initialized yet');

is($root->left->node(), undef, '... the left node is uninitialized');

ok(exists($root->left->{'$:node'}), '... node attribute has now been initialized');

$root->left->node(1);
is($root->left->node(), 1, '... the left node == 1');

ok(!exists($root->left->{'$:left'}), '... left attribute still has not been initialized yet');
ok(!exists($root->left->{'$:right'}), '... right attribute still has not been initialized yet');

is($root->right->node(), undef, '... the right node is uninitialized');

ok(exists($root->right->{'$:node'}), '... node attribute has now been initialized');

$root->right->node(2);
is($root->right->node(), 2, '... the right node == 1');

ok(!exists($root->right->{'$:left'}), '... left attribute still has not been initialized yet');
ok(!exists($root->right->{'$:right'}), '... right attribute still has not been initialized yet');