Commit | Line | Data |
231be3be |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
b72373c4 |
6 | use Test::More tests => 69; |
231be3be |
7 | |
8 | use Moose::Util::MetaRole; |
9 | |
10 | |
11 | { |
12 | package My::Meta::Class; |
13 | use Moose; |
14 | extends 'Moose::Meta::Class'; |
15 | } |
16 | |
17 | { |
231be3be |
18 | package Role::Foo; |
19 | use Moose::Role; |
20 | has 'foo' => ( is => 'ro', default => 10 ); |
21 | } |
22 | |
23 | { |
24 | package My::Class; |
25 | |
26 | use Moose; |
27 | } |
28 | |
29 | { |
30 | Moose::Util::MetaRole::apply_metaclass_roles( |
31 | for_class => 'My::Class', |
32 | metaclass_roles => ['Role::Foo'], |
33 | ); |
34 | |
35 | ok( My::Class->meta()->meta()->does_role('Role::Foo'), |
36 | 'apply Role::Foo to My::Class->meta()' ); |
37 | is( My::Class->meta()->foo(), 10, |
38 | '... and call foo() on that meta object' ); |
39 | } |
40 | |
41 | { |
42 | Moose::Util::MetaRole::apply_metaclass_roles( |
43 | for_class => 'My::Class', |
44 | attribute_metaclass_roles => ['Role::Foo'], |
45 | ); |
46 | |
47 | ok( My::Class->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'), |
48 | q{apply Role::Foo to My::Class->meta()'s attribute metaclass} ); |
49 | ok( My::Class->meta()->meta()->does_role('Role::Foo'), |
50 | '... My::Class->meta() still does Role::Foo' ); |
51 | |
52 | My::Class->meta()->add_attribute( 'size', is => 'ro' ); |
53 | is( My::Class->meta()->get_attribute('size')->foo(), 10, |
54 | '... call foo() on an attribute metaclass object' ); |
55 | } |
56 | |
57 | { |
58 | Moose::Util::MetaRole::apply_metaclass_roles( |
59 | for_class => 'My::Class', |
60 | method_metaclass_roles => ['Role::Foo'], |
61 | ); |
62 | |
63 | ok( My::Class->meta()->method_metaclass()->meta()->does_role('Role::Foo'), |
64 | q{apply Role::Foo to My::Class->meta()'s method metaclass} ); |
65 | ok( My::Class->meta()->meta()->does_role('Role::Foo'), |
66 | '... My::Class->meta() still does Role::Foo' ); |
67 | ok( My::Class->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'), |
68 | q{... My::Class->meta()'s attribute metaclass still does Role::Foo} ); |
69 | |
70 | My::Class->meta()->add_method( 'bar' => sub { 'bar' } ); |
71 | is( My::Class->meta()->get_method('bar')->foo(), 10, |
72 | '... call foo() on a method metaclass object' ); |
73 | } |
74 | |
75 | { |
76 | Moose::Util::MetaRole::apply_metaclass_roles( |
77 | for_class => 'My::Class', |
78 | instance_metaclass_roles => ['Role::Foo'], |
79 | ); |
80 | |
81 | ok( My::Class->meta()->instance_metaclass()->meta()->does_role('Role::Foo'), |
82 | q{apply Role::Foo to My::Class->meta()'s instance metaclass} ); |
83 | ok( My::Class->meta()->meta()->does_role('Role::Foo'), |
84 | '... My::Class->meta() still does Role::Foo' ); |
85 | ok( My::Class->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'), |
86 | q{... My::Class->meta()'s attribute metaclass still does Role::Foo} ); |
87 | ok( My::Class->meta()->method_metaclass()->meta()->does_role('Role::Foo'), |
88 | q{... My::Class->meta()'s method metaclass still does Role::Foo} ); |
89 | |
90 | is( My::Class->meta()->get_meta_instance()->foo(), 10, |
91 | '... call foo() on an instance metaclass object' ); |
92 | } |
93 | |
94 | { |
95 | Moose::Util::MetaRole::apply_metaclass_roles( |
96 | for_class => 'My::Class', |
97 | constructor_class_roles => ['Role::Foo'], |
98 | ); |
99 | |
100 | ok( My::Class->meta()->constructor_class()->meta()->does_role('Role::Foo'), |
101 | q{apply Role::Foo to My::Class->meta()'s constructor class} ); |
102 | ok( My::Class->meta()->meta()->does_role('Role::Foo'), |
103 | '... My::Class->meta() still does Role::Foo' ); |
104 | ok( My::Class->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'), |
105 | q{... My::Class->meta()'s attribute metaclass still does Role::Foo} ); |
106 | ok( My::Class->meta()->method_metaclass()->meta()->does_role('Role::Foo'), |
107 | q{... My::Class->meta()'s method metaclass still does Role::Foo} ); |
108 | ok( My::Class->meta()->instance_metaclass()->meta()->does_role('Role::Foo'), |
109 | q{... My::Class->meta()'s instance metaclass still does Role::Foo} ); |
110 | |
111 | # Actually instantiating the constructor class is too freaking hard! |
112 | ok( My::Class->meta()->constructor_class()->can('foo'), |
113 | '... constructor class has a foo method' ); |
114 | } |
115 | |
116 | { |
117 | Moose::Util::MetaRole::apply_metaclass_roles( |
118 | for_class => 'My::Class', |
119 | destructor_class_roles => ['Role::Foo'], |
120 | ); |
121 | |
122 | ok( My::Class->meta()->destructor_class()->meta()->does_role('Role::Foo'), |
123 | q{apply Role::Foo to My::Class->meta()'s destructor class} ); |
124 | ok( My::Class->meta()->meta()->does_role('Role::Foo'), |
125 | '... My::Class->meta() still does Role::Foo' ); |
126 | ok( My::Class->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'), |
127 | q{... My::Class->meta()'s attribute metaclass still does Role::Foo} ); |
128 | ok( My::Class->meta()->method_metaclass()->meta()->does_role('Role::Foo'), |
129 | q{... My::Class->meta()'s method metaclass still does Role::Foo} ); |
130 | ok( My::Class->meta()->instance_metaclass()->meta()->does_role('Role::Foo'), |
131 | q{... My::Class->meta()'s instance metaclass still does Role::Foo} ); |
132 | ok( My::Class->meta()->constructor_class()->meta()->does_role('Role::Foo'), |
133 | q{... My::Class->meta()'s constructor class still does Role::Foo} ); |
134 | |
135 | # same problem as the constructor class |
136 | ok( My::Class->meta()->destructor_class()->can('foo'), |
137 | '... destructor class has a foo method' ); |
138 | } |
139 | |
140 | { |
141 | Moose::Util::MetaRole::apply_base_class_roles( |
142 | for_class => 'My::Class', |
143 | roles => ['Role::Foo'], |
144 | ); |
145 | |
146 | ok( My::Class->meta()->does_role('Role::Foo'), |
147 | 'apply Role::Foo to My::Class base class' ); |
148 | is( My::Class->new()->foo(), 10, |
149 | '... call foo() on a My::Class object' ); |
150 | } |
151 | |
152 | { |
153 | package My::Class2; |
154 | |
155 | use Moose; |
156 | } |
157 | |
158 | { |
159 | Moose::Util::MetaRole::apply_metaclass_roles( |
160 | for_class => 'My::Class2', |
161 | metaclass_roles => ['Role::Foo'], |
162 | attribute_metaclass_roles => ['Role::Foo'], |
163 | method_metaclass_roles => ['Role::Foo'], |
164 | instance_metaclass_roles => ['Role::Foo'], |
165 | constructor_class_roles => ['Role::Foo'], |
166 | destructor_class_roles => ['Role::Foo'], |
167 | ); |
168 | |
169 | ok( My::Class2->meta()->meta()->does_role('Role::Foo'), |
170 | 'apply Role::Foo to My::Class2->meta()' ); |
171 | is( My::Class2->meta()->foo(), 10, |
172 | '... and call foo() on that meta object' ); |
173 | ok( My::Class2->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'), |
174 | q{apply Role::Foo to My::Class2->meta()'s attribute metaclass} ); |
175 | My::Class2->meta()->add_attribute( 'size', is => 'ro' ); |
176 | |
177 | is( My::Class2->meta()->get_attribute('size')->foo(), 10, |
178 | '... call foo() on an attribute metaclass object' ); |
179 | |
180 | ok( My::Class2->meta()->method_metaclass()->meta()->does_role('Role::Foo'), |
181 | q{apply Role::Foo to My::Class2->meta()'s method metaclass} ); |
182 | |
183 | My::Class2->meta()->add_method( 'bar' => sub { 'bar' } ); |
184 | is( My::Class2->meta()->get_method('bar')->foo(), 10, |
185 | '... call foo() on a method metaclass object' ); |
186 | |
187 | ok( My::Class2->meta()->instance_metaclass()->meta()->does_role('Role::Foo'), |
188 | q{apply Role::Foo to My::Class2->meta()'s instance metaclass} ); |
189 | is( My::Class2->meta()->get_meta_instance()->foo(), 10, |
190 | '... call foo() on an instance metaclass object' ); |
191 | |
192 | ok( My::Class2->meta()->constructor_class()->meta()->does_role('Role::Foo'), |
193 | q{apply Role::Foo to My::Class2->meta()'s constructor class} ); |
194 | ok( My::Class2->meta()->constructor_class()->can('foo'), |
195 | '... constructor class has a foo method' ); |
196 | |
197 | ok( My::Class2->meta()->destructor_class()->meta()->does_role('Role::Foo'), |
198 | q{apply Role::Foo to My::Class2->meta()'s destructor class} ); |
199 | ok( My::Class2->meta()->destructor_class()->can('foo'), |
200 | '... destructor class has a foo method' ); |
201 | } |
202 | |
203 | |
204 | { |
205 | package My::Meta; |
206 | |
207 | use Moose::Exporter; |
208 | Moose::Exporter->setup_import_methods( also => 'Moose' ); |
209 | |
210 | sub init_meta { |
211 | shift; |
212 | my %p = @_; |
213 | |
214 | Moose->init_meta( %p, metaclass => 'My::Meta::Class' ); |
215 | } |
216 | } |
217 | |
218 | { |
219 | package My::Class3; |
220 | |
221 | My::Meta->import(); |
222 | } |
223 | |
224 | |
225 | { |
226 | Moose::Util::MetaRole::apply_metaclass_roles( |
227 | for_class => 'My::Class3', |
228 | metaclass_roles => ['Role::Foo'], |
229 | ); |
230 | |
231 | ok( My::Class3->meta()->meta()->does_role('Role::Foo'), |
232 | 'apply Role::Foo to My::Class3->meta()' ); |
233 | is( My::Class3->meta()->foo(), 10, |
234 | '... and call foo() on that meta object' ); |
235 | ok( ( grep { $_ eq 'My::Meta::Class' } My::Class3->meta()->meta()->superclasses() ), |
236 | 'apply_metaclass_roles() does not interfere with metaclass set via Moose->init_meta()' ); |
237 | } |
82b388d5 |
238 | |
239 | { |
240 | package Role::Bar; |
241 | use Moose::Role; |
242 | has 'bar' => ( is => 'ro', default => 200 ); |
243 | } |
244 | |
245 | { |
246 | package My::Class4; |
247 | use Moose; |
248 | } |
249 | |
250 | { |
251 | Moose::Util::MetaRole::apply_metaclass_roles( |
252 | for_class => 'My::Class4', |
253 | metaclass_roles => ['Role::Foo'], |
254 | ); |
255 | |
256 | ok( My::Class4->meta()->meta()->does_role('Role::Foo'), |
257 | 'apply Role::Foo to My::Class4->meta()' ); |
258 | |
259 | Moose::Util::MetaRole::apply_metaclass_roles( |
260 | for_class => 'My::Class4', |
261 | metaclass_roles => ['Role::Bar'], |
262 | ); |
263 | |
264 | ok( My::Class4->meta()->meta()->does_role('Role::Bar'), |
265 | 'apply Role::Bar to My::Class4->meta()' ); |
266 | ok( My::Class4->meta()->meta()->does_role('Role::Foo'), |
267 | '... and My::Class4->meta() still does Role::Foo' ); |
268 | } |
4fed6bbc |
269 | |
270 | { |
271 | package My::Class5; |
272 | use Moose; |
273 | |
274 | extends 'My::Class'; |
275 | } |
276 | |
277 | { |
deed2e7e |
278 | ok( My::Class5->meta()->meta()->does_role('Role::Foo'), |
63647399 |
279 | q{My::Class5->meta()'s does Role::Foo because it extends My::Class} ); |
deed2e7e |
280 | ok( My::Class5->meta()->attribute_metaclass()->meta()->does_role('Role::Foo'), |
4fed6bbc |
281 | q{My::Class5->meta()'s attribute metaclass also does Role::Foo} ); |
deed2e7e |
282 | ok( My::Class5->meta()->method_metaclass()->meta()->does_role('Role::Foo'), |
4fed6bbc |
283 | q{My::Class5->meta()'s method metaclass also does Role::Foo} ); |
deed2e7e |
284 | ok( My::Class5->meta()->instance_metaclass()->meta()->does_role('Role::Foo'), |
4fed6bbc |
285 | q{My::Class5->meta()'s instance metaclass also does Role::Foo} ); |
deed2e7e |
286 | ok( My::Class5->meta()->constructor_class()->meta()->does_role('Role::Foo'), |
4fed6bbc |
287 | q{My::Class5->meta()'s constructor class also does Role::Foo} ); |
deed2e7e |
288 | ok( My::Class5->meta()->destructor_class()->meta()->does_role('Role::Foo'), |
289 | q{My::Class5->meta()'s destructor class also does Role::Foo} ); |
4fed6bbc |
290 | } |
291 | |
292 | { |
293 | Moose::Util::MetaRole::apply_metaclass_roles( |
294 | for_class => 'My::Class5', |
295 | metaclass_roles => ['Role::Bar'], |
296 | ); |
297 | |
298 | ok( My::Class5->meta()->meta()->does_role('Role::Bar'), |
299 | q{apply Role::Bar My::Class5->meta()} ); |
300 | ok( My::Class5->meta()->meta()->does_role('Role::Foo'), |
301 | q{... and My::Class5->meta() still does Role::Foo} ); |
302 | } |
303 | |
4fed6bbc |
304 | { |
305 | package My::Class6; |
306 | use Moose; |
9f82cc33 |
307 | |
4fed6bbc |
308 | Moose::Util::MetaRole::apply_metaclass_roles( |
309 | for_class => 'My::Class6', |
310 | metaclass_roles => ['Role::Bar'], |
311 | ); |
312 | |
313 | extends 'My::Class'; |
314 | } |
315 | |
316 | { |
317 | ok( My::Class6->meta()->meta()->does_role('Role::Bar'), |
318 | q{apply Role::Bar My::Class6->meta() before extends} ); |
319 | ok( My::Class6->meta()->meta()->does_role('Role::Foo'), |
f8b6827f |
320 | q{... and My::Class6->meta() does Role::Foo because My::Class6 extends My::Class} ); |
00c71b9f |
321 | } |
4fed6bbc |
322 | |
f8b6827f |
323 | # This is the hack that used to be needed to work around the |
324 | # _fix_metaclass_incompatibility problem. You called extends() (which |
325 | # in turn calls _fix_metaclass_imcompatibility) _before_ you apply |
326 | # more extensions in the subclass. We wabt to make sure this continues |
327 | # to work in the future. |
4fed6bbc |
328 | { |
329 | package My::Class7; |
330 | use Moose; |
331 | |
332 | # In real usage this would go in a BEGIN block so it happened |
333 | # before apply_metaclass_roles was called by an extension. |
334 | extends 'My::Class'; |
335 | |
336 | Moose::Util::MetaRole::apply_metaclass_roles( |
337 | for_class => 'My::Class7', |
338 | metaclass_roles => ['Role::Bar'], |
339 | ); |
340 | } |
341 | |
342 | { |
343 | ok( My::Class7->meta()->meta()->does_role('Role::Bar'), |
344 | q{apply Role::Bar My::Class7->meta() before extends} ); |
345 | ok( My::Class7->meta()->meta()->does_role('Role::Foo'), |
f8b6827f |
346 | q{... and My::Class7->meta() does Role::Foo because My::Class7 extends My::Class} ); |
347 | } |
348 | |
349 | { |
350 | package My::Class8; |
351 | use Moose; |
352 | |
353 | Moose::Util::MetaRole::apply_metaclass_roles( |
354 | for_class => 'My::Class8', |
355 | metaclass_roles => ['Role::Bar'], |
356 | attribute_metaclass_roles => ['Role::Bar'], |
357 | ); |
358 | |
359 | extends 'My::Class'; |
360 | } |
361 | |
362 | { |
363 | ok( My::Class8->meta()->meta()->does_role('Role::Bar'), |
364 | q{apply Role::Bar My::Class8->meta() before extends} ); |
365 | ok( My::Class8->meta()->meta()->does_role('Role::Foo'), |
366 | q{... and My::Class8->meta() does Role::Foo because My::Class8 extends My::Class} ); |
367 | ok( My::Class8->meta()->attribute_metaclass->meta()->does_role('Role::Bar'), |
368 | q{apply Role::Bar to My::Class8->meta()->attribute_metaclass before extends} ); |
369 | ok( My::Class8->meta()->attribute_metaclass->meta()->does_role('Role::Foo'), |
370 | q{... and My::Class8->meta()->attribute_metaclass does Role::Foo because My::Class8 extends My::Class} ); |
371 | } |
372 | |
373 | |
374 | { |
375 | package My::Class9; |
376 | use Moose; |
377 | |
378 | Moose::Util::MetaRole::apply_metaclass_roles( |
379 | for_class => 'My::Class9', |
380 | attribute_metaclass_roles => ['Role::Bar'], |
381 | ); |
382 | |
383 | extends 'My::Class'; |
384 | } |
385 | |
386 | { |
387 | ok( My::Class9->meta()->meta()->does_role('Role::Foo'), |
388 | q{... and My::Class9->meta() does Role::Foo because My::Class9 extends My::Class} ); |
389 | ok( My::Class9->meta()->attribute_metaclass->meta()->does_role('Role::Bar'), |
390 | q{apply Role::Bar to My::Class9->meta()->attribute_metaclass before extends} ); |
391 | ok( My::Class9->meta()->attribute_metaclass->meta()->does_role('Role::Foo'), |
392 | q{... and My::Class9->meta()->attribute_metaclass does Role::Foo because My::Class9 extends My::Class} ); |
4fed6bbc |
393 | } |
dd37a5be |
394 | |
395 | # This tests applying meta roles to a metaclass's metaclass. This is |
396 | # completely insane, but is exactly what happens with |
397 | # Fey::Meta::Class::Table. It's a subclass of Moose::Meta::Class |
398 | # itself, and then it _uses_ MooseX::ClassAttribute, so the metaclass |
399 | # for Fey::Meta::Class::Table does a role. |
400 | # |
401 | # At one point this caused a metaclass incompatibility error down |
402 | # below, when we applied roles to the metaclass of My::Class10. It's |
403 | # all madness but as long as the tests pass we're happy. |
404 | { |
405 | package My::Meta::Class2; |
406 | use Moose; |
407 | extends 'Moose::Meta::Class'; |
408 | |
409 | Moose::Util::MetaRole::apply_metaclass_roles( |
410 | for_class => 'My::Meta::Class2', |
411 | metaclass_roles => ['Role::Foo'], |
412 | ); |
413 | } |
414 | |
415 | { |
416 | package My::Meta2; |
417 | |
418 | use Moose::Exporter; |
419 | Moose::Exporter->setup_import_methods( also => 'Moose' ); |
420 | |
421 | sub init_meta { |
422 | shift; |
423 | my %p = @_; |
424 | |
425 | Moose->init_meta( %p, metaclass => 'My::Meta::Class2' ); |
426 | } |
427 | } |
428 | |
429 | { |
430 | package My::Class10; |
431 | My::Meta2->import; |
432 | |
433 | Moose::Util::MetaRole::apply_metaclass_roles( |
434 | for_class => 'My::Class10', |
435 | metaclass_roles => ['Role::Bar'], |
436 | ); |
437 | } |
438 | |
439 | { |
440 | ok( My::Class10->meta()->meta()->meta()->does_role('Role::Foo'), |
441 | q{My::Class10->meta()->meta() does Role::Foo } ); |
b72373c4 |
442 | ok( My::Class10->meta()->meta()->does_role('Role::Bar'), |
443 | q{My::Class10->meta()->meta() does Role::Bar } ); |
dd37a5be |
444 | ok( My::Class10->meta()->isa('My::Meta::Class2'), |
445 | q{... and My::Class10->meta still isa(My::Meta::Class2)} ); |
446 | } |