add is_role method

diff --git a/Changes b/Changes
index 196bd5e..3275ae2 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,6 +1,7 @@
   - Fix _concrete_methods_of returning non-CODE entries
   - fix broken implementation of method conflict resolution
     (Perlmonks#1041015)
+  - add is_role method for checking if a given package is a role
 
 1.002005 - 2013-02-01
   - complain loudly if Class::Method::Modifiers is too old (and skip tests)

diff --git a/lib/Role/Tiny.pm b/lib/Role/Tiny.pm
index 9ce2caf..44659cf 100644 (file)
--- a/lib/Role/Tiny.pm
+++ b/lib/Role/Tiny.pm
@@ -361,6 +361,11 @@ sub does_role {
   return 0;
 }
 
+sub is_role {
+  my ($me, $role) = @_;
+  return !!$INFO{$role};
+}
+
 1;
 
 =encoding utf-8
@@ -538,6 +543,12 @@ resulting class.
 Creates a new class based on base, with the roles composed into it in order.
 New class is returned.
 
+=head2 is_role
+
+ Role::Tiny->is_role('Some::Role1')
+
+Returns true if the given package is a role.
+
 =head1 SEE ALSO
 
 L<Role::Tiny> is the attribute-less subset of L<Moo::Role>; L<Moo::Role> is

diff --git a/t/role-tiny.t b/t/role-tiny.t
index 57914c0..f93cc78 100644 (file)
--- a/t/role-tiny.t
+++ b/t/role-tiny.t
@@ -92,5 +92,9 @@ is exception {
 isa_ok($new_class, 'MyClass');
 is($new_class->extra1, 'role extra', 'method from role');
 
+ok(Role::Tiny->is_role('MyRole'), 'is_role true for roles');
+ok(!Role::Tiny->is_role('MyClass'), 'is_role false for classes');
+
+
 done_testing;