When applying a role to a class and some methods are missing (or are

accessors), collect all the missing methods together and mention them
all in the error, rather than just dying on the first one. This makes
for a much friendlier error message. (RT #41119).

diff --git a/Changes b/Changes
index 770cb05..b2cbc48 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,5 +1,12 @@
 Revision history for Perl extension Moose
 
+0.63
+    * Moose::Meta::Role::Application::ToClass
+      - When a class does not provide all of a role's required
+        methods, the error thrown now mentions all of the missing
+        methods, as opposed to just the first one found. Requested by
+        Michael Schwern (RT #41119). (Dave Rolsky)
+
 0.62_01 Wed, December 3, 2008
     * Moose::Object
       - use the method->execute API for BUILDALL

diff --git a/lib/Moose/Meta/Role/Application/ToClass.pm b/lib/Moose/Meta/Role/Application/ToClass.pm
index da24330..a29a9fe 100644 (file)
--- a/lib/Moose/Meta/Role/Application/ToClass.pm
+++ b/lib/Moose/Meta/Role/Application/ToClass.pm
@@ -4,7 +4,8 @@ use strict;
 use warnings;
 use metaclass;
 
-use Scalar::Util    'blessed';
+use Moose::Util  'english_list';
+use Scalar::Util 'blessed';
 
 our $VERSION   = '0.62_01';
 $VERSION = eval $VERSION;
@@ -32,6 +33,10 @@ sub check_role_exclusions {
 
 sub check_required_methods {
     my ($self, $role, $class) = @_;
+
+    my @missing;
+    my @is_attr;
+
     # NOTE:
     # we might need to move this down below the
     # the attributes so that we can require any
@@ -43,9 +48,8 @@ sub check_required_methods {
         if (!$class->find_method_by_name($required_method_name)) {
             
             next if $self->is_aliased_method($required_method_name);
-            
-            $class->throw_error("'" . $role->name . "' requires the method '$required_method_name' " .
-                    "to be implemented by '" . $class->name . "'");
+
+            push @missing, $required_method_name;
         }
         else {
             # NOTE:
@@ -55,9 +59,8 @@ sub check_required_methods {
             my $method = $class->find_method_by_name($required_method_name);
 
             # check if it is a generated accessor ...
-            (!$method->isa('Class::MOP::Method::Accessor'))
-                || $class->throw_error("'" . $role->name . "' requires the method '$required_method_name' " .
-                           "to be implemented by '" . $class->name . "', the method is only an attribute accessor");
+            push @is_attr, $required_method_name,
+                if $method->isa('Class::MOP::Method::Accessor');
 
             # NOTE:
             # All other tests here have been removed, they were tests
@@ -72,6 +75,43 @@ sub check_required_methods {
             # - SL
         }
     }
+
+    return unless @missing || @is_attr;
+
+    my $error = '';
+
+    if (@missing) {
+        my $noun = @missing == 1 ? 'method' : 'methods';
+
+        my $list
+            = Moose::Util::english_list( map { q{'} . $_ . q{'} } @missing );
+
+        $error
+            .= q{'}
+            . $role->name
+            . "' requires the $noun $list "
+            . "to be implemented by '"
+            . $class->name . q{'};
+    }
+
+    if (@is_attr) {
+        my $noun = @is_attr == 1 ? 'method' : 'methods';
+
+        my $list
+            = Moose::Util::english_list( map { q{'} . $_ . q{'} } @is_attr );
+
+        $error .= "\n" if length $error;
+
+        $error
+            .= q{'}
+            . $role->name
+            . "' requires the $noun $list "
+            . "to be implemented by '"
+            . $class->name
+            . "' but the method is only an attribute accessor";
+    }
+
+    $class->throw_error($error);
 }
 
 sub check_required_attributes {

diff --git a/lib/Moose/Util.pm b/lib/Moose/Util.pm
index e069711..5f72b9f 100644 (file)
--- a/lib/Moose/Util.pm
+++ b/lib/Moose/Util.pm
@@ -21,6 +21,7 @@ my @exports = qw[
     resolve_metatrait_alias
     resolve_metaclass_alias
     add_method_modifier
+    english_list
 ];
 
 Sub::Exporter::setup_exporter({
@@ -170,6 +171,19 @@ sub add_method_modifier {
     }
 }
 
+sub english_list {
+    my @items = sort @_;
+
+    return $items[0] if @items == 1;
+    return "$items[0] and $items[1]" if @items == 2;
+
+    my $tail = pop @items;
+    my $list = join ', ', @items;
+    $list .= ', and ' . $tail;
+
+    return $list;
+}
+
 1;
 
 __END__
@@ -254,6 +268,12 @@ to a full class name.
 
 =item B<add_method_modifier ($class_or_obj, $modifier_name, $args)>
 
+=item B<english_list(@items)>
+
+Given a list of scalars, turns them into a proper list in English
+("one and two", "one, two, three, and four"). This is used to help us
+make nicer error messages.
+
 =back
 
 =head1 TODO

diff --git a/t/030_roles/004_role_composition_errors.t b/t/030_roles/004_role_composition_errors.t
index 0ad4331..7e8aba6 100644 (file)
--- a/t/030_roles/004_role_composition_errors.t
+++ b/t/030_roles/004_role_composition_errors.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 10;
+use Test::More tests => 14;
 use Test::Exception;
 
 
@@ -102,3 +102,58 @@ is_deeply(
     sub foo {'Baz::Class2::foo'}
 }
 
+
+{
+    package Quux::Role;
+    use Moose::Role;
+
+    requires qw( meth1 meth2 meth3 meth4 );
+}
+
+# RT #41119
+{
+
+    package Quux::Class;
+    use Moose;
+
+    ::throws_ok { with('Quux::Role') }
+        qr/\Q'Quux::Role' requires the methods 'meth1', 'meth2', 'meth3', and 'meth4' to be implemented by 'Quux::Class'/,
+        'exception mentions all the missing required methods at once';
+}
+
+{
+    package Quux::Class2;
+    use Moose;
+
+    sub meth1 { }
+
+    ::throws_ok { with('Quux::Role') }
+        qr/'Quux::Role' requires the methods 'meth2', 'meth3', and 'meth4' to be implemented by 'Quux::Class2'/,
+        'exception mentions all the missing required methods at once, but not the one that exists';
+}
+
+{
+    package Quux::Class3;
+    use Moose;
+
+    has 'meth1' => ( is => 'ro' );
+    has 'meth2' => ( is => 'ro' );
+
+    ::throws_ok { with('Quux::Role') }
+        qr/\Q'Quux::Role' requires the methods 'meth3' and 'meth4' to be implemented by 'Quux::Class3'\E\n
+           \Q'Quux::Role' requires the methods 'meth1' and 'meth2' to be implemented by 'Quux::Class3' but the method is only an attribute accessor/x,
+        'exception mentions all the require methods that are accessors at once, as well as missing methods';
+}
+
+{
+    package Quux::Class4;
+    use Moose;
+
+    sub meth1 { }
+    has 'meth2' => ( is => 'ro' );
+
+    ::throws_ok { with('Quux::Role') }
+        qr/\Q'Quux::Role' requires the methods 'meth3' and 'meth4' to be implemented by 'Quux::Class4'\E\n
+           \Q'Quux::Role' requires the method 'meth2' to be implemented by 'Quux::Class4' but the method is only an attribute accessor/x,
+        'exception mentions all the require methods that are accessors at once, as well as missing methods, but not the one that exists';
+}