more-tests
[gitmo/Moose.git] / t / 044_role_conflict_detection.t
CommitLineData
db1ab48d 1#!/usr/bin/perl
2
3use strict;
4use warnings;
5
d79e62fd 6use Test::More tests => 90;
db1ab48d 7use Test::Exception;
8
9BEGIN {
10 use_ok('Moose');
11 use_ok('Moose::Role');
12}
13
14=pod
15
16Mutually recursive roles.
17
18=cut
19
20{
21 package Role::Foo;
22 use strict;
23 use warnings;
24 use Moose::Role;
25
26 requires 'foo';
27
28 sub bar { 'Role::Foo::bar' }
29
30 package Role::Bar;
31 use strict;
32 use warnings;
33 use Moose::Role;
34
35 requires 'bar';
36
37 sub foo { 'Role::Bar::foo' }
38}
39
40{
41 package My::Test1;
42 use strict;
43 use warnings;
44 use Moose;
45
46 ::lives_ok {
47 with 'Role::Foo', 'Role::Bar';
48 } '... our mutually recursive roles combine okay';
49
50 package My::Test2;
51 use strict;
52 use warnings;
53 use Moose;
54
55 ::lives_ok {
56 with 'Role::Bar', 'Role::Foo';
57 } '... our mutually recursive roles combine okay (no matter what order)';
58}
59
60my $test1 = My::Test1->new;
61isa_ok($test1, 'My::Test1');
62
63ok($test1->does('Role::Foo'), '... $test1 does Role::Foo');
64ok($test1->does('Role::Bar'), '... $test1 does Role::Bar');
65
66can_ok($test1, 'foo');
67can_ok($test1, 'bar');
68
69is($test1->foo, 'Role::Bar::foo', '... $test1->foo worked');
70is($test1->bar, 'Role::Foo::bar', '... $test1->bar worked');
71
72my $test2 = My::Test2->new;
73isa_ok($test2, 'My::Test2');
74
75ok($test2->does('Role::Foo'), '... $test2 does Role::Foo');
76ok($test2->does('Role::Bar'), '... $test2 does Role::Bar');
77
78can_ok($test2, 'foo');
79can_ok($test2, 'bar');
80
81is($test2->foo, 'Role::Bar::foo', '... $test2->foo worked');
82is($test2->bar, 'Role::Foo::bar', '... $test2->bar worked');
83
84# check some meta-stuff
85
86ok(Role::Foo->meta->has_method('bar'), '... it still has the bar method');
87ok(Role::Foo->meta->requires_method('foo'), '... it still has the required foo method');
88
89ok(Role::Bar->meta->has_method('foo'), '... it still has the foo method');
90ok(Role::Bar->meta->requires_method('bar'), '... it still has the required bar method');
91
92=pod
93
94Role method conflicts
95
96=cut
97
98{
99 package Role::Bling;
100 use strict;
101 use warnings;
102 use Moose::Role;
103
104 sub bling { 'Role::Bling::bling' }
105
106 package Role::Bling::Bling;
107 use strict;
108 use warnings;
109 use Moose::Role;
110
111 sub bling { 'Role::Bling::Bling::bling' }
112}
113
114{
115 package My::Test3;
116 use strict;
117 use warnings;
118 use Moose;
119
120 ::throws_ok {
121 with 'Role::Bling', 'Role::Bling::Bling';
122 } qr/requires the method \'bling\' to be implemented/, '... role methods conflicted and method was required';
123
124 package My::Test4;
125 use strict;
126 use warnings;
127 use Moose;
128
129 ::lives_ok {
130 with 'Role::Bling';
131 with 'Role::Bling::Bling';
132 } '... role methods didnt conflict when manually combined';
133
134 package My::Test5;
135 use strict;
136 use warnings;
137 use Moose;
138
139 ::lives_ok {
140 with 'Role::Bling::Bling';
141 with 'Role::Bling';
142 } '... role methods didnt conflict when manually combined (in opposite order)';
143
144 package My::Test6;
145 use strict;
146 use warnings;
147 use Moose;
148
149 ::lives_ok {
150 with 'Role::Bling::Bling', 'Role::Bling';
151 } '... role methods didnt conflict when manually resolved';
152
153 sub bling { 'My::Test6::bling' }
154}
155
156ok(!My::Test3->meta->has_method('bling'), '... we didnt get any methods in the conflict');
157ok(My::Test4->meta->has_method('bling'), '... we did get the method when manually dealt with');
158ok(My::Test5->meta->has_method('bling'), '... we did get the method when manually dealt with');
159ok(My::Test6->meta->has_method('bling'), '... we did get the method when manually dealt with');
160
d79e62fd 161ok(!My::Test3->does('Role::Bling'), '... our class does() the correct roles');
162ok(!My::Test3->does('Role::Bling::Bling'), '... our class does() the correct roles');
163ok(My::Test4->does('Role::Bling'), '... our class does() the correct roles');
164ok(My::Test4->does('Role::Bling::Bling'), '... our class does() the correct roles');
165ok(My::Test5->does('Role::Bling'), '... our class does() the correct roles');
166ok(My::Test5->does('Role::Bling::Bling'), '... our class does() the correct roles');
167ok(My::Test6->does('Role::Bling'), '... our class does() the correct roles');
168ok(My::Test6->does('Role::Bling::Bling'), '... our class does() the correct roles');
169
db1ab48d 170is(My::Test4->bling, 'Role::Bling::bling', '... and we got the first method that was added');
171is(My::Test5->bling, 'Role::Bling::Bling::bling', '... and we got the first method that was added');
172is(My::Test6->bling, 'My::Test6::bling', '... and we got the local method');
173
174# check how this affects role compostion
175
176{
177 package Role::Bling::Bling::Bling;
178 use strict;
179 use warnings;
180 use Moose::Role;
181
182 with 'Role::Bling::Bling';
183
184 sub bling { 'Role::Bling::Bling::Bling::bling' }
185}
186
187ok(Role::Bling::Bling->meta->has_method('bling'), '... still got the bling method in Role::Bling::Bling');
d79e62fd 188ok(Role::Bling::Bling->meta->does_role('Role::Bling::Bling'), '... our role correctly does() the other role');
db1ab48d 189ok(Role::Bling::Bling::Bling->meta->has_method('bling'), '... still got the bling method in Role::Bling::Bling::Bling');
d05cd563 190is(Role::Bling::Bling::Bling->meta->get_method('bling')->(),
191 'Role::Bling::Bling::Bling::bling',
192 '... still got the bling method in Role::Bling::Bling::Bling');
db1ab48d 193
194=pod
195
196Role attribute conflicts
197
198=cut
199
200{
201 package Role::Boo;
202 use strict;
203 use warnings;
204 use Moose::Role;
205
206 has 'ghost' => (is => 'ro', default => 'Role::Boo::ghost');
207
208 package Role::Boo::Hoo;
209 use strict;
210 use warnings;
211 use Moose::Role;
212
213 has 'ghost' => (is => 'ro', default => 'Role::Boo::Hoo::ghost');
214}
215
216{
217 package My::Test7;
218 use strict;
219 use warnings;
220 use Moose;
221
222 ::throws_ok {
223 with 'Role::Boo', 'Role::Boo::Hoo';
224 } qr/Role \'Role::Boo::Hoo\' has encountered an attribute conflict/,
225 '... role attrs conflicted and method was required';
226
227 package My::Test8;
228 use strict;
229 use warnings;
230 use Moose;
231
232 ::lives_ok {
233 with 'Role::Boo';
234 with 'Role::Boo::Hoo';
235 } '... role attrs didnt conflict when manually combined';
236
237 package My::Test9;
238 use strict;
239 use warnings;
240 use Moose;
241
242 ::lives_ok {
243 with 'Role::Boo::Hoo';
244 with 'Role::Boo';
245 } '... role attrs didnt conflict when manually combined';
246
247 package My::Test10;
248 use strict;
249 use warnings;
250 use Moose;
251
252 has 'ghost' => (is => 'ro', default => 'My::Test10::ghost');
253
254 ::throws_ok {
255 with 'Role::Boo', 'Role::Boo::Hoo';
256 } qr/Role \'Role::Boo::Hoo\' has encountered an attribute conflict/,
257 '... role attrs conflicted and cannot be manually disambiguted';
258
259}
260
261ok(!My::Test7->meta->has_attribute('ghost'), '... we didnt get any attributes in the conflict');
262ok(My::Test8->meta->has_attribute('ghost'), '... we did get an attributes when manually composed');
263ok(My::Test9->meta->has_attribute('ghost'), '... we did get an attributes when manually composed');
264ok(My::Test10->meta->has_attribute('ghost'), '... we did still have an attribute ghost (conflict does not mess with class)');
265
d79e62fd 266ok(!My::Test7->does('Role::Boo'), '... our class does() the correct roles');
267ok(!My::Test7->does('Role::Boo::Hoo'), '... our class does() the correct roles');
268ok(My::Test8->does('Role::Boo'), '... our class does() the correct roles');
269ok(My::Test8->does('Role::Boo::Hoo'), '... our class does() the correct roles');
270ok(My::Test9->does('Role::Boo'), '... our class does() the correct roles');
271ok(My::Test9->does('Role::Boo::Hoo'), '... our class does() the correct roles');
272ok(!My::Test10->does('Role::Boo'), '... our class does() the correct roles');
273ok(!My::Test10->does('Role::Boo::Hoo'), '... our class does() the correct roles');
274
db1ab48d 275can_ok('My::Test8', 'ghost');
276can_ok('My::Test9', 'ghost');
277can_ok('My::Test10', 'ghost');
278
279is(My::Test8->new->ghost, 'Role::Boo::ghost', '... got the expected default attr value');
280is(My::Test9->new->ghost, 'Role::Boo::Hoo::ghost', '... got the expected default attr value');
281is(My::Test10->new->ghost, 'My::Test10::ghost', '... got the expected default attr value');
282
d05cd563 283=pod
284
285Role override method conflicts
286
287=cut
288
289{
d79e62fd 290 package Role::Plot;
d05cd563 291 use strict;
292 use warnings;
293 use Moose::Role;
294
295 override 'twist' => sub {
d79e62fd 296 super() . ' -> Role::Plot::twist';
d05cd563 297 };
298
d79e62fd 299 package Role::Truth;
d05cd563 300 use strict;
301 use warnings;
302 use Moose::Role;
303
304 override 'twist' => sub {
d79e62fd 305 super() . ' -> Role::Truth::twist';
d05cd563 306 };
307}
308
309{
310 package My::Test::Base;
311 use strict;
312 use warnings;
313 use Moose;
314
315 sub twist { 'My::Test::Base::twist' }
316
317 package My::Test11;
318 use strict;
319 use warnings;
320 use Moose;
321
322 extends 'My::Test::Base';
323
324 ::lives_ok {
d79e62fd 325 with 'Role::Truth';
d05cd563 326 } '... composed the role with override okay';
327
328 package My::Test12;
329 use strict;
330 use warnings;
331 use Moose;
332
333 extends 'My::Test::Base';
334
335 ::lives_ok {
d79e62fd 336 with 'Role::Plot';
d05cd563 337 } '... composed the role with override okay';
338
339 package My::Test13;
340 use strict;
341 use warnings;
342 use Moose;
343
344 ::dies_ok {
d79e62fd 345 with 'Role::Plot';
d05cd563 346 } '... cannot compose it because we have no superclass';
347
348 package My::Test14;
349 use strict;
350 use warnings;
351 use Moose;
352
353 extends 'My::Test::Base';
354
355 ::throws_ok {
d79e62fd 356 with 'Role::Plot', 'Role::Truth';
d05cd563 357 } qr/Two \'override\' methods of the same name encountered/,
061a963b 358 '... cannot compose it because we have no superclass';
d05cd563 359}
360
361ok(My::Test11->meta->has_method('twist'), '... the twist method has been added');
362ok(My::Test12->meta->has_method('twist'), '... the twist method has been added');
363ok(!My::Test13->meta->has_method('twist'), '... the twist method has not been added');
364ok(!My::Test14->meta->has_method('twist'), '... the twist method has not been added');
365
d79e62fd 366ok(!My::Test11->does('Role::Plot'), '... our class does() the correct roles');
367ok(My::Test11->does('Role::Truth'), '... our class does() the correct roles');
368ok(!My::Test12->does('Role::Truth'), '... our class does() the correct roles');
369ok(My::Test12->does('Role::Plot'), '... our class does() the correct roles');
370ok(!My::Test13->does('Role::Plot'), '... our class does() the correct roles');
371ok(!My::Test14->does('Role::Truth'), '... our class does() the correct roles');
372ok(!My::Test14->does('Role::Plot'), '... our class does() the correct roles');
373
374is(My::Test11->twist(), 'My::Test::Base::twist -> Role::Truth::twist', '... got the right method return');
375is(My::Test12->twist(), 'My::Test::Base::twist -> Role::Plot::twist', '... got the right method return');
061a963b 376ok(!My::Test13->can('twist'), '... no twist method here at all');
377is(My::Test14->twist(), 'My::Test::Base::twist', '... got the right method return (from superclass)');
db1ab48d 378
d79e62fd 379{
380 package Role::Reality;
381 use strict;
382 use warnings;
383 use Moose::Role;
384
385 ::throws_ok {
386 with 'Role::Plot';
387 } qr/A local method of the same name as been found/,
388 '... could not compose roles here, it dies';
389
390 sub twist {
391 'Role::Reality::twist';
392 }
393}
394
395ok(Role::Reality->meta->has_method('twist'), '... the twist method has not been added');
396ok(!Role::Reality->meta->does_role('Role::Plot'), '... our role does() the correct roles');
397is(Role::Reality->meta->get_method('twist')->(),
398 'Role::Reality::twist',
399 '... the twist method returns the right value');