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.
9 use lib 't/lib', 'lib';
14 use Moose::Util::MetaRole;
18 package My::Meta::Class;
20 extends 'Moose::Meta::Class';
26 has 'foo' => ( is => 'ro', default => 10 );
41 Moose::Util::MetaRole::apply_metaclass_roles(
42 for_class => My::Class->meta,
43 metaclass_roles => ['Role::Foo'],
46 ok( My::Class->meta()->meta()->does_role('Role::Foo'),
47 'apply Role::Foo to My::Class->meta()' );
48 is( My::Class->meta()->foo(), 10,
49 '... and call foo() on that meta object' );
53 Moose::Util::MetaRole::apply_metaclass_roles(
54 for_class => 'My::Class',
55 attribute_metaclass_roles => ['Role::Foo'],
58 ok( My::Class->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'),
59 q{apply Role::Foo to My::Class->meta()'s attribute metaclass} );
60 ok( My::Class->meta()->meta()->does_role('Role::Foo'),
61 '... My::Class->meta() still does Role::Foo' );
63 My::Class->meta()->add_attribute( 'size', is => 'ro' );
64 is( My::Class->meta()->get_attribute('size')->foo(), 10,
65 '... call foo() on an attribute metaclass object' );
69 Moose::Util::MetaRole::apply_metaclass_roles(
70 for_class => 'My::Class',
71 method_metaclass_roles => ['Role::Foo'],
74 ok( My::Class->meta()->method_metaclass()->meta()->does_role('Role::Foo'),
75 q{apply Role::Foo to My::Class->meta()'s method metaclass} );
76 ok( My::Class->meta()->meta()->does_role('Role::Foo'),
77 '... My::Class->meta() still does Role::Foo' );
78 ok( My::Class->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'),
79 q{... My::Class->meta()'s attribute metaclass still does Role::Foo} );
81 My::Class->meta()->add_method( 'bar' => sub { 'bar' } );
82 is( My::Class->meta()->get_method('bar')->foo(), 10,
83 '... call foo() on a method metaclass object' );
87 Moose::Util::MetaRole::apply_metaclass_roles(
88 for_class => 'My::Class',
89 wrapped_method_metaclass_roles => ['Role::Foo'],
92 ok( My::Class->meta()->wrapped_method_metaclass()->meta()->does_role('Role::Foo'),
93 q{apply Role::Foo to My::Class->meta()'s wrapped method metaclass} );
94 ok( My::Class->meta()->method_metaclass()->meta()->does_role('Role::Foo'),
95 '... My::Class->meta() still does Role::Foo' );
96 ok( My::Class->meta()->meta()->does_role('Role::Foo'),
97 '... My::Class->meta() still does Role::Foo' );
98 ok( My::Class->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'),
99 q{... My::Class->meta()'s attribute metaclass still does Role::Foo} );
101 My::Class->meta()->add_after_method_modifier( 'bar' => sub { 'bar' } );
102 is( My::Class->meta()->get_method('bar')->foo(), 10,
103 '... call foo() on a wrapped method metaclass object' );
107 Moose::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 Moose::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 Moose::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' );
172 Moose::Util::MetaRole::apply_metaclass_roles(
173 for_class => 'My::Role',
174 application_to_class_class_roles => ['Role::Foo'],
177 ok( My::Role->meta->application_to_class_class->meta->does_role('Role::Foo'),
178 q{apply Role::Foo to My::Role->meta's application_to_class class} );
180 is( My::Role->meta->application_to_class_class->new->foo, 10,
181 q{... call foo() on an application_to_class instance} );
185 Moose::Util::MetaRole::apply_metaclass_roles(
186 for_class => 'My::Role',
187 application_to_role_class_roles => ['Role::Foo'],
190 ok( My::Role->meta->application_to_role_class->meta->does_role('Role::Foo'),
191 q{apply Role::Foo to My::Role->meta's application_to_role class} );
192 ok( My::Role->meta->application_to_class_class->meta->does_role('Role::Foo'),
193 q{... My::Role->meta's application_to_class class still does Role::Foo} );
195 is( My::Role->meta->application_to_role_class->new->foo, 10,
196 q{... call foo() on an application_to_role instance} );
200 Moose::Util::MetaRole::apply_metaclass_roles(
201 for_class => 'My::Role',
202 application_to_instance_class_roles => ['Role::Foo'],
205 ok( My::Role->meta->application_to_instance_class->meta->does_role('Role::Foo'),
206 q{apply Role::Foo to My::Role->meta's application_to_instance class} );
207 ok( My::Role->meta->application_to_role_class->meta->does_role('Role::Foo'),
208 q{... My::Role->meta's application_to_role class still does Role::Foo} );
209 ok( My::Role->meta->application_to_class_class->meta->does_role('Role::Foo'),
210 q{... My::Role->meta's application_to_class class still does Role::Foo} );
212 is( My::Role->meta->application_to_instance_class->new->foo, 10,
213 q{... call foo() on an application_to_instance instance} );
217 Moose::Util::MetaRole::apply_base_class_roles(
218 for_class => 'My::Class',
219 roles => ['Role::Foo'],
222 ok( My::Class->meta()->does_role('Role::Foo'),
223 'apply Role::Foo to My::Class base class' );
224 is( My::Class->new()->foo(), 10,
225 '... call foo() on a My::Class object' );
235 Moose::Util::MetaRole::apply_metaclass_roles(
236 for_class => 'My::Class2',
237 metaclass_roles => ['Role::Foo'],
238 attribute_metaclass_roles => ['Role::Foo'],
239 method_metaclass_roles => ['Role::Foo'],
240 instance_metaclass_roles => ['Role::Foo'],
241 constructor_class_roles => ['Role::Foo'],
242 destructor_class_roles => ['Role::Foo'],
245 ok( My::Class2->meta()->meta()->does_role('Role::Foo'),
246 'apply Role::Foo to My::Class2->meta()' );
247 is( My::Class2->meta()->foo(), 10,
248 '... and call foo() on that meta object' );
249 ok( My::Class2->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'),
250 q{apply Role::Foo to My::Class2->meta()'s attribute metaclass} );
251 My::Class2->meta()->add_attribute( 'size', is => 'ro' );
253 is( My::Class2->meta()->get_attribute('size')->foo(), 10,
254 '... call foo() on an attribute metaclass object' );
256 ok( My::Class2->meta()->method_metaclass()->meta()->does_role('Role::Foo'),
257 q{apply Role::Foo to My::Class2->meta()'s method metaclass} );
259 My::Class2->meta()->add_method( 'bar' => sub { 'bar' } );
260 is( My::Class2->meta()->get_method('bar')->foo(), 10,
261 '... call foo() on a method metaclass object' );
263 ok( My::Class2->meta()->instance_metaclass()->meta()->does_role('Role::Foo'),
264 q{apply Role::Foo to My::Class2->meta()'s instance metaclass} );
265 is( My::Class2->meta()->get_meta_instance()->foo(), 10,
266 '... call foo() on an instance metaclass object' );
268 ok( My::Class2->meta()->constructor_class()->meta()->does_role('Role::Foo'),
269 q{apply Role::Foo to My::Class2->meta()'s constructor class} );
270 ok( My::Class2->meta()->constructor_class()->can('foo'),
271 '... constructor class has a foo method' );
273 ok( My::Class2->meta()->destructor_class()->meta()->does_role('Role::Foo'),
274 q{apply Role::Foo to My::Class2->meta()'s destructor class} );
275 ok( My::Class2->meta()->destructor_class()->can('foo'),
276 '... destructor class has a foo method' );
284 Moose::Exporter->setup_import_methods( also => 'Moose' );
290 Moose->init_meta( %p, metaclass => 'My::Meta::Class' );
302 Moose::Util::MetaRole::apply_metaclass_roles(
303 for_class => 'My::Class3',
304 metaclass_roles => ['Role::Foo'],
307 ok( My::Class3->meta()->meta()->does_role('Role::Foo'),
308 'apply Role::Foo to My::Class3->meta()' );
309 is( My::Class3->meta()->foo(), 10,
310 '... and call foo() on that meta object' );
311 ok( ( grep { $_ eq 'My::Meta::Class' } My::Class3->meta()->meta()->superclasses() ),
312 'apply_metaclass_roles() does not interfere with metaclass set via Moose->init_meta()' );
318 has 'bar' => ( is => 'ro', default => 200 );
327 Moose::Util::MetaRole::apply_metaclass_roles(
328 for_class => 'My::Class4',
329 metaclass_roles => ['Role::Foo'],
332 ok( My::Class4->meta()->meta()->does_role('Role::Foo'),
333 'apply Role::Foo to My::Class4->meta()' );
335 Moose::Util::MetaRole::apply_metaclass_roles(
336 for_class => 'My::Class4',
337 metaclass_roles => ['Role::Bar'],
340 ok( My::Class4->meta()->meta()->does_role('Role::Bar'),
341 'apply Role::Bar to My::Class4->meta()' );
342 ok( My::Class4->meta()->meta()->does_role('Role::Foo'),
343 '... and My::Class4->meta() still does Role::Foo' );
354 ok( My::Class5->meta()->meta()->does_role('Role::Foo'),
355 q{My::Class5->meta()'s does Role::Foo because it extends My::Class} );
356 ok( My::Class5->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'),
357 q{My::Class5->meta()'s attribute metaclass also does Role::Foo} );
358 ok( My::Class5->meta()->method_metaclass()->meta()->does_role('Role::Foo'),
359 q{My::Class5->meta()'s method metaclass also does Role::Foo} );
360 ok( My::Class5->meta()->instance_metaclass()->meta()->does_role('Role::Foo'),
361 q{My::Class5->meta()'s instance metaclass also does Role::Foo} );
362 ok( My::Class5->meta()->constructor_class()->meta()->does_role('Role::Foo'),
363 q{My::Class5->meta()'s constructor class also does Role::Foo} );
364 ok( My::Class5->meta()->destructor_class()->meta()->does_role('Role::Foo'),
365 q{My::Class5->meta()'s destructor class also does Role::Foo} );
369 Moose::Util::MetaRole::apply_metaclass_roles(
370 for_class => 'My::Class5',
371 metaclass_roles => ['Role::Bar'],
374 ok( My::Class5->meta()->meta()->does_role('Role::Bar'),
375 q{apply Role::Bar My::Class5->meta()} );
376 ok( My::Class5->meta()->meta()->does_role('Role::Foo'),
377 q{... and My::Class5->meta() still does Role::Foo} );
384 Moose::Util::MetaRole::apply_metaclass_roles(
385 for_class => 'My::Class6',
386 metaclass_roles => ['Role::Bar'],
393 ok( My::Class6->meta()->meta()->does_role('Role::Bar'),
394 q{apply Role::Bar My::Class6->meta() before extends} );
395 ok( My::Class6->meta()->meta()->does_role('Role::Foo'),
396 q{... and My::Class6->meta() does Role::Foo because My::Class6 extends My::Class} );
399 # This is the hack that used to be needed to work around the
400 # _fix_metaclass_incompatibility problem. You called extends() (which
401 # in turn calls _fix_metaclass_imcompatibility) _before_ you apply
402 # more extensions in the subclass. We wabt to make sure this continues
403 # to work in the future.
408 # In real usage this would go in a BEGIN block so it happened
409 # before apply_metaclass_roles was called by an extension.
412 Moose::Util::MetaRole::apply_metaclass_roles(
413 for_class => 'My::Class7',
414 metaclass_roles => ['Role::Bar'],
419 ok( My::Class7->meta()->meta()->does_role('Role::Bar'),
420 q{apply Role::Bar My::Class7->meta() before extends} );
421 ok( My::Class7->meta()->meta()->does_role('Role::Foo'),
422 q{... and My::Class7->meta() does Role::Foo because My::Class7 extends My::Class} );
429 Moose::Util::MetaRole::apply_metaclass_roles(
430 for_class => 'My::Class8',
431 metaclass_roles => ['Role::Bar'],
432 attribute_metaclass_roles => ['Role::Bar'],
439 ok( My::Class8->meta()->meta()->does_role('Role::Bar'),
440 q{apply Role::Bar My::Class8->meta() before extends} );
441 ok( My::Class8->meta()->meta()->does_role('Role::Foo'),
442 q{... and My::Class8->meta() does Role::Foo because My::Class8 extends My::Class} );
443 ok( My::Class8->meta()->attribute_metaclass->meta()->does_role('Role::Bar'),
444 q{apply Role::Bar to My::Class8->meta()->attribute_metaclass before extends} );
445 ok( My::Class8->meta()->attribute_metaclass->meta()->does_role('Role::Foo'),
446 q{... and My::Class8->meta()->attribute_metaclass does Role::Foo because My::Class8 extends My::Class} );
454 Moose::Util::MetaRole::apply_metaclass_roles(
455 for_class => 'My::Class9',
456 attribute_metaclass_roles => ['Role::Bar'],
463 ok( My::Class9->meta()->meta()->does_role('Role::Foo'),
464 q{... and My::Class9->meta() does Role::Foo because My::Class9 extends My::Class} );
465 ok( My::Class9->meta()->attribute_metaclass->meta()->does_role('Role::Bar'),
466 q{apply Role::Bar to My::Class9->meta()->attribute_metaclass before extends} );
467 ok( My::Class9->meta()->attribute_metaclass->meta()->does_role('Role::Foo'),
468 q{... and My::Class9->meta()->attribute_metaclass does Role::Foo because My::Class9 extends My::Class} );
471 # This tests applying meta roles to a metaclass's metaclass. This is
472 # completely insane, but is exactly what happens with
473 # Fey::Meta::Class::Table. It's a subclass of Moose::Meta::Class
474 # itself, and then it _uses_ MooseX::ClassAttribute, so the metaclass
475 # for Fey::Meta::Class::Table does a role.
477 # At one point this caused a metaclass incompatibility error down
478 # below, when we applied roles to the metaclass of My::Class10. It's
479 # all madness but as long as the tests pass we're happy.
481 package My::Meta::Class2;
483 extends 'Moose::Meta::Class';
485 Moose::Util::MetaRole::apply_metaclass_roles(
486 for_class => 'My::Meta::Class2',
487 metaclass_roles => ['Role::Foo'],
494 extends 'Moose::Object';
501 Moose::Exporter->setup_import_methods( also => 'Moose' );
509 metaclass => 'My::Meta::Class2',
510 base_class => 'My::Object',
519 Moose::Util::MetaRole::apply_metaclass_roles(
520 for_class => 'My::Class10',
521 metaclass_roles => ['Role::Bar'],
526 ok( My::Class10->meta()->meta()->meta()->does_role('Role::Foo'),
527 q{My::Class10->meta()->meta() does Role::Foo } );
528 ok( My::Class10->meta()->meta()->does_role('Role::Bar'),
529 q{My::Class10->meta()->meta() does Role::Bar } );
530 ok( My::Class10->meta()->isa('My::Meta::Class2'),
531 q{... and My::Class10->meta still isa(My::Meta::Class2)} );
532 ok( My::Class10->isa('My::Object'),
533 q{... and My::Class10 still isa(My::Object)} );
537 package My::Constructor;
539 use base 'Moose::Meta::Method::Constructor';
547 __PACKAGE__->meta->constructor_class('My::Constructor');
549 Moose::Util::MetaRole::apply_metaclass_roles(
550 for_class => 'My::Class11',
551 metaclass_roles => ['Role::Foo'],
556 ok( My::Class11->meta()->meta()->does_role('Role::Foo'),
557 q{My::Class11->meta()->meta() does Role::Foo } );
558 is( My::Class11->meta()->constructor_class, 'My::Constructor',
559 q{... and explicitly set constructor_class value is unchanged)} );
563 package ExportsMoose;
565 Moose::Exporter->setup_import_methods(
572 Moose->init_meta(%p);
573 return Moose::Util::MetaRole::apply_metaclass_roles(
574 for_class => $p{for_class},
575 # Causes us to recurse through init_meta, as we have to
576 # load MyMetaclassRole from disk.
577 metaclass_roles => [qw/MyMetaclassRole/],
583 package UsesExportedMoose;
584 ExportsMoose->import;
585 } 'import module which loads a role from disk during init_meta';
588 package Foo::Meta::Role;
595 Moose::Exporter->setup_import_methods(
596 also => 'Moose::Role',
602 Moose::Role->init_meta(%p);
603 return Moose::Util::MetaRole::apply_metaclass_roles(
604 for_class => $p{for_class},
605 method_metaclass_roles => [ 'Foo::Meta::Role', ],
625 My::Class12->meta->does_role( 'Role::Baz' ),
628 my $method = My::Class12->meta->get_method( 'bla' );
630 $method->meta->does_role( 'Foo::Meta::Role' ),
631 'method_metaclass_role applied'
639 Moose::Util::MetaRole::apply_metaclass_roles(
640 for_class => __PACKAGE__,
641 constructor_class_roles => ['Role::Foo'],
654 Parent->meta->constructor_class->meta->can('does_role')
655 && Parent->meta->constructor_class->meta->does_role('Role::Foo'),
656 'Parent constructor class has metarole from Parent'
662 = 'Moose does not see that the child differs from the parent because it only checks the class and instance metaclasses do determine compatibility';
664 Child->meta->constructor_class->meta->can('does_role')
665 && Child->meta->constructor_class->meta->does_role(
667 'Child constructor class has metarole from Parent'