Commit | Line | Data |
5d3ab42b |
1 | #!perl |
2 | use strict; |
3 | use warnings; |
4 | |
5 | use Test::More tests => 15; |
6 | |
7 | use Mouse::Util::TypeConstraints qw(duck_type); |
8 | |
9 | { |
10 | package Foo; |
11 | use Mouse; |
12 | |
13 | sub a {} |
14 | |
15 | package Bar; |
16 | use Mouse; |
17 | |
18 | extends qw(Foo); |
19 | |
20 | sub b {} |
21 | |
22 | package Baz; |
23 | use Mouse; |
24 | |
25 | sub can { |
26 | my($class, $method) = @_; |
27 | return $method eq 'b'; |
28 | } |
29 | } |
30 | |
31 | my $CanA = duck_type CanA => qw(a); |
32 | my $CanB = duck_type CanB => [qw(b)]; |
33 | my $CanAB = duck_type [qw(a b)]; |
34 | |
35 | is $CanA->name, 'CanA'; |
36 | is $CanB->name, 'CanB'; |
37 | is $CanAB->name, '__ANON__'; |
38 | |
39 | ok $CanA->check(Foo->new); |
40 | ok $CanA->check(Bar->new); |
41 | ok!$CanA->check(Baz->new); |
42 | |
43 | ok!$CanB->check(Foo->new); |
44 | ok $CanB->check(Bar->new); |
45 | ok $CanB->check(Baz->new); |
46 | |
47 | ok!$CanAB->check(Foo->new); |
48 | ok $CanAB->check(Bar->new); |
49 | ok!$CanAB->check(Baz->new); |
50 | |
51 | ok!$CanA->check(undef); |
52 | ok!$CanA->check(1); |
53 | ok!$CanA->check({}); |