more-roles

diff --git a/lib/Moose/Meta/Role.pm b/lib/Moose/Meta/Role.pm
index e5724bc..3b938cd 100644 (file)
--- 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 (file)
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');