Commit | Line | Data |
b2b106d7 |
1 | #!/usr/bin/perl |
2 | use strict; |
3 | use warnings; |
4 | |
5 | use Test::More tests => 5; |
6 | use Test::Exception; |
7 | |
8 | { |
9 | |
10 | package Duck; |
11 | use Mouse; |
12 | |
13 | sub quack { } |
14 | |
15 | } |
16 | |
17 | { |
18 | |
19 | package Swan; |
20 | use Mouse; |
21 | |
22 | sub honk { } |
23 | |
24 | } |
25 | |
26 | { |
27 | |
28 | package RubberDuck; |
29 | use Mouse; |
30 | |
31 | sub quack { } |
32 | |
33 | } |
34 | |
35 | { |
36 | |
37 | package DucktypeTest; |
38 | use Mouse; |
39 | use Mouse::Util::TypeConstraints; |
40 | |
41 | duck_type 'DuckType' => qw(quack); |
42 | duck_type 'SwanType' => [qw(honk)]; |
43 | |
44 | has duck => ( |
45 | isa => 'DuckType', |
46 | is => 'ro', |
47 | lazy_build => 1, |
48 | ); |
49 | |
50 | sub _build_duck { Duck->new } |
51 | |
52 | has swan => ( |
53 | isa => duck_type( [qw(honk)] ), |
54 | is => 'ro', |
55 | ); |
56 | |
57 | has other_swan => ( |
58 | isa => 'SwanType', |
59 | is => 'ro', |
60 | ); |
61 | |
62 | } |
63 | |
64 | # try giving it a duck |
65 | lives_ok { DucktypeTest->new( duck => Duck->new ) } 'the Duck lives okay'; |
66 | |
67 | # try giving it a swan which is like a duck, but not close enough |
68 | throws_ok { DucktypeTest->new( duck => Swan->new ) } |
69 | qr/Swan is missing methods 'quack'/, |
70 | "the Swan doesn't quack"; |
71 | |
72 | # try giving it a rubber RubberDuckey |
73 | lives_ok { DucktypeTest->new( swan => Swan->new ) } 'but a Swan can honk'; |
74 | |
75 | # try giving it a rubber RubberDuckey |
76 | lives_ok { DucktypeTest->new( duck => RubberDuck->new ) } |
77 | 'the RubberDuck lives okay'; |
78 | |
79 | # try with the other constraint form |
80 | lives_ok { DucktypeTest->new( other_swan => Swan->new ) } 'but a Swan can honk'; |