Mouse::Role supports 'with'

diff --git a/lib/Mouse/Meta/Role.pm b/lib/Mouse/Meta/Role.pm
index 9037044..9072312 100644 (file)
--- a/lib/Mouse/Meta/Role.pm
+++ b/lib/Mouse/Meta/Role.pm
@@ -91,12 +91,24 @@ sub apply {
         }
     }
 
-    for my $name ($self->get_attribute_list) {
-        next if $class->has_attribute($name);
-        my $spec = $self->get_attribute($name);
-        Mouse::Meta::Attribute->create($class, $name, %$spec);
+    if ($class->isa('Mouse::Meta::Class')) {
+        # apply role to class
+        for my $name ($self->get_attribute_list) {
+            next if $class->has_attribute($name);
+            my $spec = $self->get_attribute($name);
+            Mouse::Meta::Attribute->create($class, $name, %$spec);
+        }
+    } else {
+        # apply role to role
+        # XXX Room for speed improvement
+        for my $name ($self->get_attribute_list) {
+            next if $class->has_attribute($name);
+            my $spec = $self->get_attribute($name);
+            $class->add_attribute($name, $spec);
+        }
     }
 
+    # XXX Room for speed improvement in role to role
     for my $modifier_type (qw/before after around/) {
         my $add_method = "add_${modifier_type}_method_modifier";
         my $modified = $self->{"${modifier_type}_method_modifiers"};

diff --git a/lib/Mouse/Role.pm b/lib/Mouse/Role.pm
index 057761a..b222a1d 100644 (file)
--- a/lib/Mouse/Role.pm
+++ b/lib/Mouse/Role.pm
@@ -49,7 +49,14 @@ sub has {
 
 sub extends  { confess "Roles do not support 'extends'" }
 
-sub with     { confess "Mouse::Role does not currently support 'with'" }
+sub with     {
+    my $meta = Mouse::Meta::Role->initialize(caller);
+    my $role  = shift;
+    confess "Mouse::Role only supports 'with' on individual roles at a time" if @_;
+
+    Mouse::load_class($role);
+    $role->meta->apply($meta);
+}
 
 sub requires {
     my $meta = Mouse::Meta::Role->initialize(caller);

diff --git a/t/035-apply-roles-to-roles.t b/t/035-apply-roles-to-roles.t
new file mode 100644 (file)
index 0000000..a6842d5
--- /dev/null
+++ b/t/035-apply-roles-to-roles.t
@@ -0,0 +1,30 @@
+use strict;
+use warnings;
+use Test::More tests => 4;
+
+{
+    package Animal;
+    use Mouse::Role;
+    sub eat { 'delicious' }
+    has food => ( is => 'ro' );
+}
+
+{
+    package Dog;
+    use Mouse::Role;
+    with 'Animal';
+}
+
+{
+    package Chihuahua;
+    use Mouse;
+    with 'Dog';
+}
+
+ok !Animal->can('food');
+ok !Dog->can('food');
+
+my $c = Chihuahua->new(food => 'bone');
+is $c->eat(), 'delicious';
+is $c->food(), 'bone';
+

diff --git a/t/400-define-role.t b/t/400-define-role.t
index aa7f598..5f130cc 100644 (file)
--- a/t/400-define-role.t
+++ b/t/400-define-role.t
@@ -55,14 +55,14 @@ do {
     no Mouse::Role;
 };
 
-throws_ok {
+lives_ok {
     package Role;
     use Mouse::Role;
 
     with 'Other::Role';
 
     no Mouse::Role;
-} qr/Mouse::Role does not currently support 'with'/;
+};
 
 throws_ok {
     package Role;