adding the lazy class example
[gitmo/Class-MOP.git] / t / 106_LazyClass_test.t
CommitLineData
4300f56a 1#!/usr/bin/perl
2
3use strict;
4use warnings;
5
6use Test::More no_plan => 29;
7use File::Spec;
8
9BEGIN {
10 use_ok('Class::MOP');
11 require_ok(File::Spec->catdir('examples', 'LazyClass.pod'));
12}
13
14{
15 package BinaryTree;
16
17 sub meta {
18 LazyClass->initialize($_[0] => (
19 ':attribute_metaclass' => 'LazyClass::Attribute'
20 ));
21 }
22
23 BinaryTree->meta->add_attribute('$:node' => (
24 accessor => 'node',
25 init_arg => ':node'
26 ));
27
28 BinaryTree->meta->add_attribute('$:left' => (
29 reader => 'left',
30 default => sub { BinaryTree->new() }
31 ));
32
33 BinaryTree->meta->add_attribute('$:right' => (
34 reader => 'right',
35 default => sub { BinaryTree->new() }
36 ));
37
38 sub new {
39 my $class = shift;
40 bless $class->meta->construct_instance(@_) => $class;
41 }
42}
43
44my $root = BinaryTree->new(':node' => 0);
45isa_ok($root, 'BinaryTree');
46
47ok(exists($root->{'$:node'}), '... node attribute has been initialized yet');
48ok(!exists($root->{'$:left'}), '... left attribute has not been initialized yet');
49ok(!exists($root->{'$:right'}), '... right attribute has not been initialized yet');
50
51isa_ok($root->left, 'BinaryTree');
52isa_ok($root->right, 'BinaryTree');
53
54ok(exists($root->{'$:left'}), '... left attribute has now been initialized');
55ok(exists($root->{'$:right'}), '... right attribute has now been initialized');
56
57ok(!exists($root->left->{'$:node'}), '... node attribute has not been initialized yet');
58ok(!exists($root->left->{'$:left'}), '... left attribute has not been initialized yet');
59ok(!exists($root->left->{'$:right'}), '... right attribute has not been initialized yet');
60
61ok(!exists($root->right->{'$:node'}), '... node attribute has not been initialized yet');
62ok(!exists($root->right->{'$:left'}), '... left attribute has not been initialized yet');
63ok(!exists($root->right->{'$:right'}), '... right attribute has not been initialized yet');
64
65is($root->left->node(), undef, '... the left node is uninitialized');
66
67ok(exists($root->left->{'$:node'}), '... node attribute has now been initialized');
68
69$root->left->node(1);
70is($root->left->node(), 1, '... the left node == 1');
71
72ok(!exists($root->left->{'$:left'}), '... left attribute still has not been initialized yet');
73ok(!exists($root->left->{'$:right'}), '... right attribute still has not been initialized yet');
74
75is($root->right->node(), undef, '... the right node is uninitialized');
76
77ok(exists($root->right->{'$:node'}), '... node attribute has now been initialized');
78
79$root->right->node(2);
80is($root->right->node(), 2, '... the right node == 1');
81
82ok(!exists($root->right->{'$:left'}), '... left attribute still has not been initialized yet');
83ok(!exists($root->right->{'$:right'}), '... right attribute still has not been initialized yet');
84