X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F040_type_constraints%2F034_duck_types.t;fp=t%2F040_type_constraints%2F034_duck_types.t;h=5eb1093a87839524defab246bed0ddbe34a277f8;hb=fde8e43f95fe996fbc2a778aa259feeb04552171;hp=0000000000000000000000000000000000000000;hpb=0bdc9d38dfd3de07aad929f6629f8fa65d434c27;p=gitmo%2FMouse.git

diff --git a/t/040_type_constraints/034_duck_types.t b/t/040_type_constraints/034_duck_types.t
new file mode 100644
index 0000000..5eb1093
--- /dev/null
+++ b/t/040_type_constraints/034_duck_types.t
@@ -0,0 +1,86 @@
+#!/usr/bin/perl
+# This is automatically generated by author/import-moose-test.pl.
+# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!!
+use t::lib::MooseCompat;
+use strict;
+use warnings;
+
+use Test::More;
+$TODO = q{Mouse is not yet completed};
+use Test::Exception;
+
+{
+
+    package Duck;
+    use Mouse;
+
+    sub quack { }
+
+}
+
+{
+
+    package Swan;
+    use Mouse;
+
+    sub honk { }
+
+}
+
+{
+
+    package RubberDuck;
+    use Mouse;
+
+    sub quack { }
+
+}
+
+{
+
+    package DucktypeTest;
+    use Mouse;
+    use Mouse::Util::TypeConstraints;
+
+    duck_type 'DuckType' => qw(quack);
+    duck_type 'SwanType' => [qw(honk)];
+
+    has duck => (
+        isa        => 'DuckType',
+        is => 'ro',
+        lazy_build => 1,
+    );
+
+    sub _build_duck { Duck->new }
+
+    has swan => (
+        isa => duck_type( [qw(honk)] ),
+        is => 'ro',
+    );
+
+    has other_swan => (
+        isa => 'SwanType',
+        is => 'ro',
+    );
+
+}
+
+# try giving it a duck
+lives_ok { DucktypeTest->new( duck => Duck->new ) } 'the Duck lives okay';
+
+# try giving it a swan which is like a duck, but not close enough
+throws_ok { DucktypeTest->new( duck => Swan->new ) }
+qr/Swan is missing methods 'quack'/,
+    "the Swan doesn't quack";
+
+# try giving it a rubber RubberDuckey
+lives_ok { DucktypeTest->new( swan => Swan->new ) } 'but a Swan can honk';
+
+# try giving it a rubber RubberDuckey
+lives_ok { DucktypeTest->new( duck => RubberDuck->new ) }
+'the RubberDuck lives okay';
+
+# try with the other constraint form
+lives_ok { DucktypeTest->new( other_swan => Swan->new ) } 'but a Swan can honk';
+
+done_testing;