[gitmo/Moose.git] / t / 044_role_conflict_detection.t

#!/usr/bin/perl

use strict;
use warnings;

use Test::More tests => 67;
use Test::Exception;

BEGIN {
    use_ok('Moose');
    use_ok('Moose::Role');    
}

=pod

Mutually recursive roles.

=cut

{
    package Role::Foo;
    use Moose::Role;

    requires 'foo';
    
    sub bar { 'Role::Foo::bar' }
    
    package Role::Bar;
    use Moose::Role;
    
    requires 'bar';
    
    sub foo { 'Role::Bar::foo' }    
}

{
    package My::Test1;
    use Moose;
    
    ::lives_ok {
        with 'Role::Foo', 'Role::Bar';
    } '... our mutually recursive roles combine okay';
    
    package My::Test2;
    use Moose;
    
    ::lives_ok {
        with 'Role::Bar', 'Role::Foo';
    } '... our mutually recursive roles combine okay (no matter what order)';    
}

my $test1 = My::Test1->new;
isa_ok($test1, 'My::Test1');

ok($test1->does('Role::Foo'), '... $test1 does Role::Foo');
ok($test1->does('Role::Bar'), '... $test1 does Role::Bar');

can_ok($test1, 'foo');
can_ok($test1, 'bar');

is($test1->foo, 'Role::Bar::foo', '... $test1->foo worked');
is($test1->bar, 'Role::Foo::bar', '... $test1->bar worked');

my $test2 = My::Test2->new;
isa_ok($test2, 'My::Test2');

ok($test2->does('Role::Foo'), '... $test2 does Role::Foo');
ok($test2->does('Role::Bar'), '... $test2 does Role::Bar');

can_ok($test2, 'foo');
can_ok($test2, 'bar');

is($test2->foo, 'Role::Bar::foo', '... $test2->foo worked');
is($test2->bar, 'Role::Foo::bar', '... $test2->bar worked');

# check some meta-stuff

ok(Role::Foo->meta->has_method('bar'), '... it still has the bar method');
ok(Role::Foo->meta->requires_method('foo'), '... it still has the required foo method');

ok(Role::Bar->meta->has_method('foo'), '... it still has the foo method');
ok(Role::Bar->meta->requires_method('bar'), '... it still has the required bar method');

=pod

Role method conflicts

=cut

{
    package Role::Bling;
    use Moose::Role;
    
    sub bling { 'Role::Bling::bling' }
    
    package Role::Bling::Bling;
    use Moose::Role;
    
    sub bling { 'Role::Bling::Bling::bling' }    
}

{
    package My::Test3;
    use Moose;
    
    ::throws_ok {
        with 'Role::Bling', 'Role::Bling::Bling';
    } qr/requires the method \'bling\' to be implemented/, '... role methods conflicted and method was required';
    
    package My::Test4;
    use Moose;
    
    ::lives_ok {
        with 'Role::Bling';
        with 'Role::Bling::Bling';
    } '... role methods didnt conflict when manually combined';    
    
    package My::Test5;
    use Moose;
    
    ::lives_ok {
        with 'Role::Bling::Bling';
        with 'Role::Bling';
    } '... role methods didnt conflict when manually combined (in opposite order)';    
    
    package My::Test6;
    use Moose;
    
    ::lives_ok {
        with 'Role::Bling::Bling', 'Role::Bling';
    } '... role methods didnt conflict when manually resolved';    
    
    sub bling { 'My::Test6::bling' }
}

ok(!My::Test3->meta->has_method('bling'), '... we didnt get any methods in the conflict');
ok(My::Test4->meta->has_method('bling'), '... we did get the method when manually dealt with');
ok(My::Test5->meta->has_method('bling'), '... we did get the method when manually dealt with');
ok(My::Test6->meta->has_method('bling'), '... we did get the method when manually dealt with');

ok(!My::Test3->does('Role::Bling'), '... our class does() the correct roles');
ok(!My::Test3->does('Role::Bling::Bling'), '... our class does() the correct roles');
ok(My::Test4->does('Role::Bling'), '... our class does() the correct roles');
ok(My::Test4->does('Role::Bling::Bling'), '... our class does() the correct roles');
ok(My::Test5->does('Role::Bling'), '... our class does() the correct roles');
ok(My::Test5->does('Role::Bling::Bling'), '... our class does() the correct roles');
ok(My::Test6->does('Role::Bling'), '... our class does() the correct roles');
ok(My::Test6->does('Role::Bling::Bling'), '... our class does() the correct roles');

is(My::Test4->bling, 'Role::Bling::bling', '... and we got the first method that was added');
is(My::Test5->bling, 'Role::Bling::Bling::bling', '... and we got the first method that was added');
is(My::Test6->bling, 'My::Test6::bling', '... and we got the local method');

