stuff

diff --git a/Changes b/Changes
index 8c754b8..13da993 100644 (file)
--- a/Changes
+++ b/Changes
@@ -11,7 +11,8 @@ Revision history for Perl extension Moose
     * Moose::Meta::Role
       - ripped out much of it's guts ,.. much cleaner now
       - added required methods and correct handling of 
-        them in apply()
+        them in apply() for both classes and roles
+        - added tests for this
       - no longer adds a does() method to consuming classes 
         it relys on the one in Moose::Object
       - added roles attribute and some methods to support 

diff --git a/lib/Moose/Meta/Role.pm b/lib/Moose/Meta/Role.pm
index aa68ba8..d0db84f 100644 (file)
--- a/lib/Moose/Meta/Role.pm
+++ b/lib/Moose/Meta/Role.pm
@@ -242,9 +242,15 @@ sub apply {
     # that maybe those are somehow exempt from 
     # the require methods stuff.  
     foreach my $required_method_name ($self->get_required_method_list) {
-        ($other->has_method($required_method_name))
-            || confess "Role (" . $self->name . ") requires the method '$required_method_name'" . 
-                      "is implemented by the class '" . $other->name . "'";
+        unless ($other->has_method($required_method_name)) {
+            if ($other->isa('Moose::Meta::Role')) {
+                $other->add_required_methods($required_method_name);
+            }
+            else {
+                confess "'" . $self->name . "' requires the method '$required_method_name' " . 
+                        "to be implemented by '" . $other->name . "'";
+            }
+        }
     }    
     
     foreach my $attribute_name ($self->get_attribute_list) {

diff --git a/t/043_role_composition_errors.t b/t/043_role_composition_errors.t
index 1514a38..b9e78d7 100644 (file)
--- a/t/043_role_composition_errors.t
+++ b/t/043_role_composition_errors.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 5;
+use Test::More tests => 10;
 use Test::Exception;
 
 BEGIN {  
@@ -19,6 +19,11 @@ BEGIN {
     requires 'foo';
 }
 
+is_deeply(
+    [ sort Foo::Role->meta->get_required_method_list ],
+    [ 'foo' ],
+    '... the Foo::Role has a required method (foo)');
+
 # classes which does not implement required method
 {
     package Foo::Class;
@@ -53,13 +58,46 @@ BEGIN {
     sub foo { 'Bar::Role::foo' }
 }
 
+is_deeply(
+    [ sort Bar::Role->meta->get_required_method_list ],
+    [],
+    '... the Bar::Role has not inherited the required method from Foo::Role');
+
 # role which does not implement required method
 {
     package Baz::Role;
     use strict;
     use warnings;
-    use Moose;
+    use Moose::Role;
     
     ::lives_ok { with('Foo::Role') } '... no foo method implemented by Baz::Role';
 }
 
+is_deeply(
+    [ sort Baz::Role->meta->get_required_method_list ],
+    [ 'foo' ],
+    '... the Baz::Role has inherited the required method from Foo::Role');
+    
+# classes which does not implement required method
+{
+    package Baz::Class;
+    use strict;
+    use warnings;
+    use Moose;
+
+    ::dies_ok { with('Baz::Role') } '... no foo method implemented by Baz::Class2';
+}
+
+# class which does implement required method
+{
+    package Baz::Class2;
+    use strict;
+    use warnings;
+    use Moose;
+
+    ::lives_ok { with('Baz::Role') } '... has a foo method implemented by Baz::Class2';
+
+    sub foo { 'Baz::Class2::foo' }
+}    
+    
+