conflicts on application to object
Matt S Trout [Fri, 25 May 2012 15:09:19 +0000 (15:09 +0000)]
Changes
lib/Role/Tiny.pm
t/role-tiny-composition.t [new file with mode: 0644]

diff --git a/Changes b/Changes
index 5ec7afb..7c33e19 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,3 +1,4 @@
+  - check for conflicts during role-to-object application (test from mmcleric)
   - add an explicit return to all exported subs so people don't accidentally
     rely on the return value
   - store coderefs as well as their refaddrs to protect against crazy
index 7f8c7fb..6e3a70a 100644 (file)
@@ -133,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 ];
diff --git a/t/role-tiny-composition.t b/t/role-tiny-composition.t
new file mode 100644 (file)
index 0000000..565d1d3
--- /dev/null
@@ -0,0 +1,32 @@
+use strictures 1;
+use Test::More;
+use Test::Fatal;
+
+{
+  package R1;
+  use Role::Tiny;
+
+  sub foo {}
+
+  $INC{"R1.pm"} = __FILE__;
+}
+
+{
+  package R2;
+  use Role::Tiny;
+
+  sub foo {}
+
+  $INC{"R2.pm"} = __FILE__;
+}
+
+{
+  package X;
+  sub new {
+      bless {} => shift
+  }
+}
+
+ok(exception { Role::Tiny->apply_roles_to_object(X->new, "R1", "R2") }, 'apply conflicting roles to object');
+
+done_testing;