6 use lib 't/lib', 'lib';
8 use Test::More 'no_plan';
11 use Mouse::Util::MetaRole;
15 package My::Meta::Class;
17 extends 'Mouse::Meta::Class';
23 has 'foo' => ( is => 'ro', default => 10 );
38 Mouse::Util::MetaRole::apply_metaclass_roles(
39 for_class => My::Class->meta,
40 metaclass_roles => ['Role::Foo'],
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' );
50 Mouse::Util::MetaRole::apply_metaclass_roles(
51 for_class => 'My::Class',
52 attribute_metaclass_roles => ['Role::Foo'],
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' );
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' );
66 Mouse::Util::MetaRole::apply_metaclass_roles(
67 for_class => 'My::Class',
68 method_metaclass_roles => ['Role::Foo'],
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} );
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' );
85 Mouse::Util::MetaRole::apply_metaclass_roles(
86 for_class => 'My::Class',
87 wrapped_method_metaclass_roles => ['Role::Foo'],
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} );
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' );
107 Mouse::Util::MetaRole::apply_metaclass_roles(
108 for_class => 'My::Class',
109 instance_metaclass_roles => ['Role::Foo'],
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} );
121 is( My::Class->meta()->get_meta_instance()->foo(), 10,
122 '... call foo() on an instance metaclass object' );
126 Mouse::Util::MetaRole::apply_metaclass_roles(
127 for_class => 'My::Class',
128 constructor_class_roles => ['Role::Foo'],
131 ok( My::Class->meta()->constructor_class()->meta()->does_role('Role::Foo'),
132 q{apply Role::Foo to My::Class->meta()'s constructor class} );
133 ok( My::Class->meta()->meta()->does_role('Role::Foo'),
134 '... My::Class->meta() still does Role::Foo' );
135 ok( My::Class->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'),
136 q{... My::Class->meta()'s attribute metaclass still does Role::Foo} );
137 ok( My::Class->meta()->method_metaclass()->meta()->does_role('Role::Foo'),
138 q{... My::Class->meta()'s method metaclass still does Role::Foo} );
139 # ok( My::Class->meta()->instance_metaclass()->meta()->does_role('Role::Foo'),
140 # q{... My::Class->meta()'s instance metaclass still does Role::Foo} );
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' );
148 Mouse::Util::MetaRole::apply_metaclass_roles(
149 for_class => 'My::Class',
150 destructor_class_roles => ['Role::Foo'],
153 ok( My::Class->meta()->destructor_class()->meta()->does_role('Role::Foo'),
154 q{apply Role::Foo to My::Class->meta()'s destructor class} );
155 ok( My::Class->meta()->meta()->does_role('Role::Foo'),
156 '... My::Class->meta() still does Role::Foo' );
157 ok( My::Class->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'),
158 q{... My::Class->meta()'s attribute metaclass still does Role::Foo} );
159 ok( My::Class->meta()->method_metaclass()->meta()->does_role('Role::Foo'),
160 q{... My::Class->meta()'s method metaclass still does Role::Foo} );
161 # ok( My::Class->meta()->instance_metaclass()->meta()->does_role('Role::Foo'),
162 # q{... My::Class->meta()'s instance metaclass still does Role::Foo} );
163 ok( My::Class->meta()->constructor_class()->meta()->does_role('Role::Foo'),
164 q{... My::Class->meta()'s constructor class still does Role::Foo} );
166 # same problem as the constructor class
167 ok( My::Class->meta()->destructor_class()->can('foo'),
168 '... destructor class has a foo method' );
174 Mouse::Util::MetaRole::apply_metaclass_roles(
175 for_class => 'My::Role',
176 application_to_class_class_roles => ['Role::Foo'],
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} );
182 is( My::Role->meta->application_to_class_class->new->foo, 10,
183 q{... call foo() on an application_to_class instance} );
189 Mouse::Util::MetaRole::apply_metaclass_roles(
190 for_class => 'My::Role',
191 application_to_role_class_roles => ['Role::Foo'],
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} );
199 is( My::Role->meta->application_to_role_class->new->foo, 10,
200 q{... call foo() on an application_to_role instance} );
206 Mouse::Util::MetaRole::apply_metaclass_roles(
207 for_class => 'My::Role',
208 application_to_instance_class_roles => ['Role::Foo'],
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} );
218 is( My::Role->meta->application_to_instance_class->new->foo, 10,
219 q{... call foo() on an application_to_instance instance} );
223 Mouse::Util::MetaRole::apply_base_class_roles(
224 for_class => 'My::Class',
225 roles => ['Role::Foo'],
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' );
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'],
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' );
259 is( My::Class2->meta()->get_attribute('size')->foo(), 10,
260 '... call foo() on an attribute metaclass object' );
262 ok( My::Class2->meta()->method_metaclass()->meta()->does_role('Role::Foo'),
263 q{apply Role::Foo to My::Class2->meta()'s method metaclass} );
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' );
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' );
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' );
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' );
290 Mouse::Exporter->setup_import_methods( also => 'Mouse' );
296 Mouse->init_meta( %p, metaclass => 'My::Meta::Class' );
308 Mouse::Util::MetaRole::apply_metaclass_roles(
309 for_class => 'My::Class3',
310 metaclass_roles => ['Role::Foo'],
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()' );
324 has 'bar' => ( is => 'ro', default => 200 );
333 Mouse::Util::MetaRole::apply_metaclass_roles(
334 for_class => 'My::Class4',
335 metaclass_roles => ['Role::Foo'],
338 ok( My::Class4->meta()->meta()->does_role('Role::Foo'),
339 'apply Role::Foo to My::Class4->meta()' );
341 Mouse::Util::MetaRole::apply_metaclass_roles(
342 for_class => 'My::Class4',
343 metaclass_roles => ['Role::Bar'],
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' );
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} );
379 Mouse::Util::MetaRole::apply_metaclass_roles(
380 for_class => 'My::Class5',
381 metaclass_roles => ['Role::Bar'],
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} );
394 Mouse::Util::MetaRole::apply_metaclass_roles(
395 for_class => 'My::Class6',
396 metaclass_roles => ['Role::Bar'],
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} );
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.
418 # In real usage this would go in a BEGIN block so it happened
419 # before apply_metaclass_roles was called by an extension.
422 Mouse::Util::MetaRole::apply_metaclass_roles(
423 for_class => 'My::Class7',
424 metaclass_roles => ['Role::Bar'],
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} );
439 Mouse::Util::MetaRole::apply_metaclass_roles(
440 for_class => 'My::Class8',
441 metaclass_roles => ['Role::Bar'],
442 attribute_metaclass_roles => ['Role::Bar'],
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} );
464 Mouse::Util::MetaRole::apply_metaclass_roles(
465 for_class => 'My::Class9',
466 attribute_metaclass_roles => ['Role::Bar'],
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} );
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.
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.
491 package My::Meta::Class2;
493 extends 'Mouse::Meta::Class';
495 Mouse::Util::MetaRole::apply_metaclass_roles(
496 for_class => 'My::Meta::Class2',
497 metaclass_roles => ['Role::Foo'],
504 extends 'Mouse::Object';
511 Mouse::Exporter->setup_import_methods( also => 'Mouse' );
519 metaclass => 'My::Meta::Class2',
520 base_class => 'My::Object',
529 Mouse::Util::MetaRole::apply_metaclass_roles(
530 for_class => 'My::Class10',
531 metaclass_roles => ['Role::Bar'],
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)} );
547 package My::Constructor;
549 use base 'Mouse::Meta::Method::Constructor';
557 __PACKAGE__->meta->constructor_class('My::Constructor');
559 Mouse::Util::MetaRole::apply_metaclass_roles(
560 for_class => 'My::Class11',
561 metaclass_roles => ['Role::Foo'],
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)} );
573 package ExportsMouse;
575 Mouse::Exporter->setup_import_methods(
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/],
593 package UsesExportedMouse;
594 ExportsMouse->import;
595 } 'import module which loads a role from disk during init_meta';
598 package Foo::Meta::Role;
605 Mouse::Exporter->setup_import_methods(
606 also => 'Mouse::Role',
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', ],
635 My::Class12->meta->does_role( 'Role::Baz' ),
638 my $method = My::Class12->meta->get_method( 'bla' );
640 $method->meta->does_role( 'Foo::Meta::Role' ),
641 'method_metaclass_role applied'
649 Mouse::Util::MetaRole::apply_metaclass_roles(
650 for_class => __PACKAGE__,
651 constructor_class_roles => ['Role::Foo'],
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'
672 = 'Mouse does not see that the child differs from the parent because it only checks the class and instance metaclasses do determine compatibility';
674 Child->meta->constructor_class->meta->can('does_role')
675 && Child->meta->constructor_class->meta->does_role(
677 'Child constructor class has metarole from Parent'