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