From: Dagfinn Ilmari Mannsåker <ilmari@photobox.com>
Date: Wed, 18 Jul 2012 11:25:47 +0000 (+0100)
Subject: properly report roles consumed by superclasses
X-Git-Tag: v1.001005~2
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=910376403fcdff119e50dd7bc785547a6ed56036;p=gitmo%2FRole-Tiny.git

properly report roles consumed by superclasses
---

diff --git a/Changes b/Changes
index 0708b83..79c8584 100644
--- a/Changes
+++ b/Changes
@@ -1,4 +1,5 @@
   - localize UNIVERSAL::can change to avoid confusing TB2
+  - properly report roles consumed by superclasses
 
 1.001004 - 2012-07-12
   - remove strictures.pm from the test supplied by mmcleric so we install again
diff --git a/lib/Role/Tiny.pm b/lib/Role/Tiny.pm
index f5ef55e..fc4eb6e 100644
--- a/lib/Role/Tiny.pm
+++ b/lib/Role/Tiny.pm
@@ -159,7 +159,7 @@ sub create_class_with_roles {
   *{_getglob "${new_name}::does"} = \&does_role unless $new_name->can('does');
 
   @{$APPLIED_TO{$new_name}||={}}{
-    map keys %{$APPLIED_TO{$_}}, @roles, $superclass
+    map keys %{$APPLIED_TO{$_}}, @roles
   } = ();
 
   $COMPOSED{class}{$new_name} = 1;
@@ -317,7 +317,15 @@ sub _install_single_modifier {
 
 sub does_role {
   my ($proto, $role) = @_;
-  return exists $APPLIED_TO{ref($proto)||$proto}{$role};
+  if ($] >= 5.010) {
+    require mro;
+  } else {
+    require MRO::Compat;
+  }
+  foreach my $class (@{mro::get_linear_isa(ref($proto)||$proto)}) {
+    return 1 if exists $APPLIED_TO{$class}{$role};
+  }
+  return 0;
 }
 
 1;
@@ -529,6 +537,8 @@ perigrin - Chris Prather (cpan:PERIGRIN) <chris@prather.org>
 
 Mithaldu - Christian Walde (cpan:MITHALDU) <walde.christian@googlemail.com>
 
+ilmari - Dagfinn Ilmari Mannsåker (cpan:ILMARI) <ilmari@ilmari.org>
+
 =head1 COPYRIGHT
 
 Copyright (c) 2010-2012 the Role::Tiny L</AUTHOR> and L</CONTRIBUTORS>
diff --git a/t/role-with-inheritance.t b/t/role-with-inheritance.t
new file mode 100644
index 0000000..3191cb3
--- /dev/null
+++ b/t/role-with-inheritance.t
@@ -0,0 +1,30 @@
+use strict;
+use warnings FATAL => 'all';
+use Test::More;
+
+{
+  package R1;
+  use Role::Tiny;
+}
+{
+  package R2;
+  use Role::Tiny;
+}
+{
+  package C1;
+  use Role::Tiny::With;
+  with 'R1';
+}
+{
+  package C2;
+  use Role::Tiny::With;
+  our @ISA=('C1');
+  with 'R2';
+}
+
+ok Role::Tiny::does_role('C1','R1'), "Parent does own role";
+ok !Role::Tiny::does_role('C1','R2'), "Parent does not do child's role";
+ok Role::Tiny::does_role('C2','R1'), "Child does base's role";
+ok Role::Tiny::does_role('C2','R2'), "Child does own role";
+
+done_testing();