Commit | Line | Data |
f785aad8 |
1 | #!/usr/bin/perl |
2 | |
3 | # This is a copy of 015_metarole.t taken on 01/01/2010. It provides a |
4 | # comprehensive test of backwards compatibility in the MetaRole API. |
5 | |
6 | use strict; |
7 | use warnings; |
8 | |
9 | use lib 't/lib', 'lib'; |
10 | |
11 | use Test::More; |
12 | use Test::Exception; |
13 | |
14 | use Moose::Util::MetaRole; |
15 | |
16 | |
17 | { |
18 | package My::Meta::Class; |
19 | use Moose; |
20 | extends 'Moose::Meta::Class'; |
21 | } |
22 | |
23 | { |
24 | package Role::Foo; |
25 | use Moose::Role; |
26 | has 'foo' => ( is => 'ro', default => 10 ); |
27 | } |
28 | |
29 | { |
30 | package My::Class; |
31 | |
32 | use Moose; |
33 | } |
34 | |
35 | { |
36 | package My::Role; |
37 | use Moose::Role; |
38 | } |
39 | |
40 | { |
41 | Moose::Util::MetaRole::apply_metaclass_roles( |
42 | for_class => My::Class->meta, |
43 | metaclass_roles => ['Role::Foo'], |
44 | ); |
45 | |
46 | ok( My::Class->meta()->meta()->does_role('Role::Foo'), |
47 | 'apply Role::Foo to My::Class->meta()' ); |
48 | is( My::Class->meta()->foo(), 10, |
49 | '... and call foo() on that meta object' ); |
50 | } |
51 | |
52 | { |
53 | Moose::Util::MetaRole::apply_metaclass_roles( |
54 | for_class => 'My::Class', |
55 | attribute_metaclass_roles => ['Role::Foo'], |
56 | ); |
57 | |
58 | ok( My::Class->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'), |
59 | q{apply Role::Foo to My::Class->meta()'s attribute metaclass} ); |
60 | ok( My::Class->meta()->meta()->does_role('Role::Foo'), |
61 | '... My::Class->meta() still does Role::Foo' ); |
62 | |
63 | My::Class->meta()->add_attribute( 'size', is => 'ro' ); |
64 | is( My::Class->meta()->get_attribute('size')->foo(), 10, |
65 | '... call foo() on an attribute metaclass object' ); |
66 | } |
67 | |
68 | { |
69 | Moose::Util::MetaRole::apply_metaclass_roles( |
70 | for_class => 'My::Class', |
71 | method_metaclass_roles => ['Role::Foo'], |
72 | ); |
73 | |
74 | ok( My::Class->meta()->method_metaclass()->meta()->does_role('Role::Foo'), |
75 | q{apply Role::Foo to My::Class->meta()'s method metaclass} ); |
76 | ok( My::Class->meta()->meta()->does_role('Role::Foo'), |
77 | '... My::Class->meta() still does Role::Foo' ); |
78 | ok( My::Class->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'), |
79 | q{... My::Class->meta()'s attribute metaclass still does Role::Foo} ); |
80 | |
81 | My::Class->meta()->add_method( 'bar' => sub { 'bar' } ); |
82 | is( My::Class->meta()->get_method('bar')->foo(), 10, |
83 | '... call foo() on a method metaclass object' ); |
84 | } |
85 | |
86 | { |
87 | Moose::Util::MetaRole::apply_metaclass_roles( |
88 | for_class => 'My::Class', |
89 | wrapped_method_metaclass_roles => ['Role::Foo'], |
90 | ); |
91 | |
92 | ok( My::Class->meta()->wrapped_method_metaclass()->meta()->does_role('Role::Foo'), |
93 | q{apply Role::Foo to My::Class->meta()'s wrapped method metaclass} ); |
94 | ok( My::Class->meta()->method_metaclass()->meta()->does_role('Role::Foo'), |
95 | '... My::Class->meta() still does Role::Foo' ); |
96 | ok( My::Class->meta()->meta()->does_role('Role::Foo'), |
97 | '... My::Class->meta() still does Role::Foo' ); |
98 | ok( My::Class->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'), |
99 | q{... My::Class->meta()'s attribute metaclass still does Role::Foo} ); |
100 | |
101 | My::Class->meta()->add_after_method_modifier( 'bar' => sub { 'bar' } ); |
102 | is( My::Class->meta()->get_method('bar')->foo(), 10, |
103 | '... call foo() on a wrapped method metaclass object' ); |
104 | } |
105 | |
106 | { |
107 | Moose::Util::MetaRole::apply_metaclass_roles( |
108 | for_class => 'My::Class', |
109 | instance_metaclass_roles => ['Role::Foo'], |
110 | ); |
111 | |
112 | ok( My::Class->meta()->instance_metaclass()->meta()->does_role('Role::Foo'), |
113 | q{apply Role::Foo to My::Class->meta()'s instance metaclass} ); |
114 | ok( My::Class->meta()->meta()->does_role('Role::Foo'), |
115 | '... My::Class->meta() still does Role::Foo' ); |
116 | ok( My::Class->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'), |
117 | q{... My::Class->meta()'s attribute metaclass still does Role::Foo} ); |
118 | ok( My::Class->meta()->method_metaclass()->meta()->does_role('Role::Foo'), |
119 | q{... My::Class->meta()'s method metaclass still does Role::Foo} ); |
120 | |
121 | is( My::Class->meta()->get_meta_instance()->foo(), 10, |
122 | '... call foo() on an instance metaclass object' ); |
123 | } |
124 | |
125 | { |
126 | Moose::Util::MetaRole::apply_metaclass_roles( |
127 | for_class => 'My::Class', |
128 | constructor_class_roles => ['Role::Foo'], |
129 | ); |
130 | |
131 | ok( My::Class->meta()->constructor_class()->meta()->does_role('Role::Foo'), |
132 | q{apply Role::Foo to My::Class->meta()'s constructor class} ); |
133 | ok( My::Class->meta()->meta()->does_role('Role::Foo'), |
134 | '... My::Class->meta() still does Role::Foo' ); |
135 | ok( My::Class->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'), |
136 | q{... My::Class->meta()'s attribute metaclass still does Role::Foo} ); |
137 | ok( My::Class->meta()->method_metaclass()->meta()->does_role('Role::Foo'), |
138 | q{... My::Class->meta()'s method metaclass still does Role::Foo} ); |
139 | ok( My::Class->meta()->instance_metaclass()->meta()->does_role('Role::Foo'), |
140 | q{... My::Class->meta()'s instance metaclass still does Role::Foo} ); |
141 | |
142 | # Actually instantiating the constructor class is too freaking hard! |
143 | ok( My::Class->meta()->constructor_class()->can('foo'), |
144 | '... constructor class has a foo method' ); |
145 | } |
146 | |
147 | { |
148 | Moose::Util::MetaRole::apply_metaclass_roles( |
149 | for_class => 'My::Class', |
150 | destructor_class_roles => ['Role::Foo'], |
151 | ); |
152 | |
153 | ok( My::Class->meta()->destructor_class()->meta()->does_role('Role::Foo'), |
154 | q{apply Role::Foo to My::Class->meta()'s destructor class} ); |
155 | ok( My::Class->meta()->meta()->does_role('Role::Foo'), |
156 | '... My::Class->meta() still does Role::Foo' ); |
157 | ok( My::Class->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'), |
158 | q{... My::Class->meta()'s attribute metaclass still does Role::Foo} ); |
159 | ok( My::Class->meta()->method_metaclass()->meta()->does_role('Role::Foo'), |
160 | q{... My::Class->meta()'s method metaclass still does Role::Foo} ); |
161 | ok( My::Class->meta()->instance_metaclass()->meta()->does_role('Role::Foo'), |
162 | q{... My::Class->meta()'s instance metaclass still does Role::Foo} ); |
163 | ok( My::Class->meta()->constructor_class()->meta()->does_role('Role::Foo'), |
164 | q{... My::Class->meta()'s constructor class still does Role::Foo} ); |
165 | |
166 | # same problem as the constructor class |
167 | ok( My::Class->meta()->destructor_class()->can('foo'), |
168 | '... destructor class has a foo method' ); |
169 | } |
170 | |
171 | { |
172 | Moose::Util::MetaRole::apply_metaclass_roles( |
173 | for_class => 'My::Role', |
174 | application_to_class_class_roles => ['Role::Foo'], |
175 | ); |
176 | |
177 | ok( My::Role->meta->application_to_class_class->meta->does_role('Role::Foo'), |
178 | q{apply Role::Foo to My::Role->meta's application_to_class class} ); |
179 | |
180 | is( My::Role->meta->application_to_class_class->new->foo, 10, |
181 | q{... call foo() on an application_to_class instance} ); |
182 | } |
183 | |
184 | { |
185 | Moose::Util::MetaRole::apply_metaclass_roles( |
186 | for_class => 'My::Role', |
187 | application_to_role_class_roles => ['Role::Foo'], |
188 | ); |
189 | |
190 | ok( My::Role->meta->application_to_role_class->meta->does_role('Role::Foo'), |
191 | q{apply Role::Foo to My::Role->meta's application_to_role class} ); |
192 | ok( My::Role->meta->application_to_class_class->meta->does_role('Role::Foo'), |
193 | q{... My::Role->meta's application_to_class class still does Role::Foo} ); |
194 | |
195 | is( My::Role->meta->application_to_role_class->new->foo, 10, |
196 | q{... call foo() on an application_to_role instance} ); |
197 | } |
198 | |
199 | { |
200 | Moose::Util::MetaRole::apply_metaclass_roles( |
201 | for_class => 'My::Role', |
202 | application_to_instance_class_roles => ['Role::Foo'], |
203 | ); |
204 | |
205 | ok( My::Role->meta->application_to_instance_class->meta->does_role('Role::Foo'), |
206 | q{apply Role::Foo to My::Role->meta's application_to_instance class} ); |
207 | ok( My::Role->meta->application_to_role_class->meta->does_role('Role::Foo'), |
208 | q{... My::Role->meta's application_to_role class still does Role::Foo} ); |
209 | ok( My::Role->meta->application_to_class_class->meta->does_role('Role::Foo'), |
210 | q{... My::Role->meta's application_to_class class still does Role::Foo} ); |
211 | |
212 | is( My::Role->meta->application_to_instance_class->new->foo, 10, |
213 | q{... call foo() on an application_to_instance instance} ); |
214 | } |
215 | |
216 | { |
217 | Moose::Util::MetaRole::apply_base_class_roles( |
218 | for_class => 'My::Class', |
219 | roles => ['Role::Foo'], |
220 | ); |
221 | |
222 | ok( My::Class->meta()->does_role('Role::Foo'), |
223 | 'apply Role::Foo to My::Class base class' ); |
224 | is( My::Class->new()->foo(), 10, |
225 | '... call foo() on a My::Class object' ); |
226 | } |
227 | |
228 | { |
229 | package My::Class2; |
230 | |
231 | use Moose; |
232 | } |
233 | |
234 | { |
235 | Moose::Util::MetaRole::apply_metaclass_roles( |
236 | for_class => 'My::Class2', |
237 | metaclass_roles => ['Role::Foo'], |
238 | attribute_metaclass_roles => ['Role::Foo'], |
239 | method_metaclass_roles => ['Role::Foo'], |
240 | instance_metaclass_roles => ['Role::Foo'], |
241 | constructor_class_roles => ['Role::Foo'], |
242 | destructor_class_roles => ['Role::Foo'], |
243 | ); |
244 | |
245 | ok( My::Class2->meta()->meta()->does_role('Role::Foo'), |
246 | 'apply Role::Foo to My::Class2->meta()' ); |
247 | is( My::Class2->meta()->foo(), 10, |
248 | '... and call foo() on that meta object' ); |
249 | ok( My::Class2->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'), |
250 | q{apply Role::Foo to My::Class2->meta()'s attribute metaclass} ); |
251 | My::Class2->meta()->add_attribute( 'size', is => 'ro' ); |
252 | |
253 | is( My::Class2->meta()->get_attribute('size')->foo(), 10, |
254 | '... call foo() on an attribute metaclass object' ); |
255 | |
256 | ok( My::Class2->meta()->method_metaclass()->meta()->does_role('Role::Foo'), |
257 | q{apply Role::Foo to My::Class2->meta()'s method metaclass} ); |
258 | |
259 | My::Class2->meta()->add_method( 'bar' => sub { 'bar' } ); |
260 | is( My::Class2->meta()->get_method('bar')->foo(), 10, |
261 | '... call foo() on a method metaclass object' ); |
262 | |
263 | ok( My::Class2->meta()->instance_metaclass()->meta()->does_role('Role::Foo'), |
264 | q{apply Role::Foo to My::Class2->meta()'s instance metaclass} ); |
265 | is( My::Class2->meta()->get_meta_instance()->foo(), 10, |
266 | '... call foo() on an instance metaclass object' ); |
267 | |
268 | ok( My::Class2->meta()->constructor_class()->meta()->does_role('Role::Foo'), |
269 | q{apply Role::Foo to My::Class2->meta()'s constructor class} ); |
270 | ok( My::Class2->meta()->constructor_class()->can('foo'), |
271 | '... constructor class has a foo method' ); |
272 | |
273 | ok( My::Class2->meta()->destructor_class()->meta()->does_role('Role::Foo'), |
274 | q{apply Role::Foo to My::Class2->meta()'s destructor class} ); |
275 | ok( My::Class2->meta()->destructor_class()->can('foo'), |
276 | '... destructor class has a foo method' ); |
277 | } |
278 | |
279 | |
280 | { |
281 | package My::Meta; |
282 | |
283 | use Moose::Exporter; |
284 | Moose::Exporter->setup_import_methods( also => 'Moose' ); |
285 | |
286 | sub init_meta { |
287 | shift; |
288 | my %p = @_; |
289 | |
290 | Moose->init_meta( %p, metaclass => 'My::Meta::Class' ); |
291 | } |
292 | } |
293 | |
294 | { |
295 | package My::Class3; |
296 | |
297 | My::Meta->import(); |
298 | } |
299 | |
300 | |
301 | { |
302 | Moose::Util::MetaRole::apply_metaclass_roles( |
303 | for_class => 'My::Class3', |
304 | metaclass_roles => ['Role::Foo'], |
305 | ); |
306 | |
307 | ok( My::Class3->meta()->meta()->does_role('Role::Foo'), |
308 | 'apply Role::Foo to My::Class3->meta()' ); |
309 | is( My::Class3->meta()->foo(), 10, |
310 | '... and call foo() on that meta object' ); |
311 | ok( ( grep { $_ eq 'My::Meta::Class' } My::Class3->meta()->meta()->superclasses() ), |
312 | 'apply_metaclass_roles() does not interfere with metaclass set via Moose->init_meta()' ); |
313 | } |
314 | |
315 | { |
316 | package Role::Bar; |
317 | use Moose::Role; |
318 | has 'bar' => ( is => 'ro', default => 200 ); |
319 | } |
320 | |
321 | { |
322 | package My::Class4; |
323 | use Moose; |
324 | } |
325 | |
326 | { |
327 | Moose::Util::MetaRole::apply_metaclass_roles( |
328 | for_class => 'My::Class4', |
329 | metaclass_roles => ['Role::Foo'], |
330 | ); |
331 | |
332 | ok( My::Class4->meta()->meta()->does_role('Role::Foo'), |
333 | 'apply Role::Foo to My::Class4->meta()' ); |
334 | |
335 | Moose::Util::MetaRole::apply_metaclass_roles( |
336 | for_class => 'My::Class4', |
337 | metaclass_roles => ['Role::Bar'], |
338 | ); |
339 | |
340 | ok( My::Class4->meta()->meta()->does_role('Role::Bar'), |
341 | 'apply Role::Bar to My::Class4->meta()' ); |
342 | ok( My::Class4->meta()->meta()->does_role('Role::Foo'), |
343 | '... and My::Class4->meta() still does Role::Foo' ); |
344 | } |
345 | |
346 | { |
347 | package My::Class5; |
348 | use Moose; |
349 | |
350 | extends 'My::Class'; |
351 | } |
352 | |
353 | { |
354 | ok( My::Class5->meta()->meta()->does_role('Role::Foo'), |
355 | q{My::Class5->meta()'s does Role::Foo because it extends My::Class} ); |
356 | ok( My::Class5->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'), |
357 | q{My::Class5->meta()'s attribute metaclass also does Role::Foo} ); |
358 | ok( My::Class5->meta()->method_metaclass()->meta()->does_role('Role::Foo'), |
359 | q{My::Class5->meta()'s method metaclass also does Role::Foo} ); |
360 | ok( My::Class5->meta()->instance_metaclass()->meta()->does_role('Role::Foo'), |
361 | q{My::Class5->meta()'s instance metaclass also does Role::Foo} ); |
362 | ok( My::Class5->meta()->constructor_class()->meta()->does_role('Role::Foo'), |
363 | q{My::Class5->meta()'s constructor class also does Role::Foo} ); |
364 | ok( My::Class5->meta()->destructor_class()->meta()->does_role('Role::Foo'), |
365 | q{My::Class5->meta()'s destructor class also does Role::Foo} ); |
366 | } |
367 | |
368 | { |
369 | Moose::Util::MetaRole::apply_metaclass_roles( |
370 | for_class => 'My::Class5', |
371 | metaclass_roles => ['Role::Bar'], |
372 | ); |
373 | |
374 | ok( My::Class5->meta()->meta()->does_role('Role::Bar'), |
375 | q{apply Role::Bar My::Class5->meta()} ); |
376 | ok( My::Class5->meta()->meta()->does_role('Role::Foo'), |
377 | q{... and My::Class5->meta() still does Role::Foo} ); |
378 | } |
379 | |
380 | { |
381 | package My::Class6; |
382 | use Moose; |
383 | |
384 | Moose::Util::MetaRole::apply_metaclass_roles( |
385 | for_class => 'My::Class6', |
386 | metaclass_roles => ['Role::Bar'], |
387 | ); |
388 | |
389 | extends 'My::Class'; |
390 | } |
391 | |
392 | { |
393 | ok( My::Class6->meta()->meta()->does_role('Role::Bar'), |
394 | q{apply Role::Bar My::Class6->meta() before extends} ); |
395 | ok( My::Class6->meta()->meta()->does_role('Role::Foo'), |
396 | q{... and My::Class6->meta() does Role::Foo because My::Class6 extends My::Class} ); |
397 | } |
398 | |
399 | # This is the hack that used to be needed to work around the |
400 | # _fix_metaclass_incompatibility problem. You called extends() (which |
401 | # in turn calls _fix_metaclass_imcompatibility) _before_ you apply |
402 | # more extensions in the subclass. We wabt to make sure this continues |
403 | # to work in the future. |
404 | { |
405 | package My::Class7; |
406 | use Moose; |
407 | |
408 | # In real usage this would go in a BEGIN block so it happened |
409 | # before apply_metaclass_roles was called by an extension. |
410 | extends 'My::Class'; |
411 | |
412 | Moose::Util::MetaRole::apply_metaclass_roles( |
413 | for_class => 'My::Class7', |
414 | metaclass_roles => ['Role::Bar'], |
415 | ); |
416 | } |
417 | |
418 | { |
419 | ok( My::Class7->meta()->meta()->does_role('Role::Bar'), |
420 | q{apply Role::Bar My::Class7->meta() before extends} ); |
421 | ok( My::Class7->meta()->meta()->does_role('Role::Foo'), |
422 | q{... and My::Class7->meta() does Role::Foo because My::Class7 extends My::Class} ); |
423 | } |
424 | |
425 | { |
426 | package My::Class8; |
427 | use Moose; |
428 | |
429 | Moose::Util::MetaRole::apply_metaclass_roles( |
430 | for_class => 'My::Class8', |
431 | metaclass_roles => ['Role::Bar'], |
432 | attribute_metaclass_roles => ['Role::Bar'], |
433 | ); |
434 | |
435 | extends 'My::Class'; |
436 | } |
437 | |
438 | { |
439 | ok( My::Class8->meta()->meta()->does_role('Role::Bar'), |
440 | q{apply Role::Bar My::Class8->meta() before extends} ); |
441 | ok( My::Class8->meta()->meta()->does_role('Role::Foo'), |
442 | q{... and My::Class8->meta() does Role::Foo because My::Class8 extends My::Class} ); |
443 | ok( My::Class8->meta()->attribute_metaclass->meta()->does_role('Role::Bar'), |
444 | q{apply Role::Bar to My::Class8->meta()->attribute_metaclass before extends} ); |
445 | ok( My::Class8->meta()->attribute_metaclass->meta()->does_role('Role::Foo'), |
446 | q{... and My::Class8->meta()->attribute_metaclass does Role::Foo because My::Class8 extends My::Class} ); |
447 | } |
448 | |
449 | |
450 | { |
451 | package My::Class9; |
452 | use Moose; |
453 | |
454 | Moose::Util::MetaRole::apply_metaclass_roles( |
455 | for_class => 'My::Class9', |
456 | attribute_metaclass_roles => ['Role::Bar'], |
457 | ); |
458 | |
459 | extends 'My::Class'; |
460 | } |
461 | |
462 | { |
463 | ok( My::Class9->meta()->meta()->does_role('Role::Foo'), |
464 | q{... and My::Class9->meta() does Role::Foo because My::Class9 extends My::Class} ); |
465 | ok( My::Class9->meta()->attribute_metaclass->meta()->does_role('Role::Bar'), |
466 | q{apply Role::Bar to My::Class9->meta()->attribute_metaclass before extends} ); |
467 | ok( My::Class9->meta()->attribute_metaclass->meta()->does_role('Role::Foo'), |
468 | q{... and My::Class9->meta()->attribute_metaclass does Role::Foo because My::Class9 extends My::Class} ); |
469 | } |
470 | |
471 | # This tests applying meta roles to a metaclass's metaclass. This is |
472 | # completely insane, but is exactly what happens with |
473 | # Fey::Meta::Class::Table. It's a subclass of Moose::Meta::Class |
474 | # itself, and then it _uses_ MooseX::ClassAttribute, so the metaclass |
475 | # for Fey::Meta::Class::Table does a role. |
476 | # |
477 | # At one point this caused a metaclass incompatibility error down |
478 | # below, when we applied roles to the metaclass of My::Class10. It's |
479 | # all madness but as long as the tests pass we're happy. |
480 | { |
481 | package My::Meta::Class2; |
482 | use Moose; |
483 | extends 'Moose::Meta::Class'; |
484 | |
485 | Moose::Util::MetaRole::apply_metaclass_roles( |
486 | for_class => 'My::Meta::Class2', |
487 | metaclass_roles => ['Role::Foo'], |
488 | ); |
489 | } |
490 | |
491 | { |
492 | package My::Object; |
493 | use Moose; |
494 | extends 'Moose::Object'; |
495 | } |
496 | |
497 | { |
498 | package My::Meta2; |
499 | |
500 | use Moose::Exporter; |
501 | Moose::Exporter->setup_import_methods( also => 'Moose' ); |
502 | |
503 | sub init_meta { |
504 | shift; |
505 | my %p = @_; |
506 | |
507 | Moose->init_meta( |
508 | %p, |
509 | metaclass => 'My::Meta::Class2', |
510 | base_class => 'My::Object', |
511 | ); |
512 | } |
513 | } |
514 | |
515 | { |
516 | package My::Class10; |
517 | My::Meta2->import; |
518 | |
519 | Moose::Util::MetaRole::apply_metaclass_roles( |
520 | for_class => 'My::Class10', |
521 | metaclass_roles => ['Role::Bar'], |
522 | ); |
523 | } |
524 | |
525 | { |
526 | ok( My::Class10->meta()->meta()->meta()->does_role('Role::Foo'), |
527 | q{My::Class10->meta()->meta() does Role::Foo } ); |
528 | ok( My::Class10->meta()->meta()->does_role('Role::Bar'), |
529 | q{My::Class10->meta()->meta() does Role::Bar } ); |
530 | ok( My::Class10->meta()->isa('My::Meta::Class2'), |
531 | q{... and My::Class10->meta still isa(My::Meta::Class2)} ); |
532 | ok( My::Class10->isa('My::Object'), |
533 | q{... and My::Class10 still isa(My::Object)} ); |
534 | } |
535 | |
536 | { |
537 | package My::Constructor; |
538 | |
539 | use base 'Moose::Meta::Method::Constructor'; |
540 | } |
541 | |
542 | { |
543 | package My::Class11; |
544 | |
545 | use Moose; |
546 | |
547 | __PACKAGE__->meta->constructor_class('My::Constructor'); |
548 | |
549 | Moose::Util::MetaRole::apply_metaclass_roles( |
550 | for_class => 'My::Class11', |
551 | metaclass_roles => ['Role::Foo'], |
552 | ); |
553 | } |
554 | |
555 | { |
556 | ok( My::Class11->meta()->meta()->does_role('Role::Foo'), |
557 | q{My::Class11->meta()->meta() does Role::Foo } ); |
558 | is( My::Class11->meta()->constructor_class, 'My::Constructor', |
559 | q{... and explicitly set constructor_class value is unchanged)} ); |
560 | } |
561 | |
562 | { |
563 | package ExportsMoose; |
564 | |
565 | Moose::Exporter->setup_import_methods( |
566 | also => 'Moose', |
567 | ); |
568 | |
569 | sub init_meta { |
570 | shift; |
571 | my %p = @_; |
572 | Moose->init_meta(%p); |
573 | return Moose::Util::MetaRole::apply_metaclass_roles( |
574 | for_class => $p{for_class}, |
575 | # Causes us to recurse through init_meta, as we have to |
576 | # load MyMetaclassRole from disk. |
577 | metaclass_roles => [qw/MyMetaclassRole/], |
578 | ); |
579 | } |
580 | } |
581 | |
582 | lives_ok { |
583 | package UsesExportedMoose; |
584 | ExportsMoose->import; |
585 | } 'import module which loads a role from disk during init_meta'; |
586 | |
587 | { |
588 | package Foo::Meta::Role; |
589 | |
590 | use Moose::Role; |
591 | } |
592 | { |
593 | package Foo::Role; |
594 | |
595 | Moose::Exporter->setup_import_methods( |
596 | also => 'Moose::Role', |
597 | ); |
598 | |
599 | sub init_meta { |
600 | shift; |
601 | my %p = @_; |
602 | Moose::Role->init_meta(%p); |
603 | return Moose::Util::MetaRole::apply_metaclass_roles( |
604 | for_class => $p{for_class}, |
605 | method_metaclass_roles => [ 'Foo::Meta::Role', ], |
606 | ); |
607 | } |
608 | } |
609 | { |
610 | package Role::Baz; |
611 | |
612 | Foo::Role->import; |
613 | |
614 | sub bla {} |
615 | } |
616 | { |
617 | package My::Class12; |
618 | |
619 | use Moose; |
620 | |
621 | with( 'Role::Baz' ); |
622 | } |
623 | { |
624 | ok( |
625 | My::Class12->meta->does_role( 'Role::Baz' ), |
626 | 'role applied' |
627 | ); |
628 | my $method = My::Class12->meta->get_method( 'bla' ); |
629 | ok( |
630 | $method->meta->does_role( 'Foo::Meta::Role' ), |
631 | 'method_metaclass_role applied' |
632 | ); |
633 | } |
634 | |
635 | { |
636 | package Parent; |
637 | use Moose; |
638 | |
639 | Moose::Util::MetaRole::apply_metaclass_roles( |
640 | for_class => __PACKAGE__, |
641 | constructor_class_roles => ['Role::Foo'], |
642 | ); |
643 | } |
644 | |
645 | { |
646 | package Child; |
647 | |
648 | use Moose; |
649 | extends 'Parent'; |
650 | } |
651 | |
652 | { |
653 | ok( |
654 | Parent->meta->constructor_class->meta->can('does_role') |
655 | && Parent->meta->constructor_class->meta->does_role('Role::Foo'), |
656 | 'Parent constructor class has metarole from Parent' |
657 | ); |
658 | |
63eeb72b |
659 | ok( |
660 | Child->meta->constructor_class->meta->can('does_role') |
661 | && Child->meta->constructor_class->meta->does_role( |
662 | 'Role::Foo'), |
663 | 'Child constructor class has metarole from Parent' |
664 | ); |
f785aad8 |
665 | } |
666 | |
667 | done_testing; |