Commit | Line | Data |
180899ed |
1 | #!/usr/bin/perl |
2 | use strict; |
3 | use warnings; |
4 | |
a28e50e4 |
5 | use Test::More; |
b10dde3a |
6 | use Test::Fatal; |
180899ed |
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); |
bce5d4a5 |
42 | duck_type 'SwanType' => [qw(honk)]; |
180899ed |
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 | |
bce5d4a5 |
57 | has other_swan => ( |
58 | isa => 'SwanType', |
59 | is => 'ro', |
60 | ); |
61 | |
180899ed |
62 | } |
63 | |
64 | # try giving it a duck |
b10dde3a |
65 | is( exception { DucktypeTest->new( duck => Duck->new ) }, undef, 'the Duck lives okay' ); |
180899ed |
66 | |
67 | # try giving it a swan which is like a duck, but not close enough |
b10dde3a |
68 | like( exception { DucktypeTest->new( duck => Swan->new ) }, qr/Swan is missing methods 'quack'/, "the Swan doesn't quack" ); |
180899ed |
69 | |
70 | # try giving it a rubber RubberDuckey |
b10dde3a |
71 | is( exception { DucktypeTest->new( swan => Swan->new ) }, undef, 'but a Swan can honk' ); |
180899ed |
72 | |
73 | # try giving it a rubber RubberDuckey |
b10dde3a |
74 | is( exception { DucktypeTest->new( duck => RubberDuck->new ) }, undef, 'the RubberDuck lives okay' ); |
180899ed |
75 | |
bce5d4a5 |
76 | # try with the other constraint form |
b10dde3a |
77 | is( exception { DucktypeTest->new( other_swan => Swan->new ) }, undef, 'but a Swan can honk' ); |
a28e50e4 |
78 | |
79 | done_testing; |