1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
|
#!/usr/bin/env perl
use strict;
use warnings;
use Test::More tests => 47;
use Test::Exception;
my $builder_called = 0;
my $lazy_builder_called = 0;
do {
package Class;
use Mouse;
has name => (
is => 'rw',
isa => 'Str',
builder => '_build_name',
predicate => 'has_name',
clearer => 'clear_name',
);
sub _build_name {
my $self = shift;
++$builder_called;
return "FRANK";
};
has age => (
is => 'ro',
isa => 'Int',
lazy_build => 1,
clearer => 'clear_age',
predicate => 'has_age',
);
sub default_age { 20 }
sub _build_age {
my $self = shift;
++$lazy_builder_called;
return $self->default_age;
};
};
# eager builder
my $object = Class->new(name => "Bob");
ok($object->has_name, "predicate: value from constructor");
is($builder_called, 0, "builder not called in the constructor when we pass a value");
is($object->name, "Bob", "builder doesn't matter when we just set the value in constructor");
$object->name("Bill");
is($object->name, "Bill", "builder doesn't matter when we just set the value in writer");
is($builder_called, 0, "builder not called in the setter");
$builder_called = 0;
$object->clear_name;
ok(!$object->has_name, "predicate: no value after clear");
is($object->name, undef, "eager builder does NOT swoop in after clear");
ok(!$object->has_name, "predicate: no value after clear and get");
is($builder_called, 0, "builder not called in the getter, even after clear");
$builder_called = 0;
my $object2 = Class->new;
ok($object2->has_name, "predicate: value from eager builder");
is($object2->name, "FRANK", "builder called to provide the default value");
is($builder_called, 1, "builder called ONCE to provide the default value");
# lazy builder
my $object3 = Class->new;
is($lazy_builder_called, 0, "lazy builder not called yet");
ok(!$object3->has_age, "predicate: no age yet");
is($object3->age, 20, "lazy builder value");
ok($object3->has_age, "predicate: have value after get");
is($lazy_builder_called, 1, "lazy builder called on get");
is($object3->age, 20, "lazy builder value");
is($lazy_builder_called, 1, "lazy builder not called on subsequent gets");
ok($object3->has_age, "predicate: have value after subsequent gets");
$lazy_builder_called = 0;
$object3->clear_age;
ok(!$object3->has_age, "predicate: no value after clear");
is($lazy_builder_called, 0, "lazy builder not called on clear");
is($object3->age, 20, "lazy builder value");
ok($object3->has_age, "predicate: have value after clear and get");
is($lazy_builder_called, 1, "lazy builder called on get after clear");
$lazy_builder_called = 0;
my $object4 = Class->new(age => 50);
ok($object4->has_age, "predicate: have value from constructor");
is($lazy_builder_called, 0, "lazy builder not called yet");
is($object4->age, 50, "value from constructor");
is($lazy_builder_called, 0, "lazy builder not called if value is from constructor");
$object4->clear_age;
ok(!$object4->has_age, "predicate: no value after clear");
is($lazy_builder_called, 0, "lazy builder not called on clear");
is($object4->age, 20, "lazy builder value");
ok($object4->has_age, "predicate: have value after clear and get");
is($lazy_builder_called, 1, "lazy builder called on get after clear");
do {
package Class::Error;
use Mouse;
::throws_ok {
has error => (
lazy_build => 1,
default => 1,
);
} qr/You can not use lazy_build and default for the same attribute \(error\)/;
};
my @calls;
do {
package Class::CustomBuilder;
use Mouse;
has custom => (
is => 'ro',
lazy_build => 1,
builder => 'build_my_customs',
predicate => 'has_my_customs',
clearer => 'clear_my_customs',
);
sub build_my_customs {
push @calls, 'build_my_customs';
return 'yo';
}
};
my $cb = Class::CustomBuilder->new;
ok(!$cb->has_my_customs, "correct predicate");
is($cb->custom, 'yo');
is_deeply([splice @calls], ['build_my_customs']);
ok($cb->has_my_customs, "correct predicate");
ok($cb->clear_my_customs, "correct clearer");
ok(!$cb->has_my_customs, "correct predicate");
do {
package Class::UnderscoreBuilder;
use Mouse;
has _attr => (
is => 'ro',
lazy_build => 1,
);
sub _build__attr {
push @calls, '_build__attr';
return 'ping';
}
};
my $cub = Class::UnderscoreBuilder->new;
ok(!$cub->_has_attr, "correct predicate");
is($cub->_attr, 'ping');
is_deeply([splice @calls], ['_build__attr']);
ok($cub->_has_attr, "correct predicate");
ok($cub->_clear_attr, "correct clearer");
ok(!$cub->_has_attr, "correct predicate");
|
