From: Shawn M Moore <sartak@gmail.com>
Date: Thu, 25 Jun 2009 06:47:55 +0000 (-0400)
Subject: Allow Moose::Meta::TypeConstraint::DuckType in handles, since it is just a list of... 
X-Git-Tag: 0.84~28
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=6cbf4a2359409fde77b74b2c131764611e6ea5ed;p=gitmo%2FMoose.git

Allow Moose::Meta::TypeConstraint::DuckType in handles, since it is just a list of methods
---

diff --git a/Changes b/Changes
index 54eb148..b6733d8 100644
--- a/Changes
+++ b/Changes
@@ -13,6 +13,10 @@ for, noteworthy changes.
       - Reify duck type from a regular subtype into an actual class
         (Sartak)
 
+    * Moose::Meta::Attribute
+      - Allow Moose::Meta::TypeConstraint::DuckType in handles, since
+        it is just a list of methods (Sartak)
+
 0.83 Tue, Jun 23, 2009
     * Moose::Meta::Class
       - Fix _construct_instance not setting the special __MOP__ object
diff --git a/lib/Moose/Meta/Attribute.pm b/lib/Moose/Meta/Attribute.pm
index 01cf157..81bdb2c 100644
--- a/lib/Moose/Meta/Attribute.pm
+++ b/lib/Moose/Meta/Attribute.pm
@@ -628,6 +628,9 @@ sub _canonicalize_handles {
         elsif ($handle_type eq 'CODE') {
             return $handles->($self, $self->_find_delegate_metaclass);
         }
+        elsif (blessed($handles) && $handles->isa('Moose::Meta::TypeConstraint::DuckType')) {
+            return map { $_ => $_ } @{ $handles->methods };
+        }
         else {
             $self->throw_error("Unable to canonicalize the 'handles' option with $handles", data => $handles);
         }
diff --git a/t/040_type_constraints/035_duck_type_handles.t b/t/040_type_constraints/035_duck_type_handles.t
new file mode 100644
index 0000000..8ac0cc1
--- /dev/null
+++ b/t/040_type_constraints/035_duck_type_handles.t
@@ -0,0 +1,46 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+
+use Test::More tests => 2;
+use Test::Exception;
+
+my @phonograph;
+{
+    package Duck;
+    use Moose;
+
+    sub walk {
+        push @phonograph, 'footsteps',
+    }
+
+    sub quack {
+        push @phonograph, 'quack';
+    }
+
+    package Swan;
+    use Moose;
+
+    sub honk {
+        push @phonograph, 'honk';
+    }
+
+    package DucktypeTest;
+    use Moose;
+    use Moose::Util::TypeConstraints;
+
+    my $ducktype = duck_type 'DuckType' => qw(walk quack);
+
+    has duck => (
+        isa     => $ducktype,
+        handles => $ducktype,
+    );
+}
+
+my $t = DucktypeTest->new(duck => Duck->new);
+$t->quack;
+is_deeply([splice @phonograph], ['quack']);
+
+$t->walk;
+is_deeply([splice @phonograph], ['footsteps']);
+