Mouse::Util::does_role() respects $thing->does() method
[gitmo/Mouse.git] / t / 040_type_constraints / 034_duck_types.t
CommitLineData
5a592ad7 1#!/usr/bin/perl
2# This is automatically generated by author/import-moose-test.pl.
3# DO NOT EDIT THIS FILE. ANY CHANGES WILL BE LOST!!!
4use t::lib::MooseCompat;
5use strict;
6use warnings;
7
8use Test::More;
9use Test::Exception;
10
11{
12
13 package Duck;
14 use Mouse;
15
16 sub quack { }
17
18}
19
20{
21
22 package Swan;
23 use Mouse;
24
25 sub honk { }
26
27}
28
29{
30
31 package RubberDuck;
32 use Mouse;
33
34 sub quack { }
35
36}
37
38{
39
40 package DucktypeTest;
41 use Mouse;
42 use Mouse::Util::TypeConstraints;
43
44 duck_type 'DuckType' => qw(quack);
45 duck_type 'SwanType' => [qw(honk)];
46
47 has duck => (
48 isa => 'DuckType',
49 is => 'ro',
50 lazy_build => 1,
51 );
52
53 sub _build_duck { Duck->new }
54
55 has swan => (
56 isa => duck_type( [qw(honk)] ),
57 is => 'ro',
58 );
59
60 has other_swan => (
61 isa => 'SwanType',
62 is => 'ro',
63 );
64
65}
66
67# try giving it a duck
68lives_ok { DucktypeTest->new( duck => Duck->new ) } 'the Duck lives okay';
69
70# try giving it a swan which is like a duck, but not close enough
71throws_ok { DucktypeTest->new( duck => Swan->new ) }
72qr/Swan is missing methods 'quack'/,
73 "the Swan doesn't quack";
74
75# try giving it a rubber RubberDuckey
76lives_ok { DucktypeTest->new( swan => Swan->new ) } 'but a Swan can honk';
77
78# try giving it a rubber RubberDuckey
79lives_ok { DucktypeTest->new( duck => RubberDuck->new ) }
80'the RubberDuck lives okay';
81
82# try with the other constraint form
83lives_ok { DucktypeTest->new( other_swan => Swan->new ) } 'but a Swan can honk';
84
85done_testing;