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 | |
d6c64f2b |
352 | ## TODO@2009/11/17 |
353 | |
354 | exit(0); |
355 | |
41888e7d |
356 | { |
357 | package My::Class5; |
358 | use Mouse; |
3c7ae143 |
359 | |
41888e7d |
360 | extends 'My::Class'; |
361 | } |
362 | |
363 | { |
364 | ok( My::Class5->meta()->meta()->does_role('Role::Foo'), |
365 | q{My::Class5->meta()'s does Role::Foo because it extends My::Class} ); |
366 | ok( My::Class5->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'), |
367 | q{My::Class5->meta()'s attribute metaclass also does Role::Foo} ); |
368 | ok( My::Class5->meta()->method_metaclass()->meta()->does_role('Role::Foo'), |
369 | q{My::Class5->meta()'s method metaclass also does Role::Foo} ); |
370 | ok( My::Class5->meta()->instance_metaclass()->meta()->does_role('Role::Foo'), |
371 | q{My::Class5->meta()'s instance metaclass also does Role::Foo} ); |
372 | ok( My::Class5->meta()->constructor_class()->meta()->does_role('Role::Foo'), |
373 | q{My::Class5->meta()'s constructor class also does Role::Foo} ); |
374 | ok( My::Class5->meta()->destructor_class()->meta()->does_role('Role::Foo'), |
375 | q{My::Class5->meta()'s destructor class also does Role::Foo} ); |
376 | } |
d6c64f2b |
377 | exit; |
41888e7d |
378 | { |
379 | Mouse::Util::MetaRole::apply_metaclass_roles( |
380 | for_class => 'My::Class5', |
381 | metaclass_roles => ['Role::Bar'], |
382 | ); |
383 | |
384 | ok( My::Class5->meta()->meta()->does_role('Role::Bar'), |
385 | q{apply Role::Bar My::Class5->meta()} ); |
386 | ok( My::Class5->meta()->meta()->does_role('Role::Foo'), |
387 | q{... and My::Class5->meta() still does Role::Foo} ); |
388 | } |
389 | |
390 | { |
391 | package My::Class6; |
392 | use Mouse; |
393 | |
394 | Mouse::Util::MetaRole::apply_metaclass_roles( |
395 | for_class => 'My::Class6', |
396 | metaclass_roles => ['Role::Bar'], |
397 | ); |
398 | |
399 | extends 'My::Class'; |
400 | } |
401 | |
402 | { |
403 | ok( My::Class6->meta()->meta()->does_role('Role::Bar'), |
404 | q{apply Role::Bar My::Class6->meta() before extends} ); |
405 | ok( My::Class6->meta()->meta()->does_role('Role::Foo'), |
406 | q{... and My::Class6->meta() does Role::Foo because My::Class6 extends My::Class} ); |
407 | } |
408 | |
409 | # This is the hack that used to be needed to work around the |
410 | # _fix_metaclass_incompatibility problem. You called extends() (which |
411 | # in turn calls _fix_metaclass_imcompatibility) _before_ you apply |
412 | # more extensions in the subclass. We wabt to make sure this continues |
413 | # to work in the future. |
414 | { |
415 | package My::Class7; |
416 | use Mouse; |
417 | |
418 | # In real usage this would go in a BEGIN block so it happened |
419 | # before apply_metaclass_roles was called by an extension. |
420 | extends 'My::Class'; |
421 | |
422 | Mouse::Util::MetaRole::apply_metaclass_roles( |
423 | for_class => 'My::Class7', |
424 | metaclass_roles => ['Role::Bar'], |
425 | ); |
426 | } |
427 | |
428 | { |
429 | ok( My::Class7->meta()->meta()->does_role('Role::Bar'), |
430 | q{apply Role::Bar My::Class7->meta() before extends} ); |
431 | ok( My::Class7->meta()->meta()->does_role('Role::Foo'), |
432 | q{... and My::Class7->meta() does Role::Foo because My::Class7 extends My::Class} ); |
433 | } |
434 | |
435 | { |
436 | package My::Class8; |
437 | use Mouse; |
438 | |
439 | Mouse::Util::MetaRole::apply_metaclass_roles( |
440 | for_class => 'My::Class8', |
441 | metaclass_roles => ['Role::Bar'], |
442 | attribute_metaclass_roles => ['Role::Bar'], |
443 | ); |
444 | |
445 | extends 'My::Class'; |
446 | } |
447 | |
448 | { |
449 | ok( My::Class8->meta()->meta()->does_role('Role::Bar'), |
450 | q{apply Role::Bar My::Class8->meta() before extends} ); |
451 | ok( My::Class8->meta()->meta()->does_role('Role::Foo'), |
452 | q{... and My::Class8->meta() does Role::Foo because My::Class8 extends My::Class} ); |
453 | ok( My::Class8->meta()->attribute_metaclass->meta()->does_role('Role::Bar'), |
454 | q{apply Role::Bar to My::Class8->meta()->attribute_metaclass before extends} ); |
455 | ok( My::Class8->meta()->attribute_metaclass->meta()->does_role('Role::Foo'), |
456 | q{... and My::Class8->meta()->attribute_metaclass does Role::Foo because My::Class8 extends My::Class} ); |
457 | } |
458 | |
459 | |
460 | { |
461 | package My::Class9; |
462 | use Mouse; |
463 | |
464 | Mouse::Util::MetaRole::apply_metaclass_roles( |
465 | for_class => 'My::Class9', |
466 | attribute_metaclass_roles => ['Role::Bar'], |
467 | ); |
468 | |
469 | extends 'My::Class'; |
470 | } |
471 | |
472 | { |
473 | ok( My::Class9->meta()->meta()->does_role('Role::Foo'), |
474 | q{... and My::Class9->meta() does Role::Foo because My::Class9 extends My::Class} ); |
475 | ok( My::Class9->meta()->attribute_metaclass->meta()->does_role('Role::Bar'), |
476 | q{apply Role::Bar to My::Class9->meta()->attribute_metaclass before extends} ); |
477 | ok( My::Class9->meta()->attribute_metaclass->meta()->does_role('Role::Foo'), |
478 | q{... and My::Class9->meta()->attribute_metaclass does Role::Foo because My::Class9 extends My::Class} ); |
479 | } |
480 | |
481 | # This tests applying meta roles to a metaclass's metaclass. This is |
482 | # completely insane, but is exactly what happens with |
483 | # Fey::Meta::Class::Table. It's a subclass of Mouse::Meta::Class |
484 | # itself, and then it _uses_ MouseX::ClassAttribute, so the metaclass |
485 | # for Fey::Meta::Class::Table does a role. |
486 | # |
487 | # At one point this caused a metaclass incompatibility error down |
488 | # below, when we applied roles to the metaclass of My::Class10. It's |
489 | # all madness but as long as the tests pass we're happy. |
490 | { |
491 | package My::Meta::Class2; |
492 | use Mouse; |
493 | extends 'Mouse::Meta::Class'; |
494 | |
495 | Mouse::Util::MetaRole::apply_metaclass_roles( |
496 | for_class => 'My::Meta::Class2', |
497 | metaclass_roles => ['Role::Foo'], |
498 | ); |
499 | } |
500 | |
501 | { |
502 | package My::Object; |
503 | use Mouse; |
504 | extends 'Mouse::Object'; |
505 | } |
506 | |
507 | { |
508 | package My::Meta2; |
509 | |
510 | use Mouse::Exporter; |
511 | Mouse::Exporter->setup_import_methods( also => 'Mouse' ); |
512 | |
513 | sub init_meta { |
514 | shift; |
515 | my %p = @_; |
516 | |
517 | Mouse->init_meta( |
518 | %p, |
519 | metaclass => 'My::Meta::Class2', |
520 | base_class => 'My::Object', |
521 | ); |
522 | } |
523 | } |
524 | |
525 | { |
526 | package My::Class10; |
527 | My::Meta2->import; |
528 | |
529 | Mouse::Util::MetaRole::apply_metaclass_roles( |
530 | for_class => 'My::Class10', |
531 | metaclass_roles => ['Role::Bar'], |
532 | ); |
533 | } |
534 | |
535 | { |
536 | ok( My::Class10->meta()->meta()->meta()->does_role('Role::Foo'), |
537 | q{My::Class10->meta()->meta() does Role::Foo } ); |
538 | ok( My::Class10->meta()->meta()->does_role('Role::Bar'), |
539 | q{My::Class10->meta()->meta() does Role::Bar } ); |
540 | ok( My::Class10->meta()->isa('My::Meta::Class2'), |
541 | q{... and My::Class10->meta still isa(My::Meta::Class2)} ); |
542 | ok( My::Class10->isa('My::Object'), |
543 | q{... and My::Class10 still isa(My::Object)} ); |
544 | } |
545 | |
546 | { |
547 | package My::Constructor; |
548 | |
549 | use base 'Mouse::Meta::Method::Constructor'; |
550 | } |
551 | |
552 | { |
553 | package My::Class11; |
554 | |
555 | use Mouse; |
556 | |
557 | __PACKAGE__->meta->constructor_class('My::Constructor'); |
558 | |
559 | Mouse::Util::MetaRole::apply_metaclass_roles( |
560 | for_class => 'My::Class11', |
561 | metaclass_roles => ['Role::Foo'], |
562 | ); |
563 | } |
564 | |
565 | { |
566 | ok( My::Class11->meta()->meta()->does_role('Role::Foo'), |
567 | q{My::Class11->meta()->meta() does Role::Foo } ); |
568 | is( My::Class11->meta()->constructor_class, 'My::Constructor', |
569 | q{... and explicitly set constructor_class value is unchanged)} ); |
570 | } |
571 | |
572 | { |
573 | package ExportsMouse; |
574 | |
575 | Mouse::Exporter->setup_import_methods( |
576 | also => 'Mouse', |
577 | ); |
578 | |
579 | sub init_meta { |
580 | shift; |
581 | my %p = @_; |
582 | Mouse->init_meta(%p); |
583 | return Mouse::Util::MetaRole::apply_metaclass_roles( |
584 | for_class => $p{for_class}, |
585 | # Causes us to recurse through init_meta, as we have to |
586 | # load MyMetaclassRole from disk. |
587 | metaclass_roles => [qw/MyMetaclassRole/], |
588 | ); |
589 | } |
590 | } |
591 | |
592 | lives_ok { |
593 | package UsesExportedMouse; |
594 | ExportsMouse->import; |
595 | } 'import module which loads a role from disk during init_meta'; |
596 | |
597 | { |
598 | package Foo::Meta::Role; |
599 | |
600 | use Mouse::Role; |
601 | } |
602 | { |
603 | package Foo::Role; |
604 | |
605 | Mouse::Exporter->setup_import_methods( |
606 | also => 'Mouse::Role', |
607 | ); |
608 | |
609 | sub init_meta { |
610 | shift; |
611 | my %p = @_; |
612 | Mouse::Role->init_meta(%p); |
613 | return Mouse::Util::MetaRole::apply_metaclass_roles( |
614 | for_class => $p{for_class}, |
615 | method_metaclass_roles => [ 'Foo::Meta::Role', ], |
616 | ); |
617 | } |
618 | } |
619 | { |
620 | package Role::Baz; |
621 | |
622 | Foo::Role->import; |
623 | |
624 | sub bla {} |
625 | } |
626 | { |
627 | package My::Class12; |
628 | |
629 | use Mouse; |
630 | |
631 | with( 'Role::Baz' ); |
632 | } |
633 | { |
634 | ok( |
635 | My::Class12->meta->does_role( 'Role::Baz' ), |
636 | 'role applied' |
637 | ); |
638 | my $method = My::Class12->meta->get_method( 'bla' ); |
639 | ok( |
640 | $method->meta->does_role( 'Foo::Meta::Role' ), |
641 | 'method_metaclass_role applied' |
642 | ); |
643 | } |
644 | |
645 | { |
646 | package Parent; |
647 | use Mouse; |
648 | |
649 | Mouse::Util::MetaRole::apply_metaclass_roles( |
650 | for_class => __PACKAGE__, |
651 | constructor_class_roles => ['Role::Foo'], |
652 | ); |
653 | } |
654 | |
655 | { |
656 | package Child; |
657 | |
658 | use Mouse; |
659 | extends 'Parent'; |
660 | } |
661 | |
662 | { |
663 | ok( |
664 | Parent->meta->constructor_class->meta->can('does_role') |
665 | && Parent->meta->constructor_class->meta->does_role('Role::Foo'), |
666 | 'Parent constructor class has metarole from Parent' |
667 | ); |
668 | |
669 | TODO: |
670 | { |
671 | local $TODO |
672 | = 'Mouse does not see that the child differs from the parent because it only checks the class and instance metaclasses do determine compatibility'; |
673 | ok( |
674 | Child->meta->constructor_class->meta->can('does_role') |
675 | && Child->meta->constructor_class->meta->does_role( |
676 | 'Role::Foo'), |
677 | 'Child constructor class has metarole from Parent' |
678 | ); |
679 | } |
680 | } |