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