#!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({});