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' );
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} );
375 Mouse::Util::MetaRole::apply_metaclass_roles(
376 for_class => 'My::Class5',
377 metaclass_roles => ['Role::Bar'],
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} );
390 Mouse::Util::MetaRole::apply_metaclass_roles(
391 for_class => 'My::Class6',
392 metaclass_roles => ['Role::Bar'],
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} );
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.
414 # In real usage this would go in a BEGIN block so it happened
415 # before apply_metaclass_roles was called by an extension.
418 Mouse::Util::MetaRole::apply_metaclass_roles(
419 for_class => 'My::Class7',
420 metaclass_roles => ['Role::Bar'],
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} );
435 Mouse::Util::MetaRole::apply_metaclass_roles(
436 for_class => 'My::Class8',
437 metaclass_roles => ['Role::Bar'],
438 attribute_metaclass_roles => ['Role::Bar'],
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} );
460 Mouse::Util::MetaRole::apply_metaclass_roles(
461 for_class => 'My::Class9',
462 attribute_metaclass_roles => ['Role::Bar'],
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} );
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.
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.
487 package My::Meta::Class2;
489 extends 'Mouse::Meta::Class';
491 Mouse::Util::MetaRole::apply_metaclass_roles(
492 for_class => 'My::Meta::Class2',
493 metaclass_roles => ['Role::Foo'],
500 extends 'Mouse::Object';
507 Mouse::Exporter->setup_import_methods( also => 'Mouse' );
515 metaclass => 'My::Meta::Class2',
516 base_class => 'My::Object',
525 Mouse::Util::MetaRole::apply_metaclass_roles(
526 for_class => 'My::Class10',
527 metaclass_roles => ['Role::Bar'],
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)} );
543 package My::Constructor;
545 use base 'Mouse::Meta::Method::Constructor';
553 __PACKAGE__->meta->constructor_class('My::Constructor');
555 Mouse::Util::MetaRole::apply_metaclass_roles(
556 for_class => 'My::Class11',
557 metaclass_roles => ['Role::Foo'],
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)} );
569 package ExportsMouse;
571 Mouse::Exporter->setup_import_methods(
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/],
589 package UsesExportedMouse;
590 ExportsMouse->import;
591 } 'import module which loads a role from disk during init_meta';
594 package Foo::Meta::Role;
601 Mouse::Exporter->setup_import_methods(
602 also => 'Mouse::Role',
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', ],
631 My::Class12->meta->does_role( 'Role::Baz' ),
634 my $method = My::Class12->meta->get_method( 'bla' );
636 $method->meta->does_role( 'Foo::Meta::Role' ),
637 'method_metaclass_role applied'
645 Mouse::Util::MetaRole::apply_metaclass_roles(
646 for_class => __PACKAGE__,
647 constructor_class_roles => ['Role::Foo'],
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'
668 = 'Mouse does not see that the child differs from the parent because it only checks the class and instance metaclasses do determine compatibility';
670 Child->meta->constructor_class->meta->can('does_role')
671 && Child->meta->constructor_class->meta->does_role(
673 'Child constructor class has metarole from Parent'