[gitmo/Moose.git] / t / roles / role_conflict_detection.t

#!/usr/bin/perl

use strict;
use warnings;

use Test::More;
use Test::Fatal;

=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;

    ::is( ::exception {
        with 'Role::Foo', 'Role::Bar';
    }, undef, '... our mutually recursive roles combine okay' );

    package My::Test2;
    use Moose;

    ::is( ::exception {
        with 'Role::Bar', 'Role::Foo';
    }, undef, '... 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;

    ::like( ::exception {
        with 'Role::Bling', 'Role::Bling::Bling';
    }, 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' );

    package My::Test4;
    use Moose;

    ::is( ::exception {
        with 'Role::Bling';
        with 'Role::Bling::Bling';
    }, undef, '... role methods didnt conflict when manually combined' );

    package My::Test5;
    use Moose;

    ::is( ::exception {
        with 'Role::Bling::Bling';
        with 'Role::Bling';
    }, undef, '... role methods didnt conflict when manually combined (in opposite order)' );

    package My::Test6;
    use Moose;

    ::is( ::exception {
        with 'Role::Bling::Bling', 'Role::Bling';
    }, undef, '... 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'), '... 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 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;

    ::like( ::exception {
        with 'Role::Boo', 'Role::Boo::Hoo';
    }, qr/We have encountered an attribute conflict.+ghost/ );

    package My::Test8;
    use Moose;

    ::is( ::exception {
        with 'Role::Boo';
        with 'Role::Boo::Hoo';
    }, undef, '... role attrs didnt conflict when manually combined' );

    package My::Test9;
    use Moose;

    ::is( ::exception {
        with 'Role::Boo::Hoo';
        with 'Role::Boo';
    }, undef, '... role attrs didnt conflict when manually combined' );

    package My::Test10;
    use Moose;

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

    ::like( ::exception {
        with 'Role::Boo', 'Role::Boo::Hoo';
    }, qr/We have encountered an attribute conflict/, '... role attrs conflict 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 Moose::Role;

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

    package Role::Truth;
    use Moose::Role;

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

{
    package My::Test::Base;
    use Moose;

    sub twist { 'My::Test::Base::twist' }

    package My::Test11;
    use Moose;

    extends 'My::Test::Base';

    ::is( ::exception {
        with 'Role::Truth';
    }, undef, '... composed the role with override okay' );

    package My::Test12;
    use Moose;

    extends 'My::Test::Base';

    ::is( ::exception {
       with 'Role::Plot';
    }, undef, '... composed the role with override okay' );

    package My::Test13;
    use Moose;

    ::isnt( ::exception {
        with 'Role::Plot';
    }, undef, '... cannot compose it because we have no superclass' );

    package My::Test14;
    use Moose;

    extends 'My::Test::Base';

    ::like( ::exception {
        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 Moose::Role;

    ::like( ::exception {
        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');

# Ovid's test case from rt.cpan.org #44
{
    package Role1;
    use Moose::Role;

    sub foo {}
}
{
    package Role2;
    use Moose::Role;

    sub foo {}
}
{
    package Conflicts;
    use Moose;

    ::like( ::exception {
        with qw(Role1 Role2);
    }, qr/Due to a method name conflict in roles 'Role1' and 'Role2', the method 'foo' must be implemented or excluded by 'Conflicts'/ );
}

=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 Moose::Role;

    sub ghost { 'Role::Method::ghost' }

    package Role::Method2;
    use Moose::Role;

    sub ghost { 'Role::Method2::ghost' }

    package Role::Attribute;
    use Moose::Role;

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

    package Role::Attribute2;
    use Moose::Role;

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

{
    package My::Test15;
    use Moose;

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

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

    package My::Test16;
    use Moose;

    ::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 Moose;

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

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

    package My::Test18;
    use Moose;

    ::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 Moose;

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

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

    package My::Test20;
    use Moose;

    ::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 Moose;

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

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

    package My::Test22;
    use Moose;

    ::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 Moose;

    ::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 Moose;

    ::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 Moose;

    ::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 Moose;

    ::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

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