From: gfx Date: Tue, 22 Sep 2009 05:16:34 +0000 (+0900) Subject: Implement confliction checks in roles X-Git-Tag: 0.32~8 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=60b5c3be4d0b3bb705df1e8d977f2ce90db6668d;p=gitmo%2FMouse.git Implement confliction checks in roles --- diff --git a/lib/Mouse/Meta/Role.pm b/lib/Mouse/Meta/Role.pm index 05faacf..33b8426 100644 --- a/lib/Mouse/Meta/Role.pm +++ b/lib/Mouse/Meta/Role.pm @@ -2,7 +2,7 @@ package Mouse::Meta::Role; use strict; use warnings; -use Mouse::Util qw(not_supported); +use Mouse::Util qw(not_supported english_list); use base qw(Mouse::Meta::Module); sub method_metaclass(){ 'Mouse::Meta::Role::Method' } # required for get_method() @@ -198,6 +198,85 @@ sub apply { sub combine_apply { my(undef, $class, @roles) = @_; + # check conflicting + my %method_provided; + my @method_conflicts; + my %attr_provided; + my %override_provided; + + foreach my $role_spec (@roles) { + my $role = $role_spec->[0]->meta; + my $role_name = $role->name; + + # methods + foreach my $method_name($role->get_method_list){ + next if $class->has_method($method_name); # manually resolved + + my $code = do{ no strict 'refs'; \&{ $role_name . '::' . $method_name } }; + + my $c = $method_provided{$method_name}; + + if($c && $c->[0] != $code){ + push @{$c}, $role; + push @method_conflicts, $c; + } + else{ + $method_provided{$method_name} = [$code, $method_name, $role]; + } + } + + # attributes + foreach my $attr_name($role->get_attribute_list){ + my $attr = $role->get_attribute($attr_name); + my $c = $attr_provided{$attr_name}; + if($c && $c != $attr){ + $class->throw_error("We have encountered an attribute conflict with '$attr_name' " + . "during composition. This is fatal error and cannot be disambiguated.") + } + else{ + $attr_provided{$attr_name} = $attr; + } + } + + # override modifiers + foreach my $method_name($role->get_method_modifier_list('override')){ + my $override = $role->get_override_method_modifier($method_name); + my $c = $override_provided{$method_name}; + if($c && $c != $override){ + $class->throw_error( "We have encountered an 'override' method conflict with '$method_name' during " + . "composition (Two 'override' methods of the same name encountered). " + . "This is fatal error.") + } + else{ + $override_provided{$method_name} = $override; + } + } + } + if(@method_conflicts){ + my $error; + + if(@method_conflicts == 1){ + my($code, $method_name, @roles) = @{$method_conflicts[0]}; + $class->throw_error( + sprintf q{Due to a method name conflict in roles %s, the method '%s' must be implemented or excluded by '%s'}, + english_list(map{ sprintf q{'%s'}, $_->name } @roles), $method_name, $class->name + ); + } + else{ + @method_conflicts = sort { $a->[0] cmp $b->[0] } @method_conflicts; # to avoid hash-ordering bugs + my $methods = english_list(map{ sprintf q{'%s'}, $_->[1] } @method_conflicts); + my $roles = english_list( + map{ sprintf q{'%s'}, $_->name } + map{ my($code, $method_name, @roles) = @{$_}; @roles } @method_conflicts + ); + + $class->throw_error( + sprintf q{Due to method name conflicts in roles %s, the methods %s must be implemented or excluded by '%s'}, + $roles, $methods, $class->name + ); + } + } + foreach my $role_spec (@roles) { my($role_name, $args) = @{$role_spec}; @@ -240,9 +319,13 @@ for my $modifier_type (qw/before after around/) { sub add_override_method_modifier{ my($self, $method_name, $method) = @_; - (!$self->has_method($method_name)) - || $self->throw_error("Cannot add an override of method '$method_name' " . - "because there is a local version of '$method_name'"); + if($self->has_method($method_name)){ + # This error happens in the override keyword or during role composition, + # so I added a message, "A local method of ...", only for compatibility (gfx) + $self->throw_error("Cannot add an override of method '$method_name' " + . "because there is a local version of '$method_name'" + . "(A local method of the same name as been found)"); + } $self->{override_method_modifiers}->{$method_name} = $method; } diff --git a/t/030_roles/005_role_conflict_detection.t b/t/030_roles/005_role_conflict_detection.t new file mode 100644 index 0000000..2faeffd --- /dev/null +++ b/t/030_roles/005_role_conflict_detection.t @@ -0,0 +1,575 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More tests => 88; +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 + +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/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 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' } +} + +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' } +} + +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 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 conflict 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 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 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'); + +# Ovid's test case from rt.cpan.org #44 +{ + package Role1; + use Mouse::Role; + + sub foo {} +} +{ + package Role2; + use Mouse::Role; + + sub foo {} +} +{ + package Conflicts; + use Mouse; + + ::throws_ok { + 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] when class defines method and role defines method, class wins +[15:24] when class 'has' method and role defines method, class wins +[15:24] when class defines method and role 'has' method, role wins +[15:24] when class 'has' method and role 'has' method, role wins +[15:24] which means when class 'has' method and two roles 'has' method, no tiebreak is detected +[15:24] this is with role and has declaration in the exact same order in every case? +[15:25] yes +[15:25] interesting +[15:25] that's what I thought +[15:26] does that sound like something I should write a test for? +[15:27] stevan, ping? +[15:27] I'm not sure what the right answer for composition is. +[15:27] who should win +[15:27] if I were to guess I'd say the class should always win. +[15:27] that would be my guess, but I thought I would ask to make sure +[15:29] kolibrie: please write a test +[15:29] I am not exactly sure who should win either,.. but I suspect it is not working correctly right now +[15:29] 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