[gitmo/Mouse.git] / t / 040_type_constraints / failing / 034_duck_types.t

#!/usr/bin/perl
use strict;
use warnings;

use Test::More tests => 5;
use Test::Exception;

{

    package Duck;
    use Mouse;

    sub quack { }

}

{

    package Swan;
    use Mouse;

    sub honk { }

}

{

    package RubberDuck;
    use Mouse;

    sub quack { }

}

{

    package DucktypeTest;
    use Mouse;
    use Mouse::Util::TypeConstraints;

    duck_type 'DuckType' => qw(quack);
    duck_type 'SwanType' => [qw(honk)];

    has duck => (
        isa        => 'DuckType',
        is => 'ro',
        lazy_build => 1,
    );

    sub _build_duck { Duck->new }

    has swan => (
        isa => duck_type( [qw(honk)] ),
        is => 'ro',
    );

    has other_swan => (
        isa => 'SwanType',
        is => 'ro',
    );

}

# try giving it a duck
lives_ok { DucktypeTest->new( duck => Duck->new ) } 'the Duck lives okay';

# try giving it a swan which is like a duck, but not close enough
throws_ok { DucktypeTest->new( duck => Swan->new ) }
qr/Swan is missing methods 'quack'/,
    "the Swan doesn't quack";

# try giving it a rubber RubberDuckey
lives_ok { DucktypeTest->new( swan => Swan->new ) } 'but a Swan can honk';

# try giving it a rubber RubberDuckey
lives_ok { DucktypeTest->new( duck => RubberDuck->new ) }
'the RubberDuck lives okay';

# try with the other constraint form
lives_ok { DucktypeTest->new( other_swan => Swan->new ) } 'but a Swan can honk';
Commit	Line	Data
b2b106d7	1	#!/usr/bin/perl
	2	use strict;
	3	use warnings;
	4
	5	use Test::More tests => 5;
	6	use Test::Exception;
	7
	8	{
	9
	10	package Duck;
	11	use Mouse;
	12
	13	sub quack { }
	14
	15	}
	16
	17	{
	18
	19	package Swan;
	20	use Mouse;
	21
	22	sub honk { }
	23
	24	}
	25
	26	{
	27
	28	package RubberDuck;
	29	use Mouse;
	30
	31	sub quack { }
	32
	33	}
	34
	35	{
	36
	37	package DucktypeTest;
	38	use Mouse;
	39	use Mouse::Util::TypeConstraints;
	40
	41	duck_type 'DuckType' => qw(quack);
	42	duck_type 'SwanType' => [qw(honk)];
	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
	57	has other_swan => (
	58	isa => 'SwanType',
	59	is => 'ro',
	60	);
	61
	62	}
	63
	64	# try giving it a duck
65	lives_ok { DucktypeTest->new( duck => Duck->new ) } 'the Duck lives okay';
66
67	# try giving it a swan which is like a duck, but not close enough
68	throws_ok { DucktypeTest->new( duck => Swan->new ) }
69	qr/Swan is missing methods 'quack'/,
70	"the Swan doesn't quack";
71
72	# try giving it a rubber RubberDuckey
73	lives_ok { DucktypeTest->new( swan => Swan->new ) } 'but a Swan can honk';
74
75	# try giving it a rubber RubberDuckey
76	lives_ok { DucktypeTest->new( duck => RubberDuck->new ) }
77	'the RubberDuck lives okay';
78
79	# try with the other constraint form
80	lives_ok { DucktypeTest->new( other_swan => Swan->new ) } 'but a Swan can honk';