From: Jesse Luehrs Date: Wed, 20 Jul 2011 15:12:41 +0000 (-0500) Subject: initialize the metaclass when calling ->does X-Git-Tag: 2.0300~138 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=6d87e24180fa3b20cb55d9985cf83b8db5c6dadc;p=gitmo%2FMoose.git initialize the metaclass when calling ->does --- diff --git a/lib/Moose/Object.pm b/lib/Moose/Object.pm index 8dbd984..e619d1f 100644 --- a/lib/Moose/Object.pm +++ b/lib/Moose/Object.pm @@ -112,7 +112,8 @@ BEGIN { # as appropiate see Moose::Meta::Role sub does { my ($self, $role_name) = @_; - my $meta = Class::MOP::class_of($self); + my $class = Scalar::Util::blessed($self) || $self; + my $meta = Class::MOP::Class->initialize($class); (defined $role_name) || $meta->throw_error("You must supply a role name to does()"); return 1 if $meta->can('does_role') && $meta->does_role($role_name); diff --git a/t/roles/use_base_does.t b/t/roles/use_base_does.t new file mode 100644 index 0000000..49cc004 --- /dev/null +++ b/t/roles/use_base_does.t @@ -0,0 +1,43 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; + +{ + package Foo::Role; + use Moose::Role; +} + +{ + package Foo; + use Moose; + + with 'Foo::Role'; +} + +{ + package Foo::Sub; + use base 'Foo'; +} + +{ + package Foo::Sub2; + use base 'Foo'; +} + +{ + package Foo::Sub3; + use base 'Foo'; +} + +{ + package Foo::Sub4; + use base 'Foo'; +} + +ok(Foo::Sub->does('Foo::Role'), "class does Foo::Role"); +ok(Foo::Sub2->new->does('Foo::Role'), "object does Foo::Role"); +ok(!Foo::Sub3->does('Bar::Role'), "class doesn't do Bar::Role"); +ok(!Foo::Sub4->new->does('Bar::Role'), "object doesn't do Bar::Role"); + +done_testing;