Commit | Line | Data |
41888e7d |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
6 | use Test::More tests => 8; |
7 | |
8 | use Mouse::Util::MetaRole; |
9 | |
10 | BEGIN |
11 | { |
12 | package My::Meta::Class; |
13 | use Mouse; |
14 | extends 'Mouse::Meta::Class'; |
15 | } |
16 | |
17 | BEGIN |
18 | { |
19 | package My::Meta::Attribute; |
20 | use Mouse; |
21 | extends 'Mouse::Meta::Attribute'; |
22 | } |
23 | |
24 | BEGIN |
25 | { |
26 | package My::Meta::Method; |
27 | use Mouse; |
28 | extends 'Mouse::Meta::Method'; |
29 | } |
30 | |
31 | BEGIN |
32 | { |
33 | package My::Meta::Instance; |
34 | use Mouse; |
35 | extends 'Mouse::Meta::Instance'; |
36 | } |
37 | |
38 | BEGIN |
39 | { |
40 | package Role::Foo; |
41 | use Mouse::Role; |
42 | has 'foo' => ( is => 'ro', default => 10 ); |
43 | } |
44 | |
45 | { |
46 | package My::Class; |
47 | |
48 | use metaclass 'My::Meta::Class'; |
49 | use Mouse; |
50 | } |
51 | |
52 | { |
53 | package My::Class2; |
54 | |
55 | use metaclass 'My::Meta::Class' => ( |
56 | attribute_metaclass => 'My::Meta::Attribute', |
57 | method_metaclass => 'My::Meta::Method', |
58 | instance_metaclass => 'My::Meta::Instance', |
59 | ); |
60 | |
61 | use Mouse; |
62 | } |
63 | |
64 | { |
65 | Mouse::Util::MetaRole::apply_metaclass_roles( |
66 | for_class => 'My::Class', |
67 | metaclass_roles => ['Role::Foo'], |
68 | ); |
69 | |
70 | ok( My::Class->meta()->meta()->does_role('Role::Foo'), |
71 | 'apply Role::Foo to My::Class->meta()' ); |
72 | has_superclass( My::Class->meta(), 'My::Meta::Class', |
73 | 'apply_metaclass_roles works with metaclass.pm' ); |
74 | } |
75 | |
76 | { |
77 | Mouse::Util::MetaRole::apply_metaclass_roles( |
78 | for_class => 'My::Class2', |
79 | attribute_metaclass_roles => ['Role::Foo'], |
80 | method_metaclass_roles => ['Role::Foo'], |
81 | instance_metaclass_roles => ['Role::Foo'], |
82 | ); |
83 | |
84 | ok( My::Class2->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'), |
85 | q{apply Role::Foo to My::Class2->meta()'s attribute metaclass} ); |
86 | has_superclass( My::Class2->meta()->attribute_metaclass(), 'My::Meta::Attribute', |
87 | '... and this does not interfere with attribute metaclass set via metaclass.pm' ); |
88 | ok( My::Class2->meta()->method_metaclass()->meta()->does_role('Role::Foo'), |
89 | q{apply Role::Foo to My::Class2->meta()'s method metaclass} ); |
90 | has_superclass( My::Class2->meta()->method_metaclass(), 'My::Meta::Method', |
91 | '... and this does not interfere with method metaclass set via metaclass.pm' ); |
92 | ok( My::Class2->meta()->instance_metaclass()->meta()->does_role('Role::Foo'), |
93 | q{apply Role::Foo to My::Class2->meta()'s instance metaclass} ); |
94 | has_superclass( My::Class2->meta()->instance_metaclass(), 'My::Meta::Instance', |
95 | '... and this does not interfere with instance metaclass set via metaclass.pm' ); |
96 | } |
97 | |
98 | # like isa_ok but works with a class name, not just refs |
99 | sub has_superclass { |
100 | my $thing = shift; |
101 | my $parent = shift; |
102 | my $desc = shift; |
103 | |
104 | my %supers = map { $_ => 1 } $thing->meta()->superclasses(); |
105 | |
106 | local $Test::Builder::Level = $Test::Builder::Level + 1; |
107 | |
108 | ok( $supers{$parent}, $desc ); |
109 | } |