X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FRole%2FTiny.pm;h=66209643aa406daffe2b27684f7fb175333e9bdf;hb=fbe6dc87c11b77b9e1fe31666b00168d3a9182dc;hp=cd327868bd55db28768e04dbc4ebdbdd832a2505;hpb=12f8eb0b0fddf2f902d34a648e0feb8cb81c0a0f;p=gitmo%2FRole-Tiny.git

diff --git a/lib/Role/Tiny.pm b/lib/Role/Tiny.pm
index cd32786..6620964 100644
--- a/lib/Role/Tiny.pm
+++ b/lib/Role/Tiny.pm
@@ -6,7 +6,7 @@ sub _getstash { \%{"$_[0]::"} }
 use strict;
 use warnings FATAL => 'all';
 
-our $VERSION = '1.001002'; # 1.1.2
+our $VERSION = '1.001005'; # 1.1.5
 $VERSION = eval $VERSION;
 
 our %INFO;
@@ -51,13 +51,16 @@ sub import {
     *{_getglob "${target}::${type}"} = sub {
       require Class::Method::Modifiers;
       push @{$INFO{$target}{modifiers}||=[]}, [ $type => @_ ];
+      return;
     };
   }
   *{_getglob "${target}::requires"} = sub {
     push @{$INFO{$target}{requires}||=[]}, @_;
+    return;
   };
   *{_getglob "${target}::with"} = sub {
     $me->apply_roles_to_package($target, @_);
+    return;
   };
   # grab all *non-constant* (stash slot is not a scalarref) subs present
   # in the symbol table and store their refaddrs (no need to forcibly
@@ -130,6 +133,18 @@ sub create_class_with_roles {
     require MRO::Compat;
   }
 
+  my %conflicts = %{$me->_composite_info_for(@roles)->{conflicts}};
+  if (keys %conflicts) {
+    my $fail = 
+      join "\n",
+        map {
+          "Method name conflict for '$_' between roles "
+          ."'".join(' and ', sort values %{$conflicts{$_}})."'"
+          .", cannot apply these simultaneously to an object."
+        } keys %conflicts;
+    die $fail;
+  }
+
   my @composable = map $me->_composable_package_for($_), reverse @roles;
 
   *{_getglob("${new_name}::ISA")} = [ @composable, $superclass ];
@@ -173,7 +188,14 @@ sub apply_roles_to_package {
         } keys %conflicts;
     die $fail;
   }
-  delete $INFO{$to}{methods}; # reset since we're about to add methods
+
+  # the if guard here is essential since otherwise we accidentally create
+  # a $INFO for something that isn't a Role::Tiny (or Moo::Role) because
+  # autovivification hates us and wants us to die()
+  if ($INFO{$to}) {
+    delete $INFO{$to}{methods}; # reset since we're about to add methods
+  }
+
   $me->apply_role_to_package($to, $_) for @roles;
   $APPLIED_TO{$to}{join('|',@roles)} = 1;
 }
@@ -237,7 +259,7 @@ sub _concrete_methods_of {
   my $stash = do { no strict 'refs'; \%{"${role}::"}};
   # reverse so our keys become the values (captured coderefs) in case
   # they got copied or re-used since
-  my $not_methods = { reverse %{$info->{not_methods}} };
+  my $not_methods = { reverse %{$info->{not_methods}||{}} };
   $info->{methods} ||= +{
     # grab all code entries that aren't in the not_methods list
     map {
@@ -295,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;
@@ -507,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>