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