Commit | Line | Data |
7acf2fe9 |
1 | use strict; |
bd567467 |
2 | use warnings FATAL => 'all'; |
7acf2fe9 |
3 | |
0f01d3ff |
4 | use Test::More; |
7acf2fe9 |
5 | use Test::Fatal; |
6 | use Test::Deep '!blessed'; |
0f01d3ff |
7 | use if $ENV{AUTHOR_TESTING}, 'Test::Warnings'; |
7acf2fe9 |
8 | use Scalar::Util 'blessed'; |
9 | |
10 | my %loaded_file; |
28d69363 |
11 | my %configfile_sub; |
8b4a3e76 |
12 | my %constructor_args; |
7acf2fe9 |
13 | |
14 | |
15 | # nothing special going on here |
16 | { |
17 | package Generic; |
18 | use Moose; |
e8e7174e |
19 | with 'MooseX::ConfigFromFile'; |
233548dd |
20 | sub get_config_from_file |
21 | { |
22 | my ($class, $file) = @_; |
23 | $loaded_file{$file}++; |
24 | +{} |
25 | } |
8b4a3e76 |
26 | around BUILDARGS => sub { |
27 | my ($orig, $class) = (shift, shift); |
28 | my $args = $class->$orig(@_); |
29 | $constructor_args{$class} = $args; |
30 | }; |
31 | sub __my_configfile |
32 | { |
33 | my $class = blessed($_[0]) || $_[0]; |
28d69363 |
34 | $configfile_sub{$class}++; |
8b4a3e76 |
35 | $class . ' file' |
36 | } |
7acf2fe9 |
37 | } |
38 | |
39 | is( |
40 | exception { |
41 | my $obj = Generic->new_with_config; |
42 | is($obj->configfile, undef, 'no configfile set'); |
233548dd |
43 | cmp_deeply(\%loaded_file, {}, 'no files loaded'); |
8b4a3e76 |
44 | cmp_deeply( |
45 | $constructor_args{blessed($obj)}, |
46 | { }, |
47 | 'correct constructor args passed', |
48 | ); |
7acf2fe9 |
49 | }, |
50 | undef, |
51 | 'no exceptions', |
52 | ); |
53 | |
eb27f7e7 |
54 | { |
55 | package Base; |
56 | use Moose; |
57 | } |
58 | { |
59 | package GenericRole; |
60 | use Moose::Role; |
61 | with 'MooseX::ConfigFromFile'; |
62 | sub get_config_from_file |
63 | { |
64 | my ($class, $file) = @_; |
65 | $loaded_file{$file}++; |
66 | +{} |
67 | } |
68 | around BUILDARGS => sub { |
69 | my ($orig, $class) = (shift, shift); |
70 | my $args = $class->$orig(@_); |
71 | $constructor_args{$class} = $args; |
72 | }; |
73 | sub __my_configfile |
74 | { |
75 | my $class = blessed($_[0]) || $_[0]; |
76 | $configfile_sub{$class}++; |
77 | $class . ' file' |
78 | } |
79 | } |
80 | |
81 | is( |
82 | exception { |
83 | my $obj = Moose::Meta::Class->create_anon_class( |
84 | superclasses => ['Base'], |
85 | roles => ['GenericRole'], |
86 | )->name->new_with_config; |
87 | is($obj->configfile, undef, 'no configfile set'); |
88 | cmp_deeply(\%loaded_file, {}, 'no files loaded'); |
89 | cmp_deeply( |
90 | $constructor_args{blessed($obj)}, |
91 | { }, |
92 | 'correct constructor args passed', |
93 | ); |
94 | }, |
95 | undef, |
96 | 'no exceptions', |
97 | ); |
7acf2fe9 |
98 | |
99 | # this is a classic legacy usecase from old documentation that we must |
100 | # continue to support |
101 | { |
102 | package OverriddenDefault; |
103 | use Moose; |
233548dd |
104 | extends 'Generic'; |
7acf2fe9 |
105 | has '+configfile' => ( |
106 | default => 'OverriddenDefault file', |
107 | ); |
108 | } |
109 | |
110 | is( |
111 | exception { |
112 | my $obj = OverriddenDefault->new_with_config; |
113 | is($obj->configfile, blessed($obj) . ' file', 'configfile set via overridden default'); |
114 | is($loaded_file{blessed($obj) . ' file'}, 1, 'correct file was loaded from'); |
115 | }, |
116 | undef, |
117 | 'no exceptions', |
118 | ); |
119 | |
28d69363 |
120 | { |
121 | package OverriddenDefaultMethod; |
122 | use Moose; |
123 | extends 'Generic'; |
124 | has '+configfile' => ( |
125 | default => sub { shift->__my_configfile }, |
126 | ); |
127 | } |
128 | |
129 | is( |
130 | exception { |
131 | my $obj = OverriddenDefaultMethod->new_with_config; |
132 | is($obj->configfile, blessed($obj) . ' file', 'configfile set via overridden default'); |
133 | is($configfile_sub{blessed($obj)}, 1, 'configfile was calculated just once'); |
134 | is($loaded_file{blessed($obj) . ' file'}, 1, 'correct file was loaded from'); |
135 | }, |
136 | undef, |
137 | 'no exceptions', |
138 | ); |
139 | |
140 | |
8b4a3e76 |
141 | # legacy usecase, and configfile init_arg has been changed |
142 | { |
143 | package OverriddenDefaultAndChangedName; |
144 | use Moose; |
145 | extends 'Generic'; |
146 | has '+configfile' => ( |
147 | init_arg => 'my_configfile', |
148 | default => 'OverriddenDefaultAndChangedName file', |
149 | ); |
150 | } |
151 | |
152 | is( |
153 | exception { |
154 | my $obj = OverriddenDefaultAndChangedName->new_with_config; |
155 | is($obj->configfile, blessed($obj) . ' file', 'configfile set via overridden default'); |
156 | cmp_deeply( |
157 | $constructor_args{blessed($obj)}, |
158 | { my_configfile => blessed($obj) . ' file' }, |
159 | 'correct constructor args passed', |
160 | ); |
161 | is($loaded_file{blessed($obj) . ' file'}, 1, 'correct file was loaded from'); |
162 | }, |
163 | undef, |
164 | 'no exceptions', |
165 | ); |
7acf2fe9 |
166 | |
167 | # "reader" method is overridden to provide for configfile default |
168 | { |
169 | package OverriddenMethod; |
170 | use Moose; |
233548dd |
171 | extends 'Generic'; |
8b4a3e76 |
172 | around configfile => sub { my $orig = shift; shift->__my_configfile }; |
7acf2fe9 |
173 | } |
174 | |
175 | is( |
176 | exception { |
177 | my $obj = OverriddenMethod->new_with_config; |
178 | is($obj->configfile, blessed($obj) . ' file', 'configfile set via overridden sub'); |
28d69363 |
179 | # this is not fixable - the reader method has been shadowed |
180 | # is($configfile_sub{blessed($obj)}, 1, 'configfile was calculated just once'); |
7acf2fe9 |
181 | is($loaded_file{blessed($obj) . ' file'}, 1, 'correct file was loaded from'); |
182 | }, |
183 | undef, |
184 | 'no exceptions', |
185 | ); |
186 | |
eb27f7e7 |
187 | { |
188 | package OverriddenMethodAsRole; |
189 | use Moose::Role; |
190 | with 'GenericRole'; |
191 | around configfile => sub { my $orig = shift; shift->__my_configfile }; |
192 | } |
193 | |
194 | is( |
195 | exception { |
196 | my $obj = Moose::Meta::Class->create_anon_class( |
197 | superclasses => ['Base'], |
198 | roles => ['OverriddenMethodAsRole'], |
199 | )->name->new_with_config; |
200 | is($obj->configfile, blessed($obj) . ' file', 'configfile set via overridden sub'); |
201 | # this is not fixable - the reader method has been shadowed |
202 | # is($configfile_sub{blessed($obj)}, 1, 'configfile was calculated just once'); |
203 | is($loaded_file{blessed($obj) . ' file'}, 1, 'correct file was loaded from'); |
204 | }, |
205 | undef, |
206 | 'no exceptions', |
207 | ); |
208 | |
7acf2fe9 |
209 | |
8b4a3e76 |
210 | # overridable method for configfile default, and configfile init_arg is changed |
211 | { |
212 | package OverriddenMethodAndChangedName; |
213 | use Moose; |
214 | extends 'Generic'; |
215 | has '+configfile' => ( |
216 | init_arg => 'my_configfile', |
217 | ); |
218 | around configfile => sub { my $orig = shift; shift->__my_configfile }; |
219 | } |
220 | |
221 | is( |
222 | exception { |
223 | my $obj = OverriddenMethodAndChangedName->new_with_config; |
224 | is($obj->configfile, blessed($obj) . ' file', 'configfile set via overridden sub'); |
225 | cmp_deeply( |
226 | $constructor_args{blessed($obj)}, |
227 | { my_configfile => blessed($obj) . ' file' }, |
228 | 'correct constructor args passed', |
229 | ); |
28d69363 |
230 | # this is not fixable - the reader method has been shadowed |
231 | # is($configfile_sub{blessed($obj)}, 1, 'configfile was calculated just once'); |
232 | is($loaded_file{blessed($obj) . ' file'}, 1, 'correct file was loaded from'); |
233 | }, |
234 | undef, |
235 | 'no exceptions', |
236 | ); |
237 | |
eb27f7e7 |
238 | { |
239 | package OverriddenMethodAndChangedNameAsRole; |
240 | use Moose::Role; |
241 | with 'GenericRole'; |
242 | use MooseX::Types::Path::Tiny 'Path'; |
243 | use MooseX::Types::Moose 'Undef'; |
244 | use Try::Tiny; |
245 | has configfile => ( |
246 | is => 'ro', |
247 | isa => Path|Undef, |
248 | coerce => 1, |
249 | predicate => 'has_configfile', |
250 | do { try { require MooseX::Getopt; (traits => ['Getopt']) } }, |
251 | lazy => 1, |
252 | # it sucks that we have to do this rather than using a builder, but some old code |
253 | # simply swaps in a new default sub into the attr definition |
254 | default => sub { shift->_get_default_configfile }, |
255 | |
256 | # this is the overridden bit |
257 | init_arg => 'my_configfile', |
258 | ); |
259 | around configfile => sub { my $orig = shift; shift->__my_configfile }; |
260 | } |
261 | |
262 | is( |
263 | exception { |
264 | my $obj = Moose::Meta::Class->create_anon_class( |
265 | superclasses => ['Base'], |
266 | roles => ['OverriddenMethodAndChangedNameAsRole'], |
267 | )->name->new_with_config; |
268 | is($obj->configfile, blessed($obj) . ' file', 'configfile set via overridden sub'); |
269 | cmp_deeply( |
270 | $constructor_args{blessed($obj)}, |
271 | { my_configfile => blessed($obj) . ' file' }, |
272 | 'correct constructor args passed', |
273 | ); |
274 | # this is not fixable - the reader method has been shadowed |
275 | # is($configfile_sub{blessed($obj)}, 1, 'configfile was calculated just once'); |
276 | is($loaded_file{blessed($obj) . ' file'}, 1, 'correct file was loaded from'); |
277 | }, |
278 | undef, |
279 | 'no exceptions', |
280 | ); |
281 | |
282 | |
28d69363 |
283 | # newly-supported overridable method for configfile default |
284 | { |
eef91585 |
285 | package NewSub; |
28d69363 |
286 | use Moose; |
287 | extends 'Generic'; |
288 | sub _get_default_configfile { shift->__my_configfile } |
289 | } |
290 | |
291 | is( |
292 | exception { |
eef91585 |
293 | my $obj = NewSub->new_with_config; |
28d69363 |
294 | is($obj->configfile, blessed($obj) . ' file', 'configfile set via new sub'); |
295 | cmp_deeply( |
296 | $constructor_args{blessed($obj)}, |
297 | { configfile => blessed($obj) . ' file' }, |
298 | 'correct constructor args passed', |
299 | ); |
300 | is($configfile_sub{blessed($obj)}, 1, 'configfile was calculated just once'); |
301 | is($loaded_file{blessed($obj) . ' file'}, 1, 'correct file was loaded from'); |
302 | }, |
303 | undef, |
304 | 'no exceptions', |
305 | ); |
306 | |
eb27f7e7 |
307 | { |
308 | package NewSubAsRole; |
309 | use Moose::Role; |
310 | with 'GenericRole'; |
311 | sub _get_default_configfile { shift->__my_configfile } |
312 | } |
313 | |
314 | is( |
315 | exception { |
316 | my $obj = Moose::Meta::Class->create_anon_class( |
317 | superclasses => ['Base'], |
318 | roles => ['NewSubAsRole'], |
319 | )->name->new_with_config; |
320 | is($obj->configfile, blessed($obj) . ' file', 'configfile set via new sub'); |
321 | cmp_deeply( |
322 | $constructor_args{blessed($obj)}, |
323 | { configfile => blessed($obj) . ' file' }, |
324 | 'correct constructor args passed', |
325 | ); |
326 | is($configfile_sub{blessed($obj)}, 1, 'configfile was calculated just once'); |
327 | is($loaded_file{blessed($obj) . ' file'}, 1, 'correct file was loaded from'); |
328 | }, |
329 | undef, |
330 | 'no exceptions', |
331 | ); |
332 | |
333 | |
28d69363 |
334 | # newly-supported overridable method for configfile default, and configfile |
335 | # init_arg has been changed |
336 | { |
eef91585 |
337 | package NewSubAndChangedName; |
28d69363 |
338 | use Moose; |
339 | extends 'Generic'; |
340 | has '+configfile' => ( |
341 | init_arg => 'my_configfile', |
342 | ); |
343 | sub _get_default_configfile { shift->__my_configfile } |
344 | } |
345 | |
346 | is( |
347 | exception { |
eef91585 |
348 | my $obj = NewSubAndChangedName->new_with_config; |
28d69363 |
349 | is($obj->configfile, blessed($obj) . ' file', 'configfile set via overridden sub'); |
350 | cmp_deeply( |
351 | $constructor_args{blessed($obj)}, |
352 | { my_configfile => blessed($obj) . ' file' }, |
353 | 'correct constructor args passed', |
354 | ); |
355 | is($configfile_sub{blessed($obj)}, 1, 'configfile was calculated just once'); |
8b4a3e76 |
356 | is($loaded_file{blessed($obj) . ' file'}, 1, 'correct file was loaded from'); |
357 | }, |
358 | undef, |
359 | 'no exceptions', |
360 | ); |
361 | |
0f01d3ff |
362 | done_testing; |