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