Commit | Line | Data |
60b5c3be |
1 | #!/usr/bin/perl |
fde8e43f |
2 | # This is automatically generated by author/import-moose-test.pl. |
3 | # DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!! |
4 | use t::lib::MooseCompat; |
60b5c3be |
5 | |
6 | use strict; |
7 | use warnings; |
8 | |
6475f69d |
9 | use Test::More; |
60b5c3be |
10 | use Test::Exception; |
11 | |
12 | =pod |
13 | |
14 | Mutually recursive roles. |
15 | |
16 | =cut |
17 | |
18 | { |
19 | package Role::Foo; |
20 | use Mouse::Role; |
21 | |
22 | requires 'foo'; |
23 | |
24 | sub bar { 'Role::Foo::bar' } |
25 | |
26 | package Role::Bar; |
27 | use Mouse::Role; |
28 | |
29 | requires 'bar'; |
30 | |
31 | sub foo { 'Role::Bar::foo' } |
32 | } |
33 | |
34 | { |
35 | package My::Test1; |
36 | use Mouse; |
37 | |
38 | ::lives_ok { |
39 | with 'Role::Foo', 'Role::Bar'; |
40 | } '... our mutually recursive roles combine okay'; |
41 | |
42 | package My::Test2; |
43 | use Mouse; |
44 | |
45 | ::lives_ok { |
46 | with 'Role::Bar', 'Role::Foo'; |
47 | } '... our mutually recursive roles combine okay (no matter what order)'; |
48 | } |
49 | |
50 | my $test1 = My::Test1->new; |
51 | isa_ok($test1, 'My::Test1'); |
52 | |
53 | ok($test1->does('Role::Foo'), '... $test1 does Role::Foo'); |
54 | ok($test1->does('Role::Bar'), '... $test1 does Role::Bar'); |
55 | |
56 | can_ok($test1, 'foo'); |
57 | can_ok($test1, 'bar'); |
58 | |
59 | is($test1->foo, 'Role::Bar::foo', '... $test1->foo worked'); |
60 | is($test1->bar, 'Role::Foo::bar', '... $test1->bar worked'); |
61 | |
62 | my $test2 = My::Test2->new; |
63 | isa_ok($test2, 'My::Test2'); |
64 | |
65 | ok($test2->does('Role::Foo'), '... $test2 does Role::Foo'); |
66 | ok($test2->does('Role::Bar'), '... $test2 does Role::Bar'); |
67 | |
68 | can_ok($test2, 'foo'); |
69 | can_ok($test2, 'bar'); |
70 | |
71 | is($test2->foo, 'Role::Bar::foo', '... $test2->foo worked'); |
72 | is($test2->bar, 'Role::Foo::bar', '... $test2->bar worked'); |
73 | |
74 | # check some meta-stuff |
75 | |
76 | ok(Role::Foo->meta->has_method('bar'), '... it still has the bar method'); |
77 | ok(Role::Foo->meta->requires_method('foo'), '... it still has the required foo method'); |
78 | |
79 | ok(Role::Bar->meta->has_method('foo'), '... it still has the foo method'); |
80 | ok(Role::Bar->meta->requires_method('bar'), '... it still has the required bar method'); |
81 | |
82 | =pod |
83 | |
84 | Role method conflicts |
85 | |
86 | =cut |
87 | |
88 | { |
89 | package Role::Bling; |
90 | use Mouse::Role; |
91 | |
92 | sub bling { 'Role::Bling::bling' } |
93 | |
94 | package Role::Bling::Bling; |
95 | use Mouse::Role; |
96 | |
97 | sub bling { 'Role::Bling::Bling::bling' } |
98 | } |
99 | |
100 | { |
101 | package My::Test3; |
102 | use Mouse; |
103 | |
104 | ::throws_ok { |
105 | with 'Role::Bling', 'Role::Bling::Bling'; |
106 | } qr/Due to a method name conflict in roles 'Role::Bling' and 'Role::Bling::Bling', the method 'bling' must be implemented or excluded by 'My::Test3'/, '... role methods conflict and method was required'; |
107 | |
108 | package My::Test4; |
109 | use Mouse; |
110 | |
111 | ::lives_ok { |
112 | with 'Role::Bling'; |
113 | with 'Role::Bling::Bling'; |
114 | } '... role methods didnt conflict when manually combined'; |
115 | |
116 | package My::Test5; |
117 | use Mouse; |
118 | |
119 | ::lives_ok { |
120 | with 'Role::Bling::Bling'; |
121 | with 'Role::Bling'; |
122 | } '... role methods didnt conflict when manually combined (in opposite order)'; |
123 | |
124 | package My::Test6; |
125 | use Mouse; |
126 | |
127 | ::lives_ok { |
128 | with 'Role::Bling::Bling', 'Role::Bling'; |
129 | } '... role methods didnt conflict when manually resolved'; |
130 | |
131 | sub bling { 'My::Test6::bling' } |
132 | } |
133 | |
134 | ok(!My::Test3->meta->has_method('bling'), '... we didnt get any methods in the conflict'); |
135 | ok(My::Test4->meta->has_method('bling'), '... we did get the method when manually dealt with'); |
136 | ok(My::Test5->meta->has_method('bling'), '... we did get the method when manually dealt with'); |
137 | ok(My::Test6->meta->has_method('bling'), '... we did get the method when manually dealt with'); |
138 | |
139 | ok(!My::Test3->does('Role::Bling'), '... our class does() the correct roles'); |
140 | ok(!My::Test3->does('Role::Bling::Bling'), '... our class does() the correct roles'); |
141 | ok(My::Test4->does('Role::Bling'), '... our class does() the correct roles'); |
142 | ok(My::Test4->does('Role::Bling::Bling'), '... our class does() the correct roles'); |
143 | ok(My::Test5->does('Role::Bling'), '... our class does() the correct roles'); |
144 | ok(My::Test5->does('Role::Bling::Bling'), '... our class does() the correct roles'); |
145 | ok(My::Test6->does('Role::Bling'), '... our class does() the correct roles'); |
146 | ok(My::Test6->does('Role::Bling::Bling'), '... our class does() the correct roles'); |
147 | |
148 | is(My::Test4->bling, 'Role::Bling::bling', '... and we got the first method that was added'); |
149 | is(My::Test5->bling, 'Role::Bling::Bling::bling', '... and we got the first method that was added'); |
150 | is(My::Test6->bling, 'My::Test6::bling', '... and we got the local method'); |
151 | |
152 | # check how this affects role compostion |
153 | |
154 | { |
155 | package Role::Bling::Bling::Bling; |
156 | use Mouse::Role; |
157 | |
158 | with 'Role::Bling::Bling'; |
159 | |
160 | sub bling { 'Role::Bling::Bling::Bling::bling' } |
161 | } |
162 | |
163 | ok(Role::Bling::Bling->meta->has_method('bling'), '... still got the bling method in Role::Bling::Bling'); |
164 | ok(Role::Bling::Bling->meta->does_role('Role::Bling::Bling'), '... our role correctly does() the other role'); |
165 | ok(Role::Bling::Bling::Bling->meta->has_method('bling'), '... dont have the bling method in Role::Bling::Bling::Bling'); |
166 | is(Role::Bling::Bling::Bling->meta->get_method('bling')->(), |
167 | 'Role::Bling::Bling::Bling::bling', |
168 | '... still got the bling method in Role::Bling::Bling::Bling'); |
169 | |
170 | |
171 | =pod |
172 | |
173 | Role attribute conflicts |
174 | |
175 | =cut |
176 | |
177 | { |
178 | package Role::Boo; |
179 | use Mouse::Role; |
180 | |
181 | has 'ghost' => (is => 'ro', default => 'Role::Boo::ghost'); |
182 | |
183 | package Role::Boo::Hoo; |
184 | use Mouse::Role; |
185 | |
186 | has 'ghost' => (is => 'ro', default => 'Role::Boo::Hoo::ghost'); |
187 | } |
188 | |
189 | { |
190 | package My::Test7; |
191 | use Mouse; |
192 | |
193 | ::throws_ok { |
194 | with 'Role::Boo', 'Role::Boo::Hoo'; |
195 | } qr/We have encountered an attribute conflict/, |
196 | '... role attrs conflict and method was required'; |
197 | |
198 | package My::Test8; |
199 | use Mouse; |
200 | |
201 | ::lives_ok { |
202 | with 'Role::Boo'; |
203 | with 'Role::Boo::Hoo'; |
204 | } '... role attrs didnt conflict when manually combined'; |
205 | |
206 | package My::Test9; |
207 | use Mouse; |
208 | |
209 | ::lives_ok { |
210 | with 'Role::Boo::Hoo'; |
211 | with 'Role::Boo'; |
212 | } '... role attrs didnt conflict when manually combined'; |
213 | |
214 | package My::Test10; |
215 | use Mouse; |
216 | |
217 | has 'ghost' => (is => 'ro', default => 'My::Test10::ghost'); |
218 | |
219 | ::throws_ok { |
220 | with 'Role::Boo', 'Role::Boo::Hoo'; |
221 | } qr/We have encountered an attribute conflict/, |
222 | '... role attrs conflict and cannot be manually disambiguted'; |
223 | |
224 | } |
225 | |
226 | ok(!My::Test7->meta->has_attribute('ghost'), '... we didnt get any attributes in the conflict'); |
227 | ok(My::Test8->meta->has_attribute('ghost'), '... we did get an attributes when manually composed'); |
228 | ok(My::Test9->meta->has_attribute('ghost'), '... we did get an attributes when manually composed'); |
229 | ok(My::Test10->meta->has_attribute('ghost'), '... we did still have an attribute ghost (conflict does not mess with class)'); |
230 | |
231 | ok(!My::Test7->does('Role::Boo'), '... our class does() the correct roles'); |
232 | ok(!My::Test7->does('Role::Boo::Hoo'), '... our class does() the correct roles'); |
233 | ok(My::Test8->does('Role::Boo'), '... our class does() the correct roles'); |
234 | ok(My::Test8->does('Role::Boo::Hoo'), '... our class does() the correct roles'); |
235 | ok(My::Test9->does('Role::Boo'), '... our class does() the correct roles'); |
236 | ok(My::Test9->does('Role::Boo::Hoo'), '... our class does() the correct roles'); |
237 | ok(!My::Test10->does('Role::Boo'), '... our class does() the correct roles'); |
238 | ok(!My::Test10->does('Role::Boo::Hoo'), '... our class does() the correct roles'); |
239 | |
240 | can_ok('My::Test8', 'ghost'); |
241 | can_ok('My::Test9', 'ghost'); |
242 | can_ok('My::Test10', 'ghost'); |
243 | |
244 | is(My::Test8->new->ghost, 'Role::Boo::ghost', '... got the expected default attr value'); |
245 | is(My::Test9->new->ghost, 'Role::Boo::Hoo::ghost', '... got the expected default attr value'); |
246 | is(My::Test10->new->ghost, 'My::Test10::ghost', '... got the expected default attr value'); |
247 | |
248 | =pod |
249 | |
250 | Role override method conflicts |
251 | |
252 | =cut |
253 | |
254 | { |
255 | package Role::Plot; |
256 | use Mouse::Role; |
257 | |
258 | override 'twist' => sub { |
259 | super() . ' -> Role::Plot::twist'; |
260 | }; |
261 | |
262 | package Role::Truth; |
263 | use Mouse::Role; |
264 | |
265 | override 'twist' => sub { |
266 | super() . ' -> Role::Truth::twist'; |
267 | }; |
268 | } |
269 | |
270 | { |
271 | package My::Test::Base; |
272 | use Mouse; |
273 | |
274 | sub twist { 'My::Test::Base::twist' } |
275 | |
276 | package My::Test11; |
277 | use Mouse; |
278 | |
279 | extends 'My::Test::Base'; |
280 | |
281 | ::lives_ok { |
282 | with 'Role::Truth'; |
283 | } '... composed the role with override okay'; |
284 | |
285 | package My::Test12; |
286 | use Mouse; |
287 | |
288 | extends 'My::Test::Base'; |
289 | |
290 | ::lives_ok { |
291 | with 'Role::Plot'; |
292 | } '... composed the role with override okay'; |
293 | |
294 | package My::Test13; |
295 | use Mouse; |
296 | |
297 | ::dies_ok { |
298 | with 'Role::Plot'; |
299 | } '... cannot compose it because we have no superclass'; |
300 | |
301 | package My::Test14; |
302 | use Mouse; |
303 | |
304 | extends 'My::Test::Base'; |
305 | |
306 | ::throws_ok { |
307 | with 'Role::Plot', 'Role::Truth'; |
308 | } qr/Two \'override\' methods of the same name encountered/, |
309 | '... cannot compose it because we have no superclass'; |
310 | } |
311 | |
312 | ok(My::Test11->meta->has_method('twist'), '... the twist method has been added'); |
313 | ok(My::Test12->meta->has_method('twist'), '... the twist method has been added'); |
314 | ok(!My::Test13->meta->has_method('twist'), '... the twist method has not been added'); |
315 | ok(!My::Test14->meta->has_method('twist'), '... the twist method has not been added'); |
316 | |
317 | ok(!My::Test11->does('Role::Plot'), '... our class does() the correct roles'); |
318 | ok(My::Test11->does('Role::Truth'), '... our class does() the correct roles'); |
319 | ok(!My::Test12->does('Role::Truth'), '... our class does() the correct roles'); |
320 | ok(My::Test12->does('Role::Plot'), '... our class does() the correct roles'); |
321 | ok(!My::Test13->does('Role::Plot'), '... our class does() the correct roles'); |
322 | ok(!My::Test14->does('Role::Truth'), '... our class does() the correct roles'); |
323 | ok(!My::Test14->does('Role::Plot'), '... our class does() the correct roles'); |
324 | |
325 | is(My::Test11->twist(), 'My::Test::Base::twist -> Role::Truth::twist', '... got the right method return'); |
326 | is(My::Test12->twist(), 'My::Test::Base::twist -> Role::Plot::twist', '... got the right method return'); |
327 | ok(!My::Test13->can('twist'), '... no twist method here at all'); |
328 | is(My::Test14->twist(), 'My::Test::Base::twist', '... got the right method return (from superclass)'); |
329 | |
330 | { |
331 | package Role::Reality; |
332 | use Mouse::Role; |
333 | |
334 | ::throws_ok { |
335 | with 'Role::Plot'; |
336 | } qr/A local method of the same name as been found/, |
337 | '... could not compose roles here, it dies'; |
338 | |
339 | sub twist { |
340 | 'Role::Reality::twist'; |
341 | } |
342 | } |
343 | |
344 | ok(Role::Reality->meta->has_method('twist'), '... the twist method has not been added'); |
345 | #ok(!Role::Reality->meta->does_role('Role::Plot'), '... our role does() the correct roles'); |
346 | is(Role::Reality->meta->get_method('twist')->(), |
347 | 'Role::Reality::twist', |
348 | '... the twist method returns the right value'); |
349 | |
350 | # Ovid's test case from rt.cpan.org #44 |
351 | { |
352 | package Role1; |
353 | use Mouse::Role; |
354 | |
355 | sub foo {} |
356 | } |
357 | { |
358 | package Role2; |
359 | use Mouse::Role; |
360 | |
361 | sub foo {} |
362 | } |
363 | { |
364 | package Conflicts; |
365 | use Mouse; |
366 | |
367 | ::throws_ok { |
368 | with qw(Role1 Role2); |
369 | } qr/Due to a method name conflict in roles 'Role1' and 'Role2', the method 'foo' must be implemented or excluded by 'Conflicts'/; |
370 | } |
371 | |
372 | =pod |
373 | |
374 | Role conflicts between attributes and methods |
375 | |
376 | [15:23] <kolibrie> when class defines method and role defines method, class wins |
377 | [15:24] <kolibrie> when class 'has' method and role defines method, class wins |
378 | [15:24] <kolibrie> when class defines method and role 'has' method, role wins |
379 | [15:24] <kolibrie> when class 'has' method and role 'has' method, role wins |
380 | [15:24] <kolibrie> which means when class 'has' method and two roles 'has' method, no tiebreak is detected |
381 | [15:24] <perigrin> this is with role and has declaration in the exact same order in every case? |
382 | [15:25] <kolibrie> yes |
383 | [15:25] <perigrin> interesting |
384 | [15:25] <kolibrie> that's what I thought |
385 | [15:26] <kolibrie> does that sound like something I should write a test for? |
386 | [15:27] <perigrin> stevan, ping? |
387 | [15:27] <perigrin> I'm not sure what the right answer for composition is. |
388 | [15:27] <perigrin> who should win |
389 | [15:27] <perigrin> if I were to guess I'd say the class should always win. |
390 | [15:27] <kolibrie> that would be my guess, but I thought I would ask to make sure |
391 | [15:29] <stevan> kolibrie: please write a test |
392 | [15:29] <stevan> I am not exactly sure who should win either,.. but I suspect it is not working correctly right now |
393 | [15:29] <stevan> I know exactly why it is doing what it is doing though |
394 | |
395 | Now I have to decide actually what happens, and how to fix it. |
396 | - SL |
397 | |
398 | { |
399 | package Role::Method; |
400 | use Mouse::Role; |
401 | |
402 | sub ghost { 'Role::Method::ghost' } |
403 | |
404 | package Role::Method2; |
405 | use Mouse::Role; |
406 | |
407 | sub ghost { 'Role::Method2::ghost' } |
408 | |
409 | package Role::Attribute; |
410 | use Mouse::Role; |
411 | |
412 | has 'ghost' => (is => 'ro', default => 'Role::Attribute::ghost'); |
413 | |
414 | package Role::Attribute2; |
415 | use Mouse::Role; |
416 | |
417 | has 'ghost' => (is => 'ro', default => 'Role::Attribute2::ghost'); |
418 | } |
419 | |
420 | { |
421 | package My::Test15; |
422 | use Mouse; |
423 | |
424 | ::lives_ok { |
425 | with 'Role::Method'; |
426 | } '... composed the method role into the method class'; |
427 | |
428 | sub ghost { 'My::Test15::ghost' } |
429 | |
430 | package My::Test16; |
431 | use Mouse; |
432 | |
433 | ::lives_ok { |
434 | with 'Role::Method'; |
435 | } '... composed the method role into the attribute class'; |
436 | |
437 | has 'ghost' => (is => 'ro', default => 'My::Test16::ghost'); |
438 | |
439 | package My::Test17; |
440 | use Mouse; |
441 | |
442 | ::lives_ok { |
443 | with 'Role::Attribute'; |
444 | } '... composed the attribute role into the method class'; |
445 | |
446 | sub ghost { 'My::Test17::ghost' } |
447 | |
448 | package My::Test18; |
449 | use Mouse; |
450 | |
451 | ::lives_ok { |
452 | with 'Role::Attribute'; |
453 | } '... composed the attribute role into the attribute class'; |
454 | |
455 | has 'ghost' => (is => 'ro', default => 'My::Test18::ghost'); |
456 | |
457 | package My::Test19; |
458 | use Mouse; |
459 | |
460 | ::lives_ok { |
461 | with 'Role::Method', 'Role::Method2'; |
462 | } '... composed method roles into class with method tiebreaker'; |
463 | |
464 | sub ghost { 'My::Test19::ghost' } |
465 | |
466 | package My::Test20; |
467 | use Mouse; |
468 | |
469 | ::lives_ok { |
470 | with 'Role::Method', 'Role::Method2'; |
471 | } '... composed method roles into class with attribute tiebreaker'; |
472 | |
473 | has 'ghost' => (is => 'ro', default => 'My::Test20::ghost'); |
474 | |
475 | package My::Test21; |
476 | use Mouse; |
477 | |
478 | ::lives_ok { |
479 | with 'Role::Attribute', 'Role::Attribute2'; |
480 | } '... composed attribute roles into class with method tiebreaker'; |
481 | |
482 | sub ghost { 'My::Test21::ghost' } |
483 | |
484 | package My::Test22; |
485 | use Mouse; |
486 | |
487 | ::lives_ok { |
488 | with 'Role::Attribute', 'Role::Attribute2'; |
489 | } '... composed attribute roles into class with attribute tiebreaker'; |
490 | |
491 | has 'ghost' => (is => 'ro', default => 'My::Test22::ghost'); |
492 | |
493 | package My::Test23; |
494 | use Mouse; |
495 | |
496 | ::lives_ok { |
497 | with 'Role::Method', 'Role::Attribute'; |
498 | } '... composed method and attribute role into class with method tiebreaker'; |
499 | |
500 | sub ghost { 'My::Test23::ghost' } |
501 | |
502 | package My::Test24; |
503 | use Mouse; |
504 | |
505 | ::lives_ok { |
506 | with 'Role::Method', 'Role::Attribute'; |
507 | } '... composed method and attribute role into class with attribute tiebreaker'; |
508 | |
509 | has 'ghost' => (is => 'ro', default => 'My::Test24::ghost'); |
510 | |
511 | package My::Test25; |
512 | use Mouse; |
513 | |
514 | ::lives_ok { |
515 | with 'Role::Attribute', 'Role::Method'; |
516 | } '... composed attribute and method role into class with method tiebreaker'; |
517 | |
518 | sub ghost { 'My::Test25::ghost' } |
519 | |
520 | package My::Test26; |
521 | use Mouse; |
522 | |
523 | ::lives_ok { |
524 | with 'Role::Attribute', 'Role::Method'; |
525 | } '... composed attribute and method role into class with attribute tiebreaker'; |
526 | |
527 | has 'ghost' => (is => 'ro', default => 'My::Test26::ghost'); |
528 | } |
529 | |
530 | my $test15 = My::Test15->new; |
531 | isa_ok($test15, 'My::Test15'); |
532 | is($test15->ghost, 'My::Test15::ghost', '... we access the method from the class and ignore the role method'); |
533 | |
534 | my $test16 = My::Test16->new; |
535 | isa_ok($test16, 'My::Test16'); |
536 | is($test16->ghost, 'My::Test16::ghost', '... we access the attribute from the class and ignore the role method'); |
537 | |
538 | my $test17 = My::Test17->new; |
539 | isa_ok($test17, 'My::Test17'); |
540 | is($test17->ghost, 'My::Test17::ghost', '... we access the method from the class and ignore the role attribute'); |
541 | |
542 | my $test18 = My::Test18->new; |
543 | isa_ok($test18, 'My::Test18'); |
544 | is($test18->ghost, 'My::Test18::ghost', '... we access the attribute from the class and ignore the role attribute'); |
545 | |
546 | my $test19 = My::Test19->new; |
547 | isa_ok($test19, 'My::Test19'); |
548 | is($test19->ghost, 'My::Test19::ghost', '... we access the method from the class and ignore the role methods'); |
549 | |
550 | my $test20 = My::Test20->new; |
551 | isa_ok($test20, 'My::Test20'); |
552 | is($test20->ghost, 'My::Test20::ghost', '... we access the attribute from the class and ignore the role methods'); |
553 | |
554 | my $test21 = My::Test21->new; |
555 | isa_ok($test21, 'My::Test21'); |
556 | is($test21->ghost, 'My::Test21::ghost', '... we access the method from the class and ignore the role attributes'); |
557 | |
558 | my $test22 = My::Test22->new; |
559 | isa_ok($test22, 'My::Test22'); |
560 | is($test22->ghost, 'My::Test22::ghost', '... we access the attribute from the class and ignore the role attributes'); |
561 | |
562 | my $test23 = My::Test23->new; |
563 | isa_ok($test23, 'My::Test23'); |
564 | is($test23->ghost, 'My::Test23::ghost', '... we access the method from the class and ignore the role method and attribute'); |
565 | |
566 | my $test24 = My::Test24->new; |
567 | isa_ok($test24, 'My::Test24'); |
568 | is($test24->ghost, 'My::Test24::ghost', '... we access the attribute from the class and ignore the role method and attribute'); |
569 | |
570 | my $test25 = My::Test25->new; |
571 | isa_ok($test25, 'My::Test25'); |
572 | is($test25->ghost, 'My::Test25::ghost', '... we access the method from the class and ignore the role attribute and method'); |
573 | |
574 | my $test26 = My::Test26->new; |
575 | isa_ok($test26, 'My::Test26'); |
576 | is($test26->ghost, 'My::Test26::ghost', '... we access the attribute from the class and ignore the role attribute and method'); |
577 | |
578 | =cut |
6475f69d |
579 | |
580 | done_testing; |