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