From: Stevan Little Date: Thu, 11 May 2006 17:48:40 +0000 (+0000) Subject: more-roles X-Git-Tag: 0_09_03~26 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d30bc0415558cb3d3c418a11691b555d554b863d;p=gitmo%2FMoose.git more-roles --- diff --git a/lib/Moose/Meta/Role.pm b/lib/Moose/Meta/Role.pm index e5724bc..3b938cd 100644 --- a/lib/Moose/Meta/Role.pm +++ b/lib/Moose/Meta/Role.pm @@ -7,6 +7,7 @@ use metaclass; use Carp 'confess'; use Scalar::Util 'blessed'; +use B 'svref_2object'; use Moose::Meta::Class; @@ -222,7 +223,15 @@ sub _add_method_modifier { my $accessor = "get_${modifier_type}_method_modifiers_map"; $self->$accessor->{$method_name} = [] unless exists $self->$accessor->{$method_name}; - push @{$self->$accessor->{$method_name}} => $method; + my $modifiers = $self->$accessor->{$method_name}; + # NOTE: + # check to see that we aren't adding the + # same code twice. We err in favor of the + # first on here, this may not be as expected + foreach my $modifier (@{$modifiers}) { + return if $modifier == $method; + } + push @{$modifiers} => $method; } sub add_override_method_modifier { @@ -370,7 +379,9 @@ sub apply { foreach my $method_name ($self->get_method_list) { # it if it has one already - if ($other->has_method($method_name)) { + if ($other->has_method($method_name) && + # and if they are not the same thing ... + $other->get_method($method_name) != $self->get_method($method_name)) { # see if we are composing into a role if ($other->isa('Moose::Meta::Role')) { # method conflicts between roles result @@ -425,26 +436,30 @@ sub apply { # if we are a role, we need to make sure # we dont have a conflict with the role # we are composing into - if ($other->has_override_method_modifier($method_name)) { + if ($other->has_override_method_modifier($method_name) && + $other->get_override_method_modifier($method_name) != $self->get_override_method_modifier($method_name)) { confess "Role '" . $self->name . "' has encountered an 'override' method conflict " . "during composition (Two 'override' methods of the same name encountered). " . "This is fatal error."; } - else { + else { + # if there is no conflict, + # just add it to the role $other->add_override_method_modifier( - $method_name, - $self->get_override_method_modifier($method_name), - $self->name + $method_name, + $self->get_override_method_modifier($method_name) ); } } else { + # if this is not a role, then we need to + # find the original package of the method + # so that we can tell the class were to + # find the right super() method + my $method = $self->get_override_method_modifier($method_name); + my $package = svref_2object($method)->GV->STASH->NAME; # if it is a class, we just add it - $other->add_override_method_modifier( - $method_name, - $self->get_override_method_modifier($method_name), - $self->name - ); + $other->add_override_method_modifier($method_name, $method, $package); } } } diff --git a/t/047_role_conflict_edge_cases.t b/t/047_role_conflict_edge_cases.t new file mode 100644 index 0000000..e1b62ab --- /dev/null +++ b/t/047_role_conflict_edge_cases.t @@ -0,0 +1,182 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More tests => 28; +use Test::Exception; + +BEGIN { + use_ok('Moose'); + use_ok('Moose::Role'); +} + +=pod + +Check for repeated inheritence causing +a method conflict (which is not really +a conflict) + +=cut + +{ + package Role::Base; + use strict; + use warnings; + use Moose::Role; + + sub foo { 'Role::Base::foo' } + + package Role::Derived1; + use strict; + use warnings; + use Moose::Role; + + with 'Role::Base'; + + package Role::Derived2; + use strict; + use warnings; + use Moose::Role; + + with 'Role::Base'; + + package My::Test::Class1; + use strict; + use warnings; + use Moose; + + ::lives_ok { + with 'Role::Derived1', 'Role::Derived2'; + } '... roles composed okay (no conflicts)'; +} + +ok(Role::Base->meta->has_method('foo'), '... have the method foo as expected'); +ok(Role::Derived1->meta->has_method('foo'), '... have the method foo as expected'); +ok(Role::Derived2->meta->has_method('foo'), '... have the method foo as expected'); +ok(My::Test::Class1->meta->has_method('foo'), '... have the method foo as expected'); + +is(My::Test::Class1->foo, 'Role::Base::foo', '... got the right value from method'); + +=pod + +Check for repeated inheritence causing +a method conflict with method modifiers +(which is not really a conflict) + +=cut + +{ + package Role::Base2; + use strict; + use warnings; + use Moose::Role; + + override 'foo' => sub { super() . ' -> Role::Base::foo' }; + + package Role::Derived3; + use strict; + use warnings; + use Moose::Role; + + with 'Role::Base2'; + + package Role::Derived4; + use strict; + use warnings; + use Moose::Role; + + with 'Role::Base2'; + + package My::Test::Class2::Base; + use strict; + use warnings; + use Moose; + + sub foo { 'My::Test::Class2::Base' } + + package My::Test::Class2; + use strict; + use warnings; + use Moose; + + extends 'My::Test::Class2::Base'; + + ::lives_ok { + with 'Role::Derived3', 'Role::Derived4'; + } '... roles composed okay (no conflicts)'; +} + +ok(Role::Base2->meta->has_override_method_modifier('foo'), '... have the method foo as expected'); +ok(Role::Derived3->meta->has_override_method_modifier('foo'), '... have the method foo as expected'); +ok(Role::Derived4->meta->has_override_method_modifier('foo'), '... have the method foo as expected'); +ok(My::Test::Class2->meta->has_method('foo'), '... have the method foo as expected'); +isa_ok(My::Test::Class2->meta->get_method('foo'), 'Moose::Meta::Method::Overriden'); +ok(My::Test::Class2::Base->meta->has_method('foo'), '... have the method foo as expected'); +isa_ok(My::Test::Class2::Base->meta->get_method('foo'), 'Class::MOP::Method'); + +is(My::Test::Class2::Base->foo, 'My::Test::Class2::Base', '... got the right value from method'); +is(My::Test::Class2->foo, 'My::Test::Class2::Base -> Role::Base::foo', '... got the right value from method'); + +=pod + +Check for repeated inheritence of the +same code. There are no conflicts with +before/around/after method modifiers. + +This tests around, but should work the +same for before/afters as well + +=cut + +{ + package Role::Base3; + use strict; + use warnings; + use Moose::Role; + + around 'foo' => sub { 'Role::Base::foo(' . (shift)->() . ')' }; + + package Role::Derived5; + use strict; + use warnings; + use Moose::Role; + + with 'Role::Base3'; + + package Role::Derived6; + use strict; + use warnings; + use Moose::Role; + + with 'Role::Base3'; + + package My::Test::Class3::Base; + use strict; + use warnings; + use Moose; + + sub foo { 'My::Test::Class3::Base' } + + package My::Test::Class3; + use strict; + use warnings; + use Moose; + + extends 'My::Test::Class3::Base'; + + ::lives_ok { + with 'Role::Derived5', 'Role::Derived6'; + } '... roles composed okay (no conflicts)'; +} + +ok(Role::Base3->meta->has_around_method_modifiers('foo'), '... have the method foo as expected'); +ok(Role::Derived5->meta->has_around_method_modifiers('foo'), '... have the method foo as expected'); +ok(Role::Derived6->meta->has_around_method_modifiers('foo'), '... have the method foo as expected'); +ok(My::Test::Class3->meta->has_method('foo'), '... have the method foo as expected'); +isa_ok(My::Test::Class3->meta->get_method('foo'), 'Class::MOP::Method::Wrapped'); +ok(My::Test::Class3::Base->meta->has_method('foo'), '... have the method foo as expected'); +isa_ok(My::Test::Class3::Base->meta->get_method('foo'), 'Class::MOP::Method'); + +is(My::Test::Class3::Base->foo, 'My::Test::Class3::Base', '... got the right value from method'); +is(My::Test::Class3->foo, 'Role::Base::foo(My::Test::Class3::Base)', '... got the right value from method');