From: Shawn M Moore <code@sartak.org>
Date: Fri, 15 Jun 2012 20:04:00 +0000 (-0500)
Subject: MethodConflict exception
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=487bd8364ee497f50bafd20c52c4a372a69d73ea;p=gitmo%2FMoose.git

MethodConflict exception
---

diff --git a/lib/Moose/Exception/MethodConflict.pm b/lib/Moose/Exception/MethodConflict.pm
new file mode 100644
index 0000000..a1e0b91
--- /dev/null
+++ b/lib/Moose/Exception/MethodConflict.pm
@@ -0,0 +1,70 @@
+package Moose::Exception::MethodConflict;
+use Moose;
+extends 'Moose::Exception';
+
+has '+message' => (
+    required => 0,
+    builder  => '_build_message',
+);
+
+has consumer => (
+    is       => 'ro',
+    isa      => 'Moose::Meta::Class',
+    required => 1,
+);
+
+has roles => (
+    traits   => ['Array'],
+    isa      => 'ArrayRef[RoleName]', # XXX we should have objects here
+    lazy     => 1,
+    default  => sub { shift->_first_method->roles },
+    handles  => {
+        roles => 'elements',
+    },
+);
+
+has methods => (
+    traits   => ['Array'],
+    isa      => 'ArrayRef[Moose::Meta::Role::Method::Conflicting]',
+    required => 1,
+    handles  => {
+        methods       => 'elements',
+        _first_method => [ get => 0 ],
+    },
+);
+
+sub _build_message {
+    my $self = shift;
+
+    my $class = $self->consumer;
+    my @conflicts = $self->methods;
+    my $conflict = $self->_first_method;
+    my $roles = $conflict->roles_as_english_list;
+
+    my @same_role_conflicts = grep { $_->roles_as_english_list eq $roles } @conflicts;
+
+    if (@same_role_conflicts == 1) {
+        return "Due to a method name conflict in roles "
+               .  $roles
+               . ", the method '"
+               . $conflict->name
+               . "' must be implemented or excluded by '"
+               . $class->name
+               . q{'};
+    }
+    else {
+        my $methods
+            = Moose::Util::english_list( map { q{'} . $_->name . q{'} } @same_role_conflicts );
+
+        return "Due to method name conflicts in roles "
+             .  $roles
+             . ", the methods "
+             . $methods
+             . " must be implemented or excluded by '"
+             . $class->name
+             . q{'};
+    }
+}
+
+1;
+
diff --git a/lib/Moose/Meta/Role/Application/ToClass.pm b/lib/Moose/Meta/Role/Application/ToClass.pm
index 822d1e5..d078291 100644
--- a/lib/Moose/Meta/Role/Application/ToClass.pm
+++ b/lib/Moose/Meta/Role/Application/ToClass.pm
@@ -76,34 +76,11 @@ sub check_required_methods {
     my @conflicts = grep { $_->isa('Moose::Meta::Role::Method::Conflicting') } @missing;
 
     if (@conflicts) {
-        my $conflict = $conflicts[0];
-        my $roles = $conflict->roles_as_english_list;
-
-        my @same_role_conflicts = grep { $_->roles_as_english_list eq $roles } @conflicts;
-
-        if (@same_role_conflicts == 1) {
-            $error
-                .= "Due to a method name conflict in roles "
-                .  $roles
-                . ", the method '"
-                . $conflict->name
-                . "' must be implemented or excluded by '"
-                . $class->name
-                . q{'};
-        }
-        else {
-            my $methods
-                = Moose::Util::english_list( map { q{'} . $_->name . q{'} } @same_role_conflicts );
-
-            $error
-                .= "Due to method name conflicts in roles "
-                .  $roles
-                . ", the methods "
-                . $methods
-                . " must be implemented or excluded by '"
-                . $class->name
-                . q{'};
-        }
+        Moose::Util::throw(
+            class    => 'Moose::Exception::MethodConflict',
+            methods  => \@conflicts,
+            consumer => $class,
+        );
     }
     elsif (@missing) {
         my $noun = @missing == 1 ? 'method' : 'methods';
diff --git a/t/exceptions/role_conflict.t b/t/exceptions/role_conflict.t
new file mode 100644
index 0000000..b949a76
--- /dev/null
+++ b/t/exceptions/role_conflict.t
@@ -0,0 +1,37 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Fatal;
+
+BEGIN {
+    package Test::Dog;
+    use Moose::Role;
+
+    sub bark { "dog" }
+}
+
+BEGIN {
+    package Test::Tree;
+    use Moose::Role;
+
+    sub bark { "tree" }
+}
+
+my $exception = exception {
+    package C;
+    use Moose;
+
+    with 'Test::Dog', 'Test::Tree';
+};
+
+isa_ok($exception, 'Moose::Exception::MethodConflict');
+is($exception->message, q{Due to a method name conflict in roles 'Test::Dog' and 'Test::Tree', the method 'bark' must be implemented or excluded by 'C'});
+is($exception->consumer->name, 'C', 'consumer');
+is((join ', ', sort $exception->roles), ('Test::Dog, Test::Tree'), 'roles');
+is((join ', ', sort $exception->methods), ('bark'), 'methods');
+
+done_testing;
+