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