From: gfx <gfuji@cpan.org>
Date: Wed, 9 Dec 2009 12:54:11 +0000 (+0900)
Subject: Add a test file for duck_type
X-Git-Tag: 0.44~1
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=commitdiff_plain;h=5d3ab42b8c257acdf05ce9ac602ec16a5923a879

Add a test file for duck_type
---

diff --git a/t/001_mouse/062-duck_type.t b/t/001_mouse/062-duck_type.t
new file mode 100644
index 0000000..d4a5396
--- /dev/null
+++ b/t/001_mouse/062-duck_type.t
@@ -0,0 +1,53 @@
+#!perl
+use strict;
+use warnings;
+
+use Test::More tests => 15;
+
+use Mouse::Util::TypeConstraints qw(duck_type);
+
+{
+    package Foo;
+    use Mouse;
+
+    sub a {}
+
+    package Bar;
+    use Mouse;
+
+    extends qw(Foo);
+
+    sub b {}
+
+    package Baz;
+    use Mouse;
+
+    sub can {
+        my($class, $method) = @_;
+        return $method eq 'b';
+    }
+}
+
+my $CanA   = duck_type CanA => qw(a);
+my $CanB  = duck_type CanB => [qw(b)];
+my $CanAB = duck_type [qw(a b)];
+
+is $CanA->name, 'CanA';
+is $CanB->name, 'CanB';
+is $CanAB->name, '__ANON__';
+
+ok $CanA->check(Foo->new);
+ok $CanA->check(Bar->new);
+ok!$CanA->check(Baz->new);
+
+ok!$CanB->check(Foo->new);
+ok $CanB->check(Bar->new);
+ok $CanB->check(Baz->new);
+
+ok!$CanAB->check(Foo->new);
+ok $CanAB->check(Bar->new);
+ok!$CanAB->check(Baz->new);
+
+ok!$CanA->check(undef);
+ok!$CanA->check(1);
+ok!$CanA->check({});