# check how this affects role compostion

{
    package Role::Bling::Bling::Bling;
    use Moose::Role;
    
    with 'Role::Bling::Bling';
    
    sub bling { 'Role::Bling::Bling::Bling::bling' }    
}

ok(Role::Bling::Bling->meta->has_method('bling'), '... still got the bling method in Role::Bling::Bling');
ok(Role::Bling::Bling->meta->does_role('Role::Bling::Bling'), '... our role correctly does() the other role');
ok(Role::Bling::Bling::Bling->meta->has_method('bling'), '... still got the bling method in Role::Bling::Bling::Bling');
is(Role::Bling::Bling::Bling->meta->get_method('bling')->(), 
    'Role::Bling::Bling::Bling::bling',
    '... still got the bling method in Role::Bling::Bling::Bling');

=pod

Role attribute conflicts

=cut

{
    package Role::Boo;
    use Moose::Role;
    
    has 'ghost' => (is => 'ro', default => 'Role::Boo::ghost');
    
    package Role::Boo::Hoo;
    use Moose::Role;
    
    has 'ghost' => (is => 'ro', default => 'Role::Boo::Hoo::ghost');
}

{
    package My::Test7;
    use Moose;
    
    ::throws_ok {
        with 'Role::Boo', 'Role::Boo::Hoo';
    } qr/Role \'Role::Boo::Hoo\' has encountered an attribute conflict/, 
      '... role attrs conflicted and method was required';

    package My::Test8;
    use Moose;

    ::lives_ok {
        with 'Role::Boo';
        with 'Role::Boo::Hoo';
    } '... role attrs didnt conflict when manually combined';
    
    package My::Test9;
    use Moose;

    ::lives_ok {
        with 'Role::Boo::Hoo';
        with 'Role::Boo';
    } '... role attrs didnt conflict when manually combined';    

    package My::Test10;
    use Moose;
    
    has 'ghost' => (is => 'ro', default => 'My::Test10::ghost');    
    
    ::throws_ok {
        with 'Role::Boo', 'Role::Boo::Hoo';
    } qr/Role \'Role::Boo::Hoo\' has encountered an attribute conflict/, 
      '... role attrs conflicted and cannot be manually disambiguted';  

}

ok(!My::Test7->meta->has_attribute('ghost'), '... we didnt get any attributes in the conflict');
ok(My::Test8->meta->has_attribute('ghost'), '... we did get an attributes when manually composed');
ok(My::Test9->meta->has_attribute('ghost'), '... we did get an attributes when manually composed');
ok(My::Test10->meta->has_attribute('ghost'), '... we did still have an attribute ghost (conflict does not mess with class)');

ok(!My::Test7->does('Role::Boo'), '... our class does() the correct roles');
ok(!My::Test7->does('Role::Boo::Hoo'), '... our class does() the correct roles');
ok(My::Test8->does('Role::Boo'), '... our class does() the correct roles');
ok(My::Test8->does('Role::Boo::Hoo'), '... our class does() the correct roles');
ok(My::Test9->does('Role::Boo'), '... our class does() the correct roles');
ok(My::Test9->does('Role::Boo::Hoo'), '... our class does() the correct roles');
ok(!My::Test10->does('Role::Boo'), '... our class does() the correct roles');
ok(!My::Test10->does('Role::Boo::Hoo'), '... our class does() the correct roles');

can_ok('My::Test8', 'ghost');
can_ok('My::Test9', 'ghost');
can_ok('My::Test10', 'ghost');

is(My::Test8->new->ghost, 'Role::Boo::ghost', '... got the expected default attr value');
is(My::Test9->new->ghost, 'Role::Boo::Hoo::ghost', '... got the expected default attr value');
is(My::Test10->new->ghost, 'My::Test10::ghost', '... got the expected default attr value');

=pod

Role override method conflicts

=cut
Commit	Line	Data
db1ab48d	1	#!/usr/bin/perl
	2
	3	use strict;
	4	use warnings;
	5
