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

diff --git a/Changes b/Changes
index 54eb148..b6733d8 100644 (file)
--- 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 (file)
--- 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 (file)
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']);
+