Commit | Line | Data |
231be3be |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
fdeb8354 |
6 | use lib 't/lib', 'lib'; |
7 | |
8 | use Test::More tests => 73; |
9 | use Test::Exception; |
231be3be |
10 | |
11 | use Moose::Util::MetaRole; |
12 | |
13 | |
14 | { |
15 | package My::Meta::Class; |
16 | use Moose; |
17 | extends 'Moose::Meta::Class'; |
18 | } |
19 | |
20 | { |
231be3be |
21 | package Role::Foo; |
22 | use Moose::Role; |
23 | has 'foo' => ( is => 'ro', default => 10 ); |
24 | } |
25 | |
26 | { |
27 | package My::Class; |
28 | |
29 | use Moose; |
30 | } |
31 | |
32 | { |
33 | Moose::Util::MetaRole::apply_metaclass_roles( |
34 | for_class => 'My::Class', |
35 | metaclass_roles => ['Role::Foo'], |
36 | ); |
37 | |
38 | ok( My::Class->meta()->meta()->does_role('Role::Foo'), |
39 | 'apply Role::Foo to My::Class->meta()' ); |
40 | is( My::Class->meta()->foo(), 10, |
41 | '... and call foo() on that meta object' ); |
42 | } |
43 | |
44 | { |
45 | Moose::Util::MetaRole::apply_metaclass_roles( |
46 | for_class => 'My::Class', |
47 | attribute_metaclass_roles => ['Role::Foo'], |
48 | ); |
49 | |
50 | ok( My::Class->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'), |
51 | q{apply Role::Foo to My::Class->meta()'s attribute metaclass} ); |
52 | ok( My::Class->meta()->meta()->does_role('Role::Foo'), |
53 | '... My::Class->meta() still does Role::Foo' ); |
54 | |
55 | My::Class->meta()->add_attribute( 'size', is => 'ro' ); |
56 | is( My::Class->meta()->get_attribute('size')->foo(), 10, |
57 | '... call foo() on an attribute metaclass object' ); |
58 | } |
59 | |
60 | { |
61 | Moose::Util::MetaRole::apply_metaclass_roles( |
62 | for_class => 'My::Class', |
63 | method_metaclass_roles => ['Role::Foo'], |
64 | ); |
65 | |
66 | ok( My::Class->meta()->method_metaclass()->meta()->does_role('Role::Foo'), |
67 | q{apply Role::Foo to My::Class->meta()'s method metaclass} ); |
68 | ok( My::Class->meta()->meta()->does_role('Role::Foo'), |
69 | '... My::Class->meta() still does Role::Foo' ); |
70 | ok( My::Class->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'), |
71 | q{... My::Class->meta()'s attribute metaclass still does Role::Foo} ); |
72 | |
73 | My::Class->meta()->add_method( 'bar' => sub { 'bar' } ); |
74 | is( My::Class->meta()->get_method('bar')->foo(), 10, |
75 | '... call foo() on a method metaclass object' ); |
76 | } |
77 | |
78 | { |
79 | Moose::Util::MetaRole::apply_metaclass_roles( |
80 | for_class => 'My::Class', |
81 | instance_metaclass_roles => ['Role::Foo'], |
82 | ); |
83 | |
84 | ok( My::Class->meta()->instance_metaclass()->meta()->does_role('Role::Foo'), |
85 | q{apply Role::Foo to My::Class->meta()'s instance metaclass} ); |
86 | ok( My::Class->meta()->meta()->does_role('Role::Foo'), |
87 | '... My::Class->meta() still does Role::Foo' ); |
88 | ok( My::Class->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'), |
89 | q{... My::Class->meta()'s attribute metaclass still does Role::Foo} ); |
90 | ok( My::Class->meta()->method_metaclass()->meta()->does_role('Role::Foo'), |
91 | q{... My::Class->meta()'s method metaclass still does Role::Foo} ); |
92 | |
93 | is( My::Class->meta()->get_meta_instance()->foo(), 10, |
94 | '... call foo() on an instance metaclass object' ); |
95 | } |
96 | |
97 | { |
98 | Moose::Util::MetaRole::apply_metaclass_roles( |
99 | for_class => 'My::Class', |
100 | constructor_class_roles => ['Role::Foo'], |
101 | ); |
102 | |
103 | ok( My::Class->meta()->constructor_class()->meta()->does_role('Role::Foo'), |
104 | q{apply Role::Foo to My::Class->meta()'s constructor class} ); |
105 | ok( My::Class->meta()->meta()->does_role('Role::Foo'), |
106 | '... My::Class->meta() still does Role::Foo' ); |
107 | ok( My::Class->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'), |
108 | q{... My::Class->meta()'s attribute metaclass still does Role::Foo} ); |
109 | ok( My::Class->meta()->method_metaclass()->meta()->does_role('Role::Foo'), |
110 | q{... My::Class->meta()'s method metaclass still does Role::Foo} ); |
111 | ok( My::Class->meta()->instance_metaclass()->meta()->does_role('Role::Foo'), |
112 | q{... My::Class->meta()'s instance metaclass still does Role::Foo} ); |
113 | |
114 | # Actually instantiating the constructor class is too freaking hard! |
115 | ok( My::Class->meta()->constructor_class()->can('foo'), |
116 | '... constructor class has a foo method' ); |
117 | } |
118 | |
119 | { |
120 | Moose::Util::MetaRole::apply_metaclass_roles( |
121 | for_class => 'My::Class', |
122 | destructor_class_roles => ['Role::Foo'], |
123 | ); |
124 | |
125 | ok( My::Class->meta()->destructor_class()->meta()->does_role('Role::Foo'), |
126 | q{apply Role::Foo to My::Class->meta()'s destructor class} ); |
127 | ok( My::Class->meta()->meta()->does_role('Role::Foo'), |
128 | '... My::Class->meta() still does Role::Foo' ); |
129 | ok( My::Class->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'), |
130 | q{... My::Class->meta()'s attribute metaclass still does Role::Foo} ); |
131 | ok( My::Class->meta()->method_metaclass()->meta()->does_role('Role::Foo'), |
132 | q{... My::Class->meta()'s method metaclass still does Role::Foo} ); |
133 | ok( My::Class->meta()->instance_metaclass()->meta()->does_role('Role::Foo'), |
134 | q{... My::Class->meta()'s instance metaclass still does Role::Foo} ); |
135 | ok( My::Class->meta()->constructor_class()->meta()->does_role('Role::Foo'), |
136 | q{... My::Class->meta()'s constructor class still does Role::Foo} ); |
137 | |
138 | # same problem as the constructor class |
139 | ok( My::Class->meta()->destructor_class()->can('foo'), |
140 | '... destructor class has a foo method' ); |
141 | } |
142 | |
143 | { |
144 | Moose::Util::MetaRole::apply_base_class_roles( |
145 | for_class => 'My::Class', |
146 | roles => ['Role::Foo'], |
147 | ); |
148 | |
149 | ok( My::Class->meta()->does_role('Role::Foo'), |
150 | 'apply Role::Foo to My::Class base class' ); |
151 | is( My::Class->new()->foo(), 10, |
152 | '... call foo() on a My::Class object' ); |
153 | } |
154 | |
155 | { |
156 | package My::Class2; |
157 | |
158 | use Moose; |
159 | } |
160 | |
161 | { |
162 | Moose::Util::MetaRole::apply_metaclass_roles( |
163 | for_class => 'My::Class2', |
164 | metaclass_roles => ['Role::Foo'], |
165 | attribute_metaclass_roles => ['Role::Foo'], |
166 | method_metaclass_roles => ['Role::Foo'], |
167 | instance_metaclass_roles => ['Role::Foo'], |
168 | constructor_class_roles => ['Role::Foo'], |
169 | destructor_class_roles => ['Role::Foo'], |
170 | ); |
171 | |
172 | ok( My::Class2->meta()->meta()->does_role('Role::Foo'), |
173 | 'apply Role::Foo to My::Class2->meta()' ); |
174 | is( My::Class2->meta()->foo(), 10, |
175 | '... and call foo() on that meta object' ); |
176 | ok( My::Class2->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'), |
177 | q{apply Role::Foo to My::Class2->meta()'s attribute metaclass} ); |
178 | My::Class2->meta()->add_attribute( 'size', is => 'ro' ); |
179 | |
180 | is( My::Class2->meta()->get_attribute('size')->foo(), 10, |
181 | '... call foo() on an attribute metaclass object' ); |
182 | |
183 | ok( My::Class2->meta()->method_metaclass()->meta()->does_role('Role::Foo'), |
184 | q{apply Role::Foo to My::Class2->meta()'s method metaclass} ); |
185 | |
186 | My::Class2->meta()->add_method( 'bar' => sub { 'bar' } ); |
187 | is( My::Class2->meta()->get_method('bar')->foo(), 10, |
188 | '... call foo() on a method metaclass object' ); |
189 | |
190 | ok( My::Class2->meta()->instance_metaclass()->meta()->does_role('Role::Foo'), |
191 | q{apply Role::Foo to My::Class2->meta()'s instance metaclass} ); |
192 | is( My::Class2->meta()->get_meta_instance()->foo(), 10, |
193 | '... call foo() on an instance metaclass object' ); |
194 | |
195 | ok( My::Class2->meta()->constructor_class()->meta()->does_role('Role::Foo'), |
196 | q{apply Role::Foo to My::Class2->meta()'s constructor class} ); |
197 | ok( My::Class2->meta()->constructor_class()->can('foo'), |
198 | '... constructor class has a foo method' ); |
199 | |
200 | ok( My::Class2->meta()->destructor_class()->meta()->does_role('Role::Foo'), |
201 | q{apply Role::Foo to My::Class2->meta()'s destructor class} ); |
202 | ok( My::Class2->meta()->destructor_class()->can('foo'), |
203 | '... destructor class has a foo method' ); |
204 | } |
205 | |
206 | |
207 | { |
208 | package My::Meta; |
209 | |
210 | use Moose::Exporter; |
211 | Moose::Exporter->setup_import_methods( also => 'Moose' ); |
212 | |
213 | sub init_meta { |
214 | shift; |
215 | my %p = @_; |
216 | |
217 | Moose->init_meta( %p, metaclass => 'My::Meta::Class' ); |
218 | } |
219 | } |
220 | |
221 | { |
222 | package My::Class3; |
223 | |
224 | My::Meta->import(); |
225 | } |
226 | |
227 | |
228 | { |
229 | Moose::Util::MetaRole::apply_metaclass_roles( |
230 | for_class => 'My::Class3', |
231 | metaclass_roles => ['Role::Foo'], |
232 | ); |
233 | |
234 | ok( My::Class3->meta()->meta()->does_role('Role::Foo'), |
235 | 'apply Role::Foo to My::Class3->meta()' ); |
236 | is( My::Class3->meta()->foo(), 10, |
237 | '... and call foo() on that meta object' ); |
238 | ok( ( grep { $_ eq 'My::Meta::Class' } My::Class3->meta()->meta()->superclasses() ), |
239 | 'apply_metaclass_roles() does not interfere with metaclass set via Moose->init_meta()' ); |
240 | } |
82b388d5 |
241 | |
242 | { |
243 | package Role::Bar; |
244 | use Moose::Role; |
245 | has 'bar' => ( is => 'ro', default => 200 ); |
246 | } |
247 | |
248 | { |
249 | package My::Class4; |
250 | use Moose; |
251 | } |
252 | |
253 | { |
254 | Moose::Util::MetaRole::apply_metaclass_roles( |
255 | for_class => 'My::Class4', |
256 | metaclass_roles => ['Role::Foo'], |
257 | ); |
258 | |
259 | ok( My::Class4->meta()->meta()->does_role('Role::Foo'), |
260 | 'apply Role::Foo to My::Class4->meta()' ); |
261 | |
262 | Moose::Util::MetaRole::apply_metaclass_roles( |
263 | for_class => 'My::Class4', |
264 | metaclass_roles => ['Role::Bar'], |
265 | ); |
266 | |
267 | ok( My::Class4->meta()->meta()->does_role('Role::Bar'), |
268 | 'apply Role::Bar to My::Class4->meta()' ); |
269 | ok( My::Class4->meta()->meta()->does_role('Role::Foo'), |
270 | '... and My::Class4->meta() still does Role::Foo' ); |
271 | } |
4fed6bbc |
272 | |
273 | { |
274 | package My::Class5; |
275 | use Moose; |
276 | |
277 | extends 'My::Class'; |
278 | } |
279 | |
280 | { |
deed2e7e |
281 | ok( My::Class5->meta()->meta()->does_role('Role::Foo'), |
63647399 |
282 | q{My::Class5->meta()'s does Role::Foo because it extends My::Class} ); |
deed2e7e |
283 | ok( My::Class5->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'), |
4fed6bbc |
284 | q{My::Class5->meta()'s attribute metaclass also does Role::Foo} ); |
deed2e7e |
285 | ok( My::Class5->meta()->method_metaclass()->meta()->does_role('Role::Foo'), |
4fed6bbc |
286 | q{My::Class5->meta()'s method metaclass also does Role::Foo} ); |
deed2e7e |
287 | ok( My::Class5->meta()->instance_metaclass()->meta()->does_role('Role::Foo'), |
4fed6bbc |
288 | q{My::Class5->meta()'s instance metaclass also does Role::Foo} ); |
deed2e7e |
289 | ok( My::Class5->meta()->constructor_class()->meta()->does_role('Role::Foo'), |
4fed6bbc |
290 | q{My::Class5->meta()'s constructor class also does Role::Foo} ); |
deed2e7e |
291 | ok( My::Class5->meta()->destructor_class()->meta()->does_role('Role::Foo'), |
292 | q{My::Class5->meta()'s destructor class also does Role::Foo} ); |
4fed6bbc |
293 | } |
294 | |
295 | { |
296 | Moose::Util::MetaRole::apply_metaclass_roles( |
297 | for_class => 'My::Class5', |
298 | metaclass_roles => ['Role::Bar'], |
299 | ); |
300 | |
301 | ok( My::Class5->meta()->meta()->does_role('Role::Bar'), |
302 | q{apply Role::Bar My::Class5->meta()} ); |
303 | ok( My::Class5->meta()->meta()->does_role('Role::Foo'), |
304 | q{... and My::Class5->meta() still does Role::Foo} ); |
305 | } |
306 | |
4fed6bbc |
307 | { |
308 | package My::Class6; |
309 | use Moose; |
9f82cc33 |
310 | |
4fed6bbc |
311 | Moose::Util::MetaRole::apply_metaclass_roles( |
312 | for_class => 'My::Class6', |
313 | metaclass_roles => ['Role::Bar'], |
314 | ); |
315 | |
316 | extends 'My::Class'; |
317 | } |
318 | |
319 | { |
320 | ok( My::Class6->meta()->meta()->does_role('Role::Bar'), |
321 | q{apply Role::Bar My::Class6->meta() before extends} ); |
322 | ok( My::Class6->meta()->meta()->does_role('Role::Foo'), |
f8b6827f |
323 | q{... and My::Class6->meta() does Role::Foo because My::Class6 extends My::Class} ); |
00c71b9f |
324 | } |
4fed6bbc |
325 | |
f8b6827f |
326 | # This is the hack that used to be needed to work around the |
327 | # _fix_metaclass_incompatibility problem. You called extends() (which |
328 | # in turn calls _fix_metaclass_imcompatibility) _before_ you apply |
329 | # more extensions in the subclass. We wabt to make sure this continues |
330 | # to work in the future. |
4fed6bbc |
331 | { |
332 | package My::Class7; |
333 | use Moose; |
334 | |
335 | # In real usage this would go in a BEGIN block so it happened |
336 | # before apply_metaclass_roles was called by an extension. |
337 | extends 'My::Class'; |
338 | |
339 | Moose::Util::MetaRole::apply_metaclass_roles( |
340 | for_class => 'My::Class7', |
341 | metaclass_roles => ['Role::Bar'], |
342 | ); |
343 | } |
344 | |
345 | { |
346 | ok( My::Class7->meta()->meta()->does_role('Role::Bar'), |
347 | q{apply Role::Bar My::Class7->meta() before extends} ); |
348 | ok( My::Class7->meta()->meta()->does_role('Role::Foo'), |
f8b6827f |
349 | q{... and My::Class7->meta() does Role::Foo because My::Class7 extends My::Class} ); |
350 | } |
351 | |
352 | { |
353 | package My::Class8; |
354 | use Moose; |
355 | |
356 | Moose::Util::MetaRole::apply_metaclass_roles( |
357 | for_class => 'My::Class8', |
358 | metaclass_roles => ['Role::Bar'], |
359 | attribute_metaclass_roles => ['Role::Bar'], |
360 | ); |
361 | |
362 | extends 'My::Class'; |
363 | } |
364 | |
365 | { |
366 | ok( My::Class8->meta()->meta()->does_role('Role::Bar'), |
367 | q{apply Role::Bar My::Class8->meta() before extends} ); |
368 | ok( My::Class8->meta()->meta()->does_role('Role::Foo'), |
369 | q{... and My::Class8->meta() does Role::Foo because My::Class8 extends My::Class} ); |
370 | ok( My::Class8->meta()->attribute_metaclass->meta()->does_role('Role::Bar'), |
371 | q{apply Role::Bar to My::Class8->meta()->attribute_metaclass before extends} ); |
372 | ok( My::Class8->meta()->attribute_metaclass->meta()->does_role('Role::Foo'), |
373 | q{... and My::Class8->meta()->attribute_metaclass does Role::Foo because My::Class8 extends My::Class} ); |
374 | } |
375 | |
376 | |
377 | { |
378 | package My::Class9; |
379 | use Moose; |
380 | |
381 | Moose::Util::MetaRole::apply_metaclass_roles( |
382 | for_class => 'My::Class9', |
383 | attribute_metaclass_roles => ['Role::Bar'], |
384 | ); |
385 | |
386 | extends 'My::Class'; |
387 | } |
388 | |
389 | { |
390 | ok( My::Class9->meta()->meta()->does_role('Role::Foo'), |
391 | q{... and My::Class9->meta() does Role::Foo because My::Class9 extends My::Class} ); |
392 | ok( My::Class9->meta()->attribute_metaclass->meta()->does_role('Role::Bar'), |
393 | q{apply Role::Bar to My::Class9->meta()->attribute_metaclass before extends} ); |
394 | ok( My::Class9->meta()->attribute_metaclass->meta()->does_role('Role::Foo'), |
395 | q{... and My::Class9->meta()->attribute_metaclass does Role::Foo because My::Class9 extends My::Class} ); |
4fed6bbc |
396 | } |
dd37a5be |
397 | |
398 | # This tests applying meta roles to a metaclass's metaclass. This is |
399 | # completely insane, but is exactly what happens with |
400 | # Fey::Meta::Class::Table. It's a subclass of Moose::Meta::Class |
401 | # itself, and then it _uses_ MooseX::ClassAttribute, so the metaclass |
402 | # for Fey::Meta::Class::Table does a role. |
403 | # |
404 | # At one point this caused a metaclass incompatibility error down |
405 | # below, when we applied roles to the metaclass of My::Class10. It's |
406 | # all madness but as long as the tests pass we're happy. |
407 | { |
408 | package My::Meta::Class2; |
409 | use Moose; |
410 | extends 'Moose::Meta::Class'; |
411 | |
412 | Moose::Util::MetaRole::apply_metaclass_roles( |
413 | for_class => 'My::Meta::Class2', |
414 | metaclass_roles => ['Role::Foo'], |
415 | ); |
416 | } |
417 | |
418 | { |
896e6f85 |
419 | package My::Object; |
420 | use Moose; |
421 | extends 'Moose::Object'; |
422 | } |
423 | |
424 | { |
dd37a5be |
425 | package My::Meta2; |
426 | |
427 | use Moose::Exporter; |
428 | Moose::Exporter->setup_import_methods( also => 'Moose' ); |
429 | |
430 | sub init_meta { |
431 | shift; |
432 | my %p = @_; |
433 | |
896e6f85 |
434 | Moose->init_meta( |
435 | %p, |
436 | metaclass => 'My::Meta::Class2', |
437 | base_class => 'My::Object', |
438 | ); |
dd37a5be |
439 | } |
440 | } |
441 | |
442 | { |
443 | package My::Class10; |
444 | My::Meta2->import; |
445 | |
446 | Moose::Util::MetaRole::apply_metaclass_roles( |
447 | for_class => 'My::Class10', |
448 | metaclass_roles => ['Role::Bar'], |
449 | ); |
450 | } |
451 | |
452 | { |
453 | ok( My::Class10->meta()->meta()->meta()->does_role('Role::Foo'), |
454 | q{My::Class10->meta()->meta() does Role::Foo } ); |
b72373c4 |
455 | ok( My::Class10->meta()->meta()->does_role('Role::Bar'), |
456 | q{My::Class10->meta()->meta() does Role::Bar } ); |
dd37a5be |
457 | ok( My::Class10->meta()->isa('My::Meta::Class2'), |
458 | q{... and My::Class10->meta still isa(My::Meta::Class2)} ); |
896e6f85 |
459 | ok( My::Class10->isa('My::Object'), |
460 | q{... and My::Class10 still isa(My::Object)} ); |
dd37a5be |
461 | } |
8f05895e |
462 | |
463 | { |
464 | package My::Constructor; |
465 | |
466 | use base 'Moose::Meta::Method::Constructor'; |
467 | } |
468 | |
469 | { |
470 | package My::Class11; |
471 | |
472 | use Moose; |
473 | |
474 | __PACKAGE__->meta->constructor_class('My::Constructor'); |
475 | |
476 | Moose::Util::MetaRole::apply_metaclass_roles( |
477 | for_class => 'My::Class11', |
478 | metaclass_roles => ['Role::Foo'], |
479 | ); |
480 | } |
481 | |
482 | { |
483 | ok( My::Class11->meta()->meta()->does_role('Role::Foo'), |
484 | q{My::Class11->meta()->meta() does Role::Foo } ); |
485 | is( My::Class11->meta()->constructor_class, 'My::Constructor', |
486 | q{... and explicitly set constructor_class value is unchanged)} ); |
487 | } |
fdeb8354 |
488 | |
489 | { |
490 | package ExportsMoose; |
491 | |
492 | Moose::Exporter->setup_import_methods( |
493 | also => 'Moose', |
494 | ); |
495 | |
496 | sub init_meta { |
497 | shift; |
498 | my %p = @_; |
499 | Moose->init_meta(%p); |
500 | return Moose::Util::MetaRole::apply_metaclass_roles( |
501 | for_class => $p{for_class}, |
502 | # Causes us to recurse through init_meta, as we have to |
503 | # load MyMetaclassRole from disk. |
504 | metaclass_roles => [qw/MyMetaclassRole/], |
505 | ); |
506 | } |
507 | } |
508 | |
509 | lives_ok { |
510 | package UsesExportedMoose; |
511 | ExportsMoose->import; |
512 | } 'import module which loads a role from disk during init_meta'; |
513 | |