Commit | Line | Data |
41888e7d |
1 | use strict; |
2 | use warnings; |
3 | use Test::More; |
4 | |
5 | our @applications; |
6 | |
7 | { |
8 | package CustomApplication; |
9 | use Mouse::Role; |
10 | |
11 | after apply_methods => sub { |
12 | my ( $self, $role, $other ) = @_; |
13 | $self->apply_custom( $role, $other ); |
14 | }; |
15 | |
16 | sub apply_custom { |
17 | shift; |
18 | push @applications, [@_]; |
19 | } |
20 | } |
21 | |
22 | { |
23 | package CustomApplication::ToClass; |
24 | use Mouse::Role; |
25 | |
26 | with 'CustomApplication'; |
27 | } |
28 | |
29 | { |
30 | package CustomApplication::ToRole; |
31 | use Mouse::Role; |
32 | |
33 | with 'CustomApplication'; |
34 | } |
35 | |
36 | { |
37 | package CustomApplication::ToInstance; |
38 | use Mouse::Role; |
39 | |
40 | with 'CustomApplication'; |
41 | } |
42 | |
43 | { |
44 | package CustomApplication::Composite; |
45 | use Mouse::Role; |
46 | |
47 | with 'CustomApplication'; |
48 | |
49 | around apply_custom => sub { |
50 | my ( $next, $self, $composite, $other ) = @_; |
51 | for my $role ( @{ $composite->get_roles } ) { |
52 | $self->$next( $role, $other ); |
53 | } |
54 | }; |
55 | } |
56 | |
57 | { |
58 | package CustomApplication::Composite::ToClass; |
59 | use Mouse::Role; |
60 | |
61 | with 'CustomApplication::Composite'; |
62 | } |
63 | |
64 | { |
65 | package CustomApplication::Composite::ToRole; |
66 | use Mouse::Role; |
67 | |
68 | with 'CustomApplication::Composite'; |
69 | } |
70 | |
71 | { |
72 | package CustomApplication::Composite::ToInstance; |
73 | use Mouse::Role; |
74 | |
75 | with 'CustomApplication::Composite'; |
76 | } |
77 | |
78 | { |
79 | package Role::Composite; |
80 | use Mouse::Role; |
81 | |
82 | around apply_params => sub { |
83 | my ( $next, $self, @args ) = @_; |
84 | return Mouse::Util::MetaRole::apply_metaclass_roles( |
85 | for_class => $self->$next(@args), |
86 | application_to_class_class_roles => |
87 | ['CustomApplication::Composite::ToClass'], |
88 | application_to_role_class_roles => |
89 | ['CustomApplication::Composite::ToRole'], |
90 | application_to_instance_class_roles => |
91 | ['CustomApplication::Composite::ToInstance'], |
92 | ); |
93 | }; |
94 | } |
95 | |
96 | { |
97 | package Role::WithCustomApplication; |
98 | use Mouse::Role; |
99 | |
100 | has '+composition_class_roles' => ( |
101 | default => ['Role::Composite'], |
102 | ); |
103 | } |
104 | |
105 | { |
106 | package CustomRole; |
107 | Mouse::Exporter->setup_import_methods( |
108 | also => 'Mouse::Role', |
109 | ); |
110 | |
111 | sub init_meta { |
112 | my ( $self, %options ) = @_; |
113 | return Mouse::Util::MetaRole::apply_metaclass_roles( |
114 | for_class => Mouse::Role->init_meta(%options), |
115 | metaclass_roles => ['Role::WithCustomApplication'], |
116 | application_to_class_class_roles => |
117 | ['CustomApplication::ToClass'], |
118 | application_to_role_class_roles => ['CustomApplication::ToRole'], |
119 | application_to_instance_class_roles => |
120 | ['CustomApplication::ToInstance'], |
121 | ); |
122 | } |
123 | } |
124 | |
125 | { |
126 | package My::Role::Normal; |
127 | use Mouse::Role; |
128 | } |
129 | |
130 | { |
131 | package My::Role::Special; |
132 | CustomRole->import; |
133 | } |
134 | |
135 | ok( My::Role::Normal->meta->isa('Mouse::Meta::Role'), "sanity check" ); |
136 | ok( My::Role::Special->meta->isa('Mouse::Meta::Role'), |
137 | "using custom application roles does not change the role metaobject's class" |
138 | ); |
139 | ok( My::Role::Special->meta->meta->does_role('Role::WithCustomApplication'), |
140 | "the role's metaobject has custom applications" ); |
141 | is_deeply( My::Role::Special->meta->composition_class_roles, |
142 | ['Role::Composite'], |
143 | "the role knows about the specified composition class" ); |
144 | |
145 | { |
146 | package Foo; |
147 | use Mouse; |
148 | |
149 | local @applications; |
150 | with 'My::Role::Special'; |
151 | |
152 | ::is( @applications, 1, 'one role application' ); |
153 | ::is( $applications[0]->[0]->name, 'My::Role::Special', |
154 | "the application's first role was My::Role::Special'" ); |
155 | ::is( $applications[0]->[1]->name, 'Foo', |
156 | "the application provided an additional role" ); |
157 | } |
158 | |
159 | { |
160 | package Bar; |
161 | use Mouse::Role; |
162 | |
163 | local @applications; |
164 | with 'My::Role::Special'; |
165 | |
166 | ::is( @applications, 1 ); |
167 | ::is( $applications[0]->[0]->name, 'My::Role::Special' ); |
168 | ::is( $applications[0]->[1]->name, 'Bar' ); |
169 | } |
170 | |
171 | { |
172 | package Baz; |
173 | use Mouse; |
174 | |
175 | my $i = Baz->new; |
176 | local @applications; |
177 | My::Role::Special->meta->apply($i); |
178 | |
179 | ::is( @applications, 1 ); |
180 | ::is( $applications[0]->[0]->name, 'My::Role::Special' ); |
181 | ::ok( $applications[0]->[1]->is_anon_class ); |
182 | ::ok( $applications[0]->[1]->name->isa('Baz') ); |
183 | } |
184 | |
185 | { |
186 | package Corge; |
187 | use Mouse; |
188 | |
189 | local @applications; |
190 | with 'My::Role::Normal', 'My::Role::Special'; |
191 | |
192 | ::is( @applications, 2 ); |
193 | ::is( $applications[0]->[0]->name, 'My::Role::Normal' ); |
194 | ::is( $applications[0]->[1]->name, 'Corge' ); |
195 | ::is( $applications[1]->[0]->name, 'My::Role::Special' ); |
196 | ::is( $applications[1]->[1]->name, 'Corge' ); |
197 | } |
198 | |
199 | { |
200 | package Thud; |
201 | use Mouse::Role; |
202 | |
203 | local @applications; |
204 | with 'My::Role::Normal', 'My::Role::Special'; |
205 | |
206 | ::is( @applications, 2 ); |
207 | ::is( $applications[0]->[0]->name, 'My::Role::Normal' ); |
208 | ::is( $applications[0]->[1]->name, 'Thud' ); |
209 | ::is( $applications[1]->[0]->name, 'My::Role::Special' ); |
210 | ::is( $applications[1]->[1]->name, 'Thud' ); |
211 | } |
212 | |
213 | { |
214 | package Garply; |
215 | use Mouse; |
216 | |
217 | my $i = Garply->new; |
218 | local @applications; |
219 | Mouse::Meta::Role->combine( |
220 | [ 'My::Role::Normal' => undef ], |
221 | [ 'My::Role::Special' => undef ], |
222 | )->apply($i); |
223 | |
224 | ::is( @applications, 2 ); |
225 | ::is( $applications[0]->[0]->name, 'My::Role::Normal' ); |
226 | ::ok( $applications[0]->[1]->is_anon_class ); |
227 | ::ok( $applications[0]->[1]->name->isa('Garply') ); |
228 | ::is( $applications[1]->[0]->name, 'My::Role::Special' ); |
229 | ::ok( $applications[1]->[1]->is_anon_class ); |
230 | ::ok( $applications[1]->[1]->name->isa('Garply') ); |
231 | } |
232 | |
233 | done_testing; |