support array references in role method modifiers

diff --git a/lib/Moose/Role.pm b/lib/Moose/Role.pm
index 1c685ed..c139766 100644 (file)
--- a/lib/Moose/Role.pm
+++ b/lib/Moose/Role.pm
@@ -50,16 +50,13 @@ sub has {
 sub _add_method_modifier {
     my $type = shift;
     my $meta = shift;
-    my $code = pop @_;
-
-    for (@_) {
-        croak "Roles do not currently support "
-            . ref($_)
-            . " references for $type method modifiers"
-            if ref $_;
-        my $add_method = "add_${type}_method_modifier";
-        $meta->$add_method( $_, $code );
+
+    if ( ref($_[0]) eq 'Regexp' ) {
+        croak "Roles do not currently support regex "
+            . " references for $type method modifiers";
     }
+
+    Moose::Util::add_method_modifier($meta, $type, \@_);
 }
 
 sub before { _add_method_modifier('before', @_) }

diff --git a/t/030_roles/048_method_modifiers.t b/t/030_roles/048_method_modifiers.t
new file mode 100644 (file)
index 0000000..4bab997
--- /dev/null
+++ b/t/030_roles/048_method_modifiers.t
@@ -0,0 +1,90 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+use Test::Exception;
+
+my $FooRole;
+{
+    package Foo::Role;
+    use Moose::Role;
+    after foo => sub { $FooRole++ };
+}
+
+{
+    package Foo;
+    use Moose;
+    with 'Foo::Role';
+    sub foo { }
+}
+
+Foo->foo;
+is($FooRole, 1, "modifier called");
+
+my $BarRole;
+{
+    package Bar::Role;
+    use Moose::Role;
+    after ['foo', 'bar'] => sub { $BarRole++ };
+}
+
+{
+    package Bar;
+    use Moose;
+    with 'Bar::Role';
+    sub foo { }
+    sub bar { }
+}
+
+Bar->foo;
+is($BarRole, 1, "modifier called");
+Bar->bar;
+is($BarRole, 2, "modifier called");
+
+my $BazRole;
+{
+    package Baz::Role;
+    use Moose::Role;
+    after 'foo', 'bar' => sub { $BazRole++ };
+}
+
+{
+    package Baz;
+    use Moose;
+    with 'Baz::Role';
+    sub foo { }
+    sub bar { }
+}
+
+Baz->foo;
+is($BazRole, 1, "modifier called");
+Baz->bar;
+is($BazRole, 2, "modifier called");
+
+my $QuuxRole;
+{
+    package Quux::Role;
+    use Moose::Role;
+    { our $TODO; local $TODO = "can't handle regexes yet";
+    ::lives_ok {
+        after qr/foo|bar/ => sub { $QuuxRole++ }
+    };
+    }
+}
+
+{
+    package Quux;
+    use Moose;
+    with 'Quux::Role';
+    sub foo { }
+    sub bar { }
+}
+
+{ local $TODO = "can't handle regexes yet";
+Quux->foo;
+is($QuuxRole, 1, "modifier called");
+Quux->bar;
+is($QuuxRole, 2, "modifier called");
+}
+
+done_testing;