fixed a method exclusion/aliasing bug

diff --git a/Changes b/Changes
index 9fbdabd..e82b98b 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,5 +1,13 @@
 Revision history for Perl extension Moose
 
+0.62
+    * Moose::Meta::Role::Application::ToClass
+      Moose::Meta::Role::Application::ToRole
+      - fixed issues where excluding and aliasing the 
+        same methods for a single role did not work 
+        right (worked just fine with multiple roles)
+        - added test for this
+
 0.61 Fri November 7, 2008
     * Moose::Meta::Attribute
       - When passing a role to handles, it will be loaded if necessary

diff --git a/MANIFEST b/MANIFEST
index 61ce0ea..4e70d2b 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -168,6 +168,7 @@ t/030_roles/026_role_composition_method_mods.t
 t/030_roles/030_role_parameterized.t
 t/030_roles/031_roles_applied_in_create.t
 t/030_roles/032_roles_and_method_cloning.t
+t/030_roles/033_role_exclusion_and_alias_bug.t
 t/040_type_constraints/001_util_type_constraints.t
 t/040_type_constraints/002_util_type_constraints_export.t
 t/040_type_constraints/003_util_std_type_constraints.t

diff --git a/lib/Moose/Meta/Role/Application/ToClass.pm b/lib/Moose/Meta/Role/Application/ToClass.pm
index d578d72..b75a263 100644 (file)
--- a/lib/Moose/Meta/Role/Application/ToClass.pm
+++ b/lib/Moose/Meta/Role/Application/ToClass.pm
@@ -100,20 +100,20 @@ sub apply_methods {
     my ($self, $role, $class) = @_;
     foreach my $method_name ($role->get_method_list) {
         
-        next if $self->is_method_excluded($method_name);
-        
-        # it if it has one already
-        if ($class->has_method($method_name) &&
-            # and if they are not the same thing ...
-            $class->get_method($method_name)->body != $role->get_method($method_name)->body) {
-            next;
-        }
-        else {
-            # add it, although it could be overriden
-            $class->add_method(
-                $method_name,
-                $role->get_method($method_name)
-            );         
+        unless ($self->is_method_excluded($method_name)) {
+            # it if it has one already
+            if ($class->has_method($method_name) &&
+                # and if they are not the same thing ...
+                $class->get_method($method_name)->body != $role->get_method($method_name)->body) {
+                next;
+            }
+            else {
+                # add it, although it could be overriden
+                $class->add_method(
+                    $method_name,
+                    $role->get_method($method_name)
+                );         
+            }
         }
         
         if ($self->is_method_aliased($method_name)) {

diff --git a/lib/Moose/Meta/Role/Application/ToRole.pm b/lib/Moose/Meta/Role/Application/ToRole.pm
index f5e38a2..c569f41 100644 (file)
--- a/lib/Moose/Meta/Role/Application/ToRole.pm
+++ b/lib/Moose/Meta/Role/Application/ToRole.pm
@@ -66,8 +66,6 @@ sub apply_attributes {
 sub apply_methods {
     my ($self, $role1, $role2) = @_;
     foreach my $method_name ($role1->get_method_list) {
-        
-        next if $self->is_method_excluded($method_name);        
 
         if ($self->is_method_aliased($method_name)) {
             my $aliased_method_name = $self->get_method_aliases->{$method_name};
@@ -84,11 +82,14 @@ sub apply_methods {
             );
 
             if (!$role2->has_method($method_name)) {
-                $role2->add_required_methods($method_name);
+                $role2->add_required_methods($method_name)
+                    unless $self->is_method_excluded($method_name);
             }
 
             next;
-        }        
+        }     
+        
+        next if $self->is_method_excluded($method_name);           
         
         # it if it has one already
         if ($role2->has_method($method_name) &&

diff --git a/t/030_roles/033_role_exclusion_and_alias_bug.t b/t/030_roles/033_role_exclusion_and_alias_bug.t
new file mode 100644 (file)
index 0000000..3fecf9d
--- /dev/null
+++ b/t/030_roles/033_role_exclusion_and_alias_bug.t
@@ -0,0 +1,69 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 17;
+use Test::Moose;
+
+{
+    package My::Role;
+    use Moose::Role;
+    
+    sub foo { "FOO" }
+    sub bar { "BAR" }    
+}
+
+{
+    package My::Class;
+    use Moose;
+    
+    with 'My::Role' => {
+        alias    => { foo => 'baz', bar => 'gorch' },
+        excludes => ['foo', 'bar'],        
+    };
+}
+
+{
+    my $x = My::Class->new;
+    isa_ok($x, 'My::Class');
+    does_ok($x, 'My::Role');
+
+    can_ok($x, $_) for qw[baz gorch];
+
+    ok(!$x->can($_), '... cant call method ' . $_) for qw[foo bar];
+
+    is($x->baz, 'FOO', '... got the right value');
+    is($x->gorch, 'BAR', '... got the right value');
+}
+
+{
+    package My::Role::Again;
+    use Moose::Role;
+    
+    with 'My::Role' => {
+        alias    => { foo => 'baz', bar => 'gorch' },
+        excludes => ['foo', 'bar'],        
+    };
+    
+    package My::Class::Again;
+    use Moose;
+    
+    with 'My::Role::Again';
+}
+
+{
+    my $x = My::Class::Again->new;
+    isa_ok($x, 'My::Class::Again');
+    does_ok($x, 'My::Role::Again');
+    does_ok($x, 'My::Role');
+
+    can_ok($x, $_) for qw[baz gorch];
+
+    ok(!$x->can($_), '... cant call method ' . $_) for qw[foo bar];
+
+    is($x->baz, 'FOO', '... got the right value');
+    is($x->gorch, 'BAR', '... got the right value');
+}
+
+