8256469a	6	use Test::More tests => 67;
db1ab48d	7	use Test::Exception;
	8
	9	BEGIN {
	10	use_ok('Moose');
	11	use_ok('Moose::Role');
	12	}
	13
	14	=pod
	15
	16	Mutually recursive roles.
	17
	18	=cut
	19
	20	{
	21	package Role::Foo;
db1ab48d	22	use Moose::Role;
	23
	24	requires 'foo';
	25
	26	sub bar { 'Role::Foo::bar' }
	27
	28	package Role::Bar;
db1ab48d	29	use Moose::Role;
	30
	31	requires 'bar';
	32
	33	sub foo { 'Role::Bar::foo' }
	34	}
	35
	36	{
	37	package My::Test1;
db1ab48d	38	use Moose;
	39
	40	::lives_ok {
	41	with 'Role::Foo', 'Role::Bar';
	42	} '... our mutually recursive roles combine okay';
	43
	44	package My::Test2;
db1ab48d	45	use Moose;
	46
	47	::lives_ok {
	48	with 'Role::Bar', 'Role::Foo';
	49	} '... our mutually recursive roles combine okay (no matter what order)';
	50	}
	51
	52	my $test1 = My::Test1->new;
	53	isa_ok($test1, 'My::Test1');
	54
	55	ok($test1->does('Role::Foo'), '... $test1 does Role::Foo');
	56	ok($test1->does('Role::Bar'), '... $test1 does Role::Bar');
	57
	58	can_ok($test1, 'foo');
	59	can_ok($test1, 'bar');
	60
	61	is($test1->foo, 'Role::Bar::foo', '... $test1->foo worked');
	62	is($test1->bar, 'Role::Foo::bar', '... $test1->bar worked');
	63
	64	my $test2 = My::Test2->new;
	65	isa_ok($test2, 'My::Test2');
	66
	67	ok($test2->does('Role::Foo'), '... $test2 does Role::Foo');
	68	ok($test2->does('Role::Bar'), '... $test2 does Role::Bar');
	69
	70	can_ok($test2, 'foo');
	71	can_ok($test2, 'bar');
	72
	73	is($test2->foo, 'Role::Bar::foo', '... $test2->foo worked');
	74	is($test2->bar, 'Role::Foo::bar', '... $test2->bar worked');
	75
	76	# check some meta-stuff
	77
	78	ok(Role::Foo->meta->has_method('bar'), '... it still has the bar method');
	79	ok(Role::Foo->meta->requires_method('foo'), '... it still has the required foo method');
	80
	81	ok(Role::Bar->meta->has_method('foo'), '... it still has the foo method');
	82	ok(Role::Bar->meta->requires_method('bar'), '... it still has the required bar method');
	83
	84	=pod
	85
	86	Role method conflicts
	87
	88	=cut
	89
	90	{
	91	package Role::Bling;
db1ab48d	92	use Moose::Role;
	93
	94	sub bling { 'Role::Bling::bling' }
	95
	96	package Role::Bling::Bling;
db1ab48d	97	use Moose::Role;
	98
	99	sub bling { 'Role::Bling::Bling::bling' }
	100	}
	101
	102	{
	103	package My::Test3;
db1ab48d	104	use Moose;
	105
	106	::throws_ok {
	107	with 'Role::Bling', 'Role::Bling::Bling';
	108	} qr/requires the method \'bling\' to be implemented/, '... role methods conflicted and method was required';
	109
	110	package My::Test4;
db1ab48d	111	use Moose;
	112
	113	::lives_ok {
	114	with 'Role::Bling';
	115	with 'Role::Bling::Bling';
	116	} '... role methods didnt conflict when manually combined';
	117
	118	package My::Test5;
db1ab48d	119	use Moose;
	120
	121	::lives_ok {
	122	with 'Role::Bling::Bling';
	123	with 'Role::Bling';
	124	} '... role methods didnt conflict when manually combined (in opposite order)';
	125
	126	package My::Test6;
db1ab48d	127	use Moose;
	128
	129	::lives_ok {
	130	with 'Role::Bling::Bling', 'Role::Bling';
	131	} '... role methods didnt conflict when manually resolved';
	132
	133	sub bling { 'My::Test6::bling' }
	134	}
	135
	136	ok(!My::Test3->meta->has_method('bling'), '... we didnt get any methods in the conflict');
	137	ok(My::Test4->meta->has_method('bling'), '... we did get the method when manually dealt with');
	138	ok(My::Test5->meta->has_method('bling'), '... we did get the method when manually dealt with');
	139	ok(My::Test6->meta->has_method('bling'), '... we did get the method when manually dealt with');
	140
d79e62fd	141	ok(!My::Test3->does('Role::Bling'), '... our class does() the correct roles');
	142	ok(!My::Test3->does('Role::Bling::Bling'), '... our class does() the correct roles');
	143	ok(My::Test4->does('Role::Bling'), '... our class does() the correct roles');
	144	ok(My::Test4->does('Role::Bling::Bling'), '... our class does() the correct roles');
	145	ok(My::Test5->does('Role::Bling'), '... our class does() the correct roles');
	146	ok(My::Test5->does('Role::Bling::Bling'), '... our class does() the correct roles');
	147	ok(My::Test6->does('Role::Bling'), '... our class does() the correct roles');
	148	ok(My::Test6->does('Role::Bling::Bling'), '... our class does() the correct roles');
	149
