[gitmo/Mouse.git] / t / 030_roles / failing / 005_role_conflict_detection.t

#!/usr/bin/perl

use strict;
use warnings;

use Test::More tests => 87; # it's really 124 with kolibrie's tests;
use Test::Exception;

=pod

Mutually recursive roles.

=cut

{
    package Role::Foo;
    use Mouse::Role;

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

{
    package My::Test1;
    use Mouse;
    
    ::lives_ok {
        with 'Role::Foo', 'Role::Bar';
    } '... our mutually recursive roles combine okay';
    
    package My::Test2;
    use Mouse;
    
    ::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

TODO: { todo_skip "Mouse: not yet implemented" => 4;
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 Mouse::Role;
    
    sub bling { 'Role::Bling::bling' }
    
    package Role::Bling::Bling;
    use Mouse::Role;
    
    sub bling { 'Role::Bling::Bling::bling' }    
}

{
    package My::Test3;
    use Mouse;
    
    ::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 Mouse;
    
    ::lives_ok {
        with 'Role::Bling';
        with 'Role::Bling::Bling';
    } '... role methods didnt conflict when manually combined';    
    
    package My::Test5;
    use Mouse;
    
    ::lives_ok {
        with 'Role::Bling::Bling';
        with 'Role::Bling';
    } '... role methods didnt conflict when manually combined (in opposite order)';    
    
    package My::Test6;
    use Mouse;
    
    ::lives_ok {
        with 'Role::Bling::Bling', 'Role::Bling';
    } '... role methods didnt conflict when manually resolved';    
    
    sub bling { 'My::Test6::bling' }
}

TODO: { todo_skip "Mouse: not yet implemented" => 4;
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 Mouse::Role;
    
    with 'Role::Bling::Bling';
    
    sub bling { 'Role::Bling::Bling::Bling::bling' }    
}

TODO: { todo_skip "Mouse: not yet implemented" => 1;
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');
TODO: { todo_skip "Mouse: not yet implemented" => 2;
ok(Role::Bling::Bling::Bling->meta->has_method('bling'), '... dont have 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 Mouse::Role;
    
    has 'ghost' => (is => 'ro', default => 'Role::Boo::ghost');
    
    package Role::Boo::Hoo;
    use Mouse::Role;
    
    has 'ghost' => (is => 'ro', default => 'Role::Boo::Hoo::ghost');
}

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

    package My::Test8;
    use Mouse;

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

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

    package My::Test10;
    use Mouse;
    
    has 'ghost' => (is => 'ro', default => 'My::Test10::ghost');    
    
    ::throws_ok {
        with 'Role::Boo', 'Role::Boo::Hoo';
    } qr/We have 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

{
    package Role::Plot;
    use Mouse::Role;
    
    override 'twist' => sub {
        super() . ' -> Role::Plot::twist';
    };
    
    package Role::Truth;
    use Mouse::Role;
    
    override 'twist' => sub {
        super() . ' -> Role::Truth::twist';
    };
}

{
    package My::Test::Base;
    use Mouse;
    
    sub twist { 'My::Test::Base::twist' }
        
    package My::Test11;
    use Mouse;
    
    extends 'My::Test::Base';

    ::lives_ok {
        with 'Role::Truth';
    } '... composed the role with override okay';
       
    package My::Test12;
    use Mouse;

    extends 'My::Test::Base';

    ::lives_ok {    
       with 'Role::Plot';
    } '... composed the role with override okay';
              
    package My::Test13;
    use Mouse;

    ::dies_ok {
        with 'Role::Plot';       
    } '... cannot compose it because we have no superclass';
    
    package My::Test14;
    use Mouse;

    extends 'My::Test::Base';

    ::throws_ok {
        with 'Role::Plot', 'Role::Truth';       
    } qr/Two \'override\' methods of the same name encountered/, 
      '... cannot compose it because we have no superclass';       
}

ok(My::Test11->meta->has_method('twist'), '... the twist method has been added');
ok(My::Test12->meta->has_method('twist'), '... the twist method has been added');
ok(!My::Test13->meta->has_method('twist'), '... the twist method has not been added');
ok(!My::Test14->meta->has_method('twist'), '... the twist method has not been added');

ok(!My::Test11->does('Role::Plot'), '... our class does() the correct roles');
ok(My::Test11->does('Role::Truth'), '... our class does() the correct roles');
ok(!My::Test12->does('Role::Truth'), '... our class does() the correct roles');
ok(My::Test12->does('Role::Plot'), '... our class does() the correct roles');
ok(!My::Test13->does('Role::Plot'), '... our class does() the correct roles');
ok(!My::Test14->does('Role::Truth'), '... our class does() the correct roles');
ok(!My::Test14->does('Role::Plot'), '... our class does() the correct roles');

is(My::Test11->twist(), 'My::Test::Base::twist -> Role::Truth::twist', '... got the right method return');
is(My::Test12->twist(), 'My::Test::Base::twist -> Role::Plot::twist', '... got the right method return');
ok(!My::Test13->can('twist'), '... no twist method here at all');
is(My::Test14->twist(), 'My::Test::Base::twist', '... got the right method return (from superclass)');

{
    package Role::Reality;
    use Mouse::Role;

    ::throws_ok {    
        with 'Role::Plot';
    } qr/A local method of the same name as been found/, 
    '... could not compose roles here, it dies';

    sub twist {
        'Role::Reality::twist';
    }
}    

ok(Role::Reality->meta->has_method('twist'), '... the twist method has not been added');
ok(!Role::Reality->meta->does_role('Role::Plot'), '... our role does() the correct roles');
is(Role::Reality->meta->get_method('twist')->(), 
    'Role::Reality::twist', 
    '... the twist method returns the right value');

=pod

Role conflicts between attributes and methods

[15:23]  <kolibrie> when class defines method and role defines method, class wins
[15:24]  <kolibrie> when class 'has'   method and role defines method, class wins
[15:24]  <kolibrie> when class defines method and role 'has'   method, role wins
[15:24]  <kolibrie> when class 'has'   method and role 'has'   method, role wins
[15:24]  <kolibrie> which means when class 'has' method and two roles 'has' method, no tiebreak is detected
[15:24]  <perigrin> this is with role and has declaration in the exact same order in every case?
[15:25]  <kolibrie> yes
[15:25]  <perigrin> interesting
[15:25]  <kolibrie> that's what I thought
[15:26]  <kolibrie> does that sound like something I should write a test for?
[15:27]  <perigrin> stevan, ping?
[15:27]  <perigrin> I'm not sure what the right answer for composition is.
[15:27]  <perigrin> who should win
[15:27]  <perigrin> if I were to guess I'd say the class should always win.
[15:27]  <kolibrie> that would be my guess, but I thought I would ask to make sure
[15:29]  <stevan> kolibrie: please write a test
[15:29]  <stevan> I am not exactly sure who should win either,.. but I suspect it is not working correctly right now
[15:29]  <stevan> I know exactly why it is doing what it is doing though

Now I have to decide actually what happens, and how to fix it.
- SL

{
    package Role::Method;
    use Mouse::Role;
    
    sub ghost { 'Role::Method::ghost' }

    package Role::Method2;
    use Mouse::Role;
    
    sub ghost { 'Role::Method2::ghost' }

    package Role::Attribute;
    use Mouse::Role;
    
    has 'ghost' => (is => 'ro', default => 'Role::Attribute::ghost');

    package Role::Attribute2;
    use Mouse::Role;
    
    has 'ghost' => (is => 'ro', default => 'Role::Attribute2::ghost');
}

{
    package My::Test15;
    use Mouse;

    ::lives_ok {    
       with 'Role::Method';
    } '... composed the method role into the method class';

    sub ghost { 'My::Test15::ghost' }

    package My::Test16;
    use Mouse;

    ::lives_ok {
       with 'Role::Method';
    } '... composed the method role into the attribute class';

    has 'ghost' => (is => 'ro', default => 'My::Test16::ghost');

    package My::Test17;
    use Mouse;

    ::lives_ok {
       with 'Role::Attribute';
    } '... composed the attribute role into the method class';

    sub ghost { 'My::Test17::ghost' }

    package My::Test18;
    use Mouse;

    ::lives_ok {
       with 'Role::Attribute';
    } '... composed the attribute role into the attribute class';

    has 'ghost' => (is => 'ro', default => 'My::Test18::ghost');

    package My::Test19;
    use Mouse;

    ::lives_ok {
       with 'Role::Method', 'Role::Method2';
    } '... composed method roles into class with method tiebreaker';

    sub ghost { 'My::Test19::ghost' }

    package My::Test20;
    use Mouse;

    ::lives_ok {
       with 'Role::Method', 'Role::Method2';
    } '... composed method roles into class with attribute tiebreaker';

    has 'ghost' => (is => 'ro', default => 'My::Test20::ghost');

    package My::Test21;
    use Mouse;

    ::lives_ok {
       with 'Role::Attribute', 'Role::Attribute2';
    } '... composed attribute roles into class with method tiebreaker';

    sub ghost { 'My::Test21::ghost' }

    package My::Test22;
    use Mouse;

    ::lives_ok {
       with 'Role::Attribute', 'Role::Attribute2';
    } '... composed attribute roles into class with attribute tiebreaker';

    has 'ghost' => (is => 'ro', default => 'My::Test22::ghost');

    package My::Test23;
    use Mouse;

    ::lives_ok {
        with 'Role::Method', 'Role::Attribute';
    } '... composed method and attribute role into class with method tiebreaker';

    sub ghost { 'My::Test23::ghost' }

    package My::Test24;
    use Mouse;

    ::lives_ok {
        with 'Role::Method', 'Role::Attribute';
    } '... composed method and attribute role into class with attribute tiebreaker';

    has 'ghost' => (is => 'ro', default => 'My::Test24::ghost');

    package My::Test25;
    use Mouse;

    ::lives_ok {
        with 'Role::Attribute', 'Role::Method';
    } '... composed attribute and method role into class with method tiebreaker';

    sub ghost { 'My::Test25::ghost' }

    package My::Test26;
    use Mouse;

    ::lives_ok {
        with 'Role::Attribute', 'Role::Method';
    } '... composed attribute and method role into class with attribute tiebreaker';

    has 'ghost' => (is => 'ro', default => 'My::Test26::ghost');
}

my $test15 = My::Test15->new;
isa_ok($test15, 'My::Test15');
is($test15->ghost, 'My::Test15::ghost', '... we access the method from the class and ignore the role method');

my $test16 = My::Test16->new;
isa_ok($test16, 'My::Test16');
is($test16->ghost, 'My::Test16::ghost', '... we access the attribute from the class and ignore the role method');

my $test17 = My::Test17->new;
isa_ok($test17, 'My::Test17');
is($test17->ghost, 'My::Test17::ghost', '... we access the method from the class and ignore the role attribute');

my $test18 = My::Test18->new;
isa_ok($test18, 'My::Test18');
is($test18->ghost, 'My::Test18::ghost', '... we access the attribute from the class and ignore the role attribute');

my $test19 = My::Test19->new;
isa_ok($test19, 'My::Test19');
is($test19->ghost, 'My::Test19::ghost', '... we access the method from the class and ignore the role methods');

my $test20 = My::Test20->new;
isa_ok($test20, 'My::Test20');
is($test20->ghost, 'My::Test20::ghost', '... we access the attribute from the class and ignore the role methods');

my $test21 = My::Test21->new;
isa_ok($test21, 'My::Test21');
is($test21->ghost, 'My::Test21::ghost', '... we access the method from the class and ignore the role attributes');

my $test22 = My::Test22->new;
isa_ok($test22, 'My::Test22');
is($test22->ghost, 'My::Test22::ghost', '... we access the attribute from the class and ignore the role attributes');

my $test23 = My::Test23->new;
isa_ok($test23, 'My::Test23');
is($test23->ghost, 'My::Test23::ghost', '... we access the method from the class and ignore the role method and attribute');

my $test24 = My::Test24->new;
isa_ok($test24, 'My::Test24');
is($test24->ghost, 'My::Test24::ghost', '... we access the attribute from the class and ignore the role method and attribute');

my $test25 = My::Test25->new;
isa_ok($test25, 'My::Test25');
is($test25->ghost, 'My::Test25::ghost', '... we access the method from the class and ignore the role attribute and method');

my $test26 = My::Test26->new;
isa_ok($test26, 'My::Test26');
is($test26->ghost, 'My::Test26::ghost', '... we access the attribute from the class and ignore the role attribute and method');

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