From: Jesse Luehrs Date: Sat, 25 Jun 2011 18:05:52 +0000 (-0500) Subject: make Moose::Util::does_role respect overridden ->does methods X-Git-Tag: 2.0105~1 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=094b6ec90bd199688b77c4143bf9925a9fce3d03;p=gitmo%2FMoose.git make Moose::Util::does_role respect overridden ->does methods --- diff --git a/Changes b/Changes index 64e01c9..4cd18f5 100644 --- a/Changes +++ b/Changes @@ -3,6 +3,10 @@ for, noteworthy changes. {{$NEXT}} + [ENHANCEMENTS] + + * Moose::Util::does_role now respects overridden ->does methods. (doy) + 2.0104-TRIAL Mon, Jun 20, 2011 [OTHER] diff --git a/lib/Moose/Util.pm b/lib/Moose/Util.pm index 130a982..da44827 100644 --- a/lib/Moose/Util.pm +++ b/lib/Moose/Util.pm @@ -10,6 +10,7 @@ use Scalar::Util 'blessed'; use List::Util qw(first); use List::MoreUtils qw(any all); use overload (); +use Try::Tiny; use Class::MOP; my @exports = qw[ @@ -43,6 +44,10 @@ sub find_meta { Class::MOP::class_of(@_) } sub does_role { my ($class_or_obj, $role) = @_; + if (try { $class_or_obj->can('does') }) { + return $class_or_obj->does($role); + } + my $meta = find_meta($class_or_obj); return unless defined $meta; diff --git a/t/moose_util/moose_util_does_role.t b/t/moose_util/moose_util_does_role.t index 26c1176..2505c9d 100644 --- a/t/moose_util/moose_util_does_role.t +++ b/t/moose_util/moose_util_does_role.t @@ -43,6 +43,18 @@ BEGIN { with 'Foo'; } +{ + package DoesMethod; + use Moose; + + sub does { + my $self = shift; + my ($role) = @_; + return 1 if $role eq 'Something::Else'; + return $self->SUPER::does(@_); + } +} + # Classes ok(does_role('Bar', 'Foo'), '... Bar does Foo'); @@ -69,6 +81,10 @@ ok(!does_role(1,'Foo'), '... 1 doesnt do Foo'); ok(!does_role('Quux', 'Foo'), '... Quux doesnt do Foo (does not die tho)'); +# overriding the does method works properly + +ok(does_role('DoesMethod', 'Something::Else'), '... can override the does method'); + # TODO: make the below work, maybe? # Self