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