more-tests

diff --git a/lib/Moose/Meta/Role.pm b/lib/Moose/Meta/Role.pm
index 61c8f29..e5724bc 100644 (file)
--- 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<add_required_methods>
 
+=item B<remove_required_methods>
+
 =item B<get_required_method_list>
 
 =item B<get_required_methods_map>

diff --git a/t/041_role.t b/t/041_role.t
index eaefa07..da598a2 100644 (file)
--- 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 (file)
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