From: Stevan Little Date: Thu, 11 May 2006 14:32:48 +0000 (+0000) Subject: more-tests X-Git-Tag: 0_09_03~27 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=38f1204cd9273901426fa6aaf5050830cbf4085c;p=gitmo%2FMoose.git more-tests --- diff --git a/lib/Moose/Meta/Role.pm b/lib/Moose/Meta/Role.pm index 61c8f29..e5724bc 100644 --- a/lib/Moose/Meta/Role.pm +++ b/lib/Moose/Meta/Role.pm @@ -131,6 +131,11 @@ sub add_required_methods { $self->get_required_methods_map->{$_} = undef foreach @methods; } +sub remove_required_methods { + my ($self, @methods) = @_; + delete $self->get_required_methods_map->{$_} foreach @methods; +} + sub get_required_method_list { my ($self) = @_; keys %{$self->get_required_methods_map}; @@ -144,7 +149,7 @@ sub requires_method { sub _clean_up_required_methods { my $self = shift; foreach my $method ($self->get_required_method_list) { - delete $self->get_required_methods_map->{$method} + $self->remove_required_methods($method) if $self->has_method($method); } } @@ -306,6 +311,27 @@ sub apply { "to be implemented by '" . $other->name . "'"; } } + else { + # NOTE: + # we need to make sure that the method is + # not a method modifier, because those do + # not satisfy the requirements ... + my $method = $other->get_method($required_method_name); + # check if it is an override or a generated accessor .. + (!$method->isa('Moose::Meta::Method::Overriden') && + !$method->isa('Class::MOP::Attribute::Accessor')) + || confess "'" . $self->name . "' requires the method '$required_method_name' " . + "to be implemented by '" . $other->name . "', the method is only a method modifier"; + # before/after/around methods are a little trickier + # since we wrap the original local method (if applicable) + # so we need to check if the original wrapped method is + # from the same package, and not a wrap of the super method + if ($method->isa('Class::MOP::Method::Wrapped')) { + ($method->get_original_method->package_name eq $other->name) + || confess "'" . $self->name . "' requires the method '$required_method_name' " . + "to be implemented by '" . $other->name . "', the method is only a method modifier"; + } + } } foreach my $attribute_name ($self->get_attribute_list) { @@ -567,6 +593,8 @@ probably not that much really). =item B +=item B + =item B =item B diff --git a/t/041_role.t b/t/041_role.t index eaefa07..da598a2 100644 --- a/t/041_role.t +++ b/t/041_role.t @@ -10,6 +10,16 @@ BEGIN { use_ok('Moose::Role'); } +=pod + +NOTE: + +Should we be testing here that the has & override +are injecting their methods correctly? In other +words, should 'has_method' return true for them? + +=cut + { package FooRole; diff --git a/t/044_basic_role_composition.t b/t/044_role_conflict_detection.t similarity index 100% rename from t/044_basic_role_composition.t rename to t/044_role_conflict_detection.t diff --git a/t/046_roles_and_required_method_edge_cases.t b/t/046_roles_and_required_method_edge_cases.t new file mode 100644 index 0000000..77ef07a --- /dev/null +++ b/t/046_roles_and_required_method_edge_cases.t @@ -0,0 +1,212 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More tests => 17; +use Test::Exception; + +BEGIN { + use_ok('Moose'); + use_ok('Moose::Role'); +} + +=pod + +Role which requires a method implemented +in another role as an override (it does +not remove the requirement) + +=cut + +{ + package Role::RequireFoo; + use strict; + use warnings; + use Moose::Role; + + requires 'foo'; + + package Role::ProvideFoo; + use strict; + use warnings; + use Moose::Role; + + ::lives_ok { + with 'Role::RequireFoo'; + } '... the required "foo" method will not exist yet (but we will live)'; + + override 'foo' => sub { 'Role::ProvideFoo::foo' }; +} + +is_deeply( + [ Role::ProvideFoo->meta->get_required_method_list ], + [ 'foo' ], + '... foo method is still required for Role::ProvideFoo'); + +=pod + +Role which requires a method implemented +in the consuming class as an override. +It will fail since method modifiers are +second class citizens. + +=cut + +{ + package Class::ProvideFoo::Base; + use strict; + use warnings; + use Moose; + + sub foo { 'Class::ProvideFoo::Base::foo' } + + package Class::ProvideFoo::Override1; + use strict; + use warnings; + use Moose; + + extends 'Class::ProvideFoo::Base'; + + ::dies_ok { + with 'Role::RequireFoo'; + } '... the required "foo" method will not exist yet (and we will die)'; + + override 'foo' => sub { 'Class::ProvideFoo::foo' }; + + package Class::ProvideFoo::Override2; + use strict; + use warnings; + use Moose; + + extends 'Class::ProvideFoo::Base'; + + override 'foo' => sub { 'Class::ProvideFoo::foo' }; + + ::dies_ok { + with 'Role::RequireFoo'; + } '... the required "foo" method exists, but it is an override (and we will die)'; + +} + +=pod + +Now same thing, but with a before +method modifier. + +=cut + +{ + package Class::ProvideFoo::Before1; + use strict; + use warnings; + use Moose; + + extends 'Class::ProvideFoo::Base'; + + ::dies_ok { + with 'Role::RequireFoo'; + } '... the required "foo" method will not exist yet (and we will die)'; + + before 'foo' => sub { 'Class::ProvideFoo::foo:before' }; + + package Class::ProvideFoo::Before2; + use strict; + use warnings; + use Moose; + + extends 'Class::ProvideFoo::Base'; + + before 'foo' => sub { 'Class::ProvideFoo::foo:before' }; + + ::dies_ok { + with 'Role::RequireFoo'; + } '... the required "foo" method exists, but it is a before (and we will die)'; + + package Class::ProvideFoo::Before3; + use strict; + use warnings; + use Moose; + + extends 'Class::ProvideFoo::Base'; + + ::lives_ok { + with 'Role::RequireFoo'; + } '... the required "foo" method will not exist yet (and we will die)'; + + sub foo { 'Class::ProvideFoo::foo' } + before 'foo' => sub { 'Class::ProvideFoo::foo:before' }; + + package Class::ProvideFoo::Before4; + use strict; + use warnings; + use Moose; + + extends 'Class::ProvideFoo::Base'; + + sub foo { 'Class::ProvideFoo::foo' } + before 'foo' => sub { 'Class::ProvideFoo::foo:before' }; + + ::isa_ok(__PACKAGE__->meta->get_method('foo'), 'Class::MOP::Method::Wrapped'); + ::is(__PACKAGE__->meta->get_method('foo')->get_original_method->package_name, __PACKAGE__, + '... but the original method is from our package'); + + ::lives_ok { + with 'Role::RequireFoo'; + } '... the required "foo" method exists in the symbol table (and we will live)'; + + package Class::ProvideFoo::Before5; + use strict; + use warnings; + use Moose; + + extends 'Class::ProvideFoo::Base'; + + before 'foo' => sub { 'Class::ProvideFoo::foo:before' }; + + ::isa_ok(__PACKAGE__->meta->get_method('foo'), 'Class::MOP::Method::Wrapped'); + ::isnt(__PACKAGE__->meta->get_method('foo')->get_original_method->package_name, __PACKAGE__, + '... but the original method is not from our package'); + + ::dies_ok { + with 'Role::RequireFoo'; + } '... the required "foo" method exists, but it is a before wrapping the super (and we will die)'; +} + +=pod + +Now same thing, but with a method from an attribute +method modifier. + +=cut + +{ + + package Class::ProvideFoo::Attr1; + use strict; + use warnings; + use Moose; + + extends 'Class::ProvideFoo::Base'; + + ::dies_ok { + with 'Role::RequireFoo'; + } '... the required "foo" method will not exist yet (and we will die)'; + + has 'foo' => (is => 'ro'); + + package Class::ProvideFoo::Attr2; + use strict; + use warnings; + use Moose; + + extends 'Class::ProvideFoo::Base'; + + has 'foo' => (is => 'ro'); + + ::dies_ok { + with 'Role::RequireFoo'; + } '... the required "foo" method exists, but it is a before (and we will die)'; +} + + \ No newline at end of file