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