Commit | Line | Data |
e3c07b19 |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
1c08fd75 |
6 | use Moose (); |
e3c07b19 |
7 | use Test::Exception; |
1c08fd75 |
8 | use Test::More; |
9 | use Test::Moose; |
e3c07b19 |
10 | |
e3c07b19 |
11 | { |
1c08fd75 |
12 | my %handles = ( |
13 | option_accessor => 'accessor', |
14 | quantity => [ accessor => 'quantity' ], |
15 | clear_options => 'clear', |
16 | num_options => 'count', |
17 | delete_option => 'delete', |
18 | is_defined => 'defined', |
19 | options_elements => 'elements', |
20 | has_option => 'exists', |
21 | get_option => 'get', |
22 | has_no_options => 'is_empty', |
23 | key_value => 'kv', |
24 | set_option => 'set', |
e3c07b19 |
25 | ); |
85592815 |
26 | |
1c08fd75 |
27 | my $name = 'Foo1'; |
28 | |
29 | sub build_class { |
30 | my %attr = @_; |
31 | |
32 | my $class = Moose::Meta::Class->create( |
33 | $name++, |
34 | superclasses => ['Moose::Object'], |
35 | ); |
36 | |
37 | $class->add_attribute( |
38 | options => ( |
39 | traits => ['Hash'], |
40 | is => 'ro', |
41 | isa => 'HashRef[Str]', |
42 | default => sub { {} }, |
43 | handles => \%handles, |
44 | clearer => '_clear_options', |
45 | %attr, |
46 | ), |
47 | ); |
48 | |
49 | return ( $class->name, \%handles ); |
50 | } |
d50fc84a |
51 | } |
e3c07b19 |
52 | |
1c08fd75 |
53 | { |
54 | run_tests(build_class); |
55 | run_tests( build_class( lazy => 1, default => sub { { x => 1 } } ) ); |
d50fc84a |
56 | } |
59de9de4 |
57 | |
1c08fd75 |
58 | sub run_tests { |
59 | my ( $class, $handles ) = @_; |
59de9de4 |
60 | |
1c08fd75 |
61 | can_ok( $class, $_ ) for sort keys %{$handles}; |
e3c07b19 |
62 | |
1c08fd75 |
63 | with_immutable { |
64 | my $obj = $class->new( options => {} ); |
e3c07b19 |
65 | |
1c08fd75 |
66 | ok( $obj->has_no_options, '... we have no options' ); |
67 | is( $obj->num_options, 0, '... we have no options' ); |
68 | |
69 | is_deeply( $obj->options, {}, '... no options yet' ); |
70 | ok( !$obj->has_option('foo'), '... we have no foo option' ); |
71 | |
72 | lives_ok { |
73 | $obj->set_option( foo => 'bar' ); |
74 | } |
75 | '... set the option okay'; |
76 | |
77 | ok( $obj->is_defined('foo'), '... foo is defined' ); |
78 | |
79 | ok( !$obj->has_no_options, '... we have options' ); |
80 | is( $obj->num_options, 1, '... we have 1 option(s)' ); |
81 | ok( $obj->has_option('foo'), '... we have a foo option' ); |
82 | is_deeply( $obj->options, { foo => 'bar' }, '... got options now' ); |
83 | |
84 | lives_ok { |
85 | $obj->set_option( bar => 'baz' ); |
86 | } |
87 | '... set the option okay'; |
88 | |
89 | is( $obj->num_options, 2, '... we have 2 option(s)' ); |
90 | is_deeply( |
91 | $obj->options, { foo => 'bar', bar => 'baz' }, |
92 | '... got more options now' |
93 | ); |
94 | |
95 | is( $obj->get_option('foo'), 'bar', '... got the right option' ); |
96 | |
97 | is_deeply( |
98 | [ $obj->get_option(qw(foo bar)) ], [qw(bar baz)], |
99 | "get multiple options at once" |
100 | ); |
101 | |
102 | is( |
103 | scalar( $obj->get_option(qw( foo bar)) ), "baz", |
104 | '... got last option in scalar context' |
105 | ); |
106 | |
107 | lives_ok { |
108 | $obj->set_option( oink => "blah", xxy => "flop" ); |
109 | } |
110 | '... set the option okay'; |
111 | |
112 | is( $obj->num_options, 4, "4 options" ); |
113 | is_deeply( |
114 | [ $obj->get_option(qw(foo bar oink xxy)) ], |
115 | [qw(bar baz blah flop)], "get multiple options at once" |
116 | ); |
117 | |
118 | lives_ok { |
119 | $obj->delete_option('bar'); |
120 | } |
121 | '... deleted the option okay'; |
122 | |
123 | lives_ok { |
124 | $obj->delete_option( 'oink', 'xxy' ); |
125 | } |
126 | '... deleted multiple option okay'; |
127 | |
128 | is( $obj->num_options, 1, '... we have 1 option(s)' ); |
129 | is_deeply( |
130 | $obj->options, { foo => 'bar' }, |
131 | '... got more options now' |
132 | ); |
133 | |
134 | $obj->clear_options; |
135 | |
136 | is_deeply( $obj->options, {}, "... cleared options" ); |
137 | |
138 | lives_ok { |
139 | $obj->quantity(4); |
140 | } |
141 | '... options added okay with defaults'; |
142 | |
143 | is( $obj->quantity, 4, 'reader part of curried accessor works' ); |
144 | |
145 | is_deeply( |
146 | $obj->options, { quantity => 4 }, |
147 | '... returns what we expect' |
148 | ); |
149 | |
150 | lives_ok { |
151 | $class->new( options => { foo => 'BAR' } ); |
152 | } |
153 | '... good constructor params'; |
154 | |
155 | dies_ok { |
156 | $obj->set_option( bar => {} ); |
157 | } |
158 | '... could not add a hash ref where an string is expected'; |
159 | |
160 | dies_ok { |
161 | $class->new( options => { foo => [] } ); |
162 | } |
163 | '... bad constructor params'; |
164 | |
165 | $obj->set_option( oink => "blah", xxy => "flop" ); |
166 | my @key_value = sort { $a->[0] cmp $b->[0] } $obj->key_value; |
167 | is_deeply( |
168 | \@key_value, |
169 | [ |
170 | sort { $a->[0] cmp $b->[0] }[ 'xxy', 'flop' ], |
171 | [ 'quantity', 4 ], |
172 | [ 'oink', 'blah' ] |
173 | ], |
174 | '... got the right key value pairs' |
175 | ) |
176 | or do { |
177 | require Data::Dumper; |
178 | diag( Data::Dumper::Dumper( \@key_value ) ); |
179 | }; |
180 | |
181 | my %options_elements = $obj->options_elements; |
182 | is_deeply( |
183 | \%options_elements, { |
184 | 'oink' => 'blah', |
185 | 'quantity' => 4, |
186 | 'xxy' => 'flop' |
187 | }, |
188 | '... got the right hash elements' |
189 | ); |
190 | |
191 | if ( $class->meta->get_attribute('options')->is_lazy ) { |
192 | my $obj = $class->new; |
193 | |
194 | $obj->set_option( y => 2 ); |
195 | |
196 | is_deeply( |
197 | $obj->options, { x => 1, y => 2 }, |
198 | 'set_option with lazy default' |
199 | ); |
200 | |
201 | $obj->_clear_options; |
202 | |
203 | ok( |
204 | $obj->has_option('x'), |
205 | 'key for x exists - lazy default' |
206 | ); |
207 | |
208 | $obj->_clear_options; |
209 | |
210 | ok( |
211 | $obj->is_defined('x'), |
212 | 'key for x is defined - lazy default' |
213 | ); |
214 | |
215 | $obj->_clear_options; |
216 | |
217 | is_deeply( |
218 | [ $obj->key_value ], |
219 | [ [ x => 1 ] ], |
220 | 'kv returns lazy default' |
221 | ); |
222 | } |
223 | } |
224 | $class; |
d50fc84a |
225 | } |
a28e50e4 |
226 | |
227 | done_testing; |