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
|
#!/usr/bin/perl
use strict;
use warnings;
use Test::More;
use Test::Exception;
{
package Foo;
use Moose;
has 'foo' => (
reader => 'get_foo',
writer => 'set_foo',
initializer => sub {
my ($self, $value, $callback, $attr) = @_;
::isa_ok($attr, 'Moose::Meta::Attribute');
::is($attr->name, 'foo', '... got the right name');
$callback->($value * 2);
},
);
has 'lazy_foo' => (
reader => 'get_lazy_foo',
lazy => 1,
default => 10,
initializer => sub {
my ($self, $value, $callback, $attr) = @_;
::isa_ok($attr, 'Moose::Meta::Attribute');
::is($attr->name, 'lazy_foo', '... got the right name');
$callback->($value * 2);
},
);
has 'lazy_foo_w_type' => (
reader => 'get_lazy_foo_w_type',
isa => 'Int',
lazy => 1,
default => 20,
initializer => sub {
my ($self, $value, $callback, $attr) = @_;
::isa_ok($attr, 'Moose::Meta::Attribute');
::is($attr->name, 'lazy_foo_w_type', '... got the right name');
$callback->($value * 2);
},
);
has 'lazy_foo_builder' => (
reader => 'get_lazy_foo_builder',
builder => 'get_foo_builder',
initializer => sub {
my ($self, $value, $callback, $attr) = @_;
::isa_ok($attr, 'Moose::Meta::Attribute');
::is($attr->name, 'lazy_foo_builder', '... got the right name');
$callback->($value * 2);
},
);
has 'lazy_foo_builder_w_type' => (
reader => 'get_lazy_foo_builder_w_type',
isa => 'Int',
builder => 'get_foo_builder_w_type',
initializer => sub {
my ($self, $value, $callback, $attr) = @_;
::isa_ok($attr, 'Moose::Meta::Attribute');
::is($attr->name, 'lazy_foo_builder_w_type', '... got the right name');
$callback->($value * 2);
},
);
sub get_foo_builder { 100 }
sub get_foo_builder_w_type { 1000 }
}
{
my $foo = Foo->new(foo => 10);
isa_ok($foo, 'Foo');
is($foo->get_foo, 20, 'initial value set to 2x given value');
is($foo->get_lazy_foo, 20, 'initial lazy value set to 2x given value');
is($foo->get_lazy_foo_w_type, 40, 'initial lazy value with type set to 2x given value');
is($foo->get_lazy_foo_builder, 200, 'initial lazy value with builder set to 2x given value');
is($foo->get_lazy_foo_builder_w_type, 2000, 'initial lazy value with builder and type set to 2x given value');
}
{
package Bar;
use Moose;
has 'foo' => (
reader => 'get_foo',
writer => 'set_foo',
initializer => sub {
my ($self, $value, $callback, $attr) = @_;
::isa_ok($attr, 'Moose::Meta::Attribute');
::is($attr->name, 'foo', '... got the right name');
$callback->($value * 2);
},
);
__PACKAGE__->meta->make_immutable;
}
{
my $bar = Bar->new(foo => 10);
isa_ok($bar, 'Bar');
is($bar->get_foo, 20, 'initial value set to 2x given value');
}
{
package Fail::Bar;
use Moose;
has 'foo' => (
reader => 'get_foo',
writer => 'set_foo',
isa => 'Int',
initializer => sub {
my ($self, $value, $callback, $attr) = @_;
::isa_ok($attr, 'Moose::Meta::Attribute');
::is($attr->name, 'foo', '... got the right name');
$callback->("Hello $value World");
},
);
__PACKAGE__->meta->make_immutable;
}
dies_ok {
Fail::Bar->new(foo => 10)
} '... this fails, because initializer returns a bad type';
done_testing;
|