db1ab48d	150	is(My::Test4->bling, 'Role::Bling::bling', '... and we got the first method that was added');
	151	is(My::Test5->bling, 'Role::Bling::Bling::bling', '... and we got the first method that was added');
	152	is(My::Test6->bling, 'My::Test6::bling', '... and we got the local method');
	153
	154	# check how this affects role compostion
	155
	156	{
	157	package Role::Bling::Bling::Bling;
db1ab48d	158	use Moose::Role;
	159
	160	with 'Role::Bling::Bling';
	161
	162	sub bling { 'Role::Bling::Bling::Bling::bling' }
	163	}
	164
	165	ok(Role::Bling::Bling->meta->has_method('bling'), '... still got the bling method in Role::Bling::Bling');
d79e62fd	166	ok(Role::Bling::Bling->meta->does_role('Role::Bling::Bling'), '... our role correctly does() the other role');
db1ab48d	167	ok(Role::Bling::Bling::Bling->meta->has_method('bling'), '... still got the bling method in Role::Bling::Bling::Bling');
d05cd563	168	is(Role::Bling::Bling::Bling->meta->get_method('bling')->(),
	169	'Role::Bling::Bling::Bling::bling',
	170	'... still got the bling method in Role::Bling::Bling::Bling');
db1ab48d	171
	172	=pod
	173
	174	Role attribute conflicts
	175
	176	=cut
	177
	178	{
	179	package Role::Boo;
db1ab48d	180	use Moose::Role;
	181
	182	has 'ghost' => (is => 'ro', default => 'Role::Boo::ghost');
	183
	184	package Role::Boo::Hoo;
db1ab48d	185	use Moose::Role;
	186
	187	has 'ghost' => (is => 'ro', default => 'Role::Boo::Hoo::ghost');
	188	}
	189
	190	{
	191	package My::Test7;
db1ab48d	192	use Moose;
	193
	194	::throws_ok {
	195	with 'Role::Boo', 'Role::Boo::Hoo';
	196	} qr/Role \'Role::Boo::Hoo\' has encountered an attribute conflict/,
	197	'... role attrs conflicted and method was required';
	198
	199	package My::Test8;
db1ab48d	200	use Moose;
	201
	202	::lives_ok {
	203	with 'Role::Boo';
	204	with 'Role::Boo::Hoo';
	205	} '... role attrs didnt conflict when manually combined';
	206
	207	package My::Test9;
db1ab48d	208	use Moose;
	209
	210	::lives_ok {
	211	with 'Role::Boo::Hoo';
	212	with 'Role::Boo';
	213	} '... role attrs didnt conflict when manually combined';
	214
	215	package My::Test10;
db1ab48d	216	use Moose;
	217
	218	has 'ghost' => (is => 'ro', default => 'My::Test10::ghost');
	219
	220	::throws_ok {
	221	with 'Role::Boo', 'Role::Boo::Hoo';
	222	} qr/Role \'Role::Boo::Hoo\' has encountered an attribute conflict/,
	223	'... role attrs conflicted and cannot be manually disambiguted';
	224
	225	}
	226
	227	ok(!My::Test7->meta->has_attribute('ghost'), '... we didnt get any attributes in the conflict');
	228	ok(My::Test8->meta->has_attribute('ghost'), '... we did get an attributes when manually composed');
	229	ok(My::Test9->meta->has_attribute('ghost'), '... we did get an attributes when manually composed');
	230	ok(My::Test10->meta->has_attribute('ghost'), '... we did still have an attribute ghost (conflict does not mess with class)');
	231
d79e62fd	232	ok(!My::Test7->does('Role::Boo'), '... our class does() the correct roles');
	233	ok(!My::Test7->does('Role::Boo::Hoo'), '... our class does() the correct roles');
	234	ok(My::Test8->does('Role::Boo'), '... our class does() the correct roles');
	235	ok(My::Test8->does('Role::Boo::Hoo'), '... our class does() the correct roles');
	236	ok(My::Test9->does('Role::Boo'), '... our class does() the correct roles');
	237	ok(My::Test9->does('Role::Boo::Hoo'), '... our class does() the correct roles');
	238	ok(!My::Test10->does('Role::Boo'), '... our class does() the correct roles');
	239	ok(!My::Test10->does('Role::Boo::Hoo'), '... our class does() the correct roles');
	240
db1ab48d	241	can_ok('My::Test8', 'ghost');
	242	can_ok('My::Test9', 'ghost');
	243	can_ok('My::Test10', 'ghost');
	244
	245	is(My::Test8->new->ghost, 'Role::Boo::ghost', '... got the expected default attr value');
	246	is(My::Test9->new->ghost, 'Role::Boo::Hoo::ghost', '... got the expected default attr value');
	247	is(My::Test10->new->ghost, 'My::Test10::ghost', '... got the expected default attr value');
	248
d05cd563	249	=pod
	250
	251	Role override method conflicts
	252
	253	=cut
	254