[gitmo/Mouse.git] / t / 800_shikabased / 002-coerce_multi_class.t

use strict;
use warnings;
use Test::More tests => 8;

{
    package Response::Headers;
    use Mouse;
    has 'foo' => ( is => 'rw' );
}
{
    package Request::Headers;
    use Mouse;
    has 'foo' => ( is => 'rw' );
}

{
    package Response;
    use Mouse;
    use Mouse::TypeRegistry;

    subtype 'Headers' => sub { defined $_ && eval { $_->isa('Response::Headers') } };
    coerce 'Headers' => +{
        HashRef => sub {
            Response::Headers->new(%{ $_ });
        },
    };

    has headers => (
        is     => 'rw',
        isa    => 'Headers',
        coerce => 1,
    );
}

{
    package Request;
    use Mouse;
    use Mouse::TypeRegistry;

    subtype 'Headers' => sub { defined $_ && eval { $_->isa('Request::Headers') } };
    coerce 'Headers' => +{
        HashRef => sub {
            Request::Headers->new(%{ $_ });
        },
    };

    has headers => (
        is     => 'rw',
        isa    => 'Headers',
        coerce => 1,
    );
}

{
    package Response;
    subtype 'Headers' => sub { defined $_ && eval { $_->isa('Response::Headers') } };
    coerce 'Headers' => +{
        HashRef => sub {
            Response::Headers->new(%{ $_ });
        },
    };
}

my $req = Request->new(headers => { foo => 'bar' });
isa_ok($req->headers, 'Request::Headers');
is($req->headers->foo, 'bar');
$req->headers({foo => 'yay'});
isa_ok($req->headers, 'Request::Headers');
is($req->headers->foo, 'yay');

my $res = Response->new(headers => { foo => 'bar' });
isa_ok($res->headers, 'Response::Headers');
is($res->headers->foo, 'bar');
$res->headers({foo => 'yay'});
isa_ok($res->headers, 'Response::Headers');
is($res->headers->foo, 'yay');
Commit	Line	Data
f374ae86	1	use strict;
	2	use warnings;
	3	use Test::More tests => 8;
	4
	5	{
	6	package Response::Headers;
	7	use Mouse;
	8	has 'foo' => ( is => 'rw' );
	9	}
	10	{
	11	package Request::Headers;
	12	use Mouse;
	13	has 'foo' => ( is => 'rw' );
	14	}
	15
	16	{
	17	package Response;
	18	use Mouse;
	19	use Mouse::TypeRegistry;
	20
	21	subtype 'Headers' => sub { defined $_ && eval { $_->isa('Response::Headers') } };
	22	coerce 'Headers' => +{
	23	HashRef => sub {
	24	Response::Headers->new(%{ $_ });
	25	},
	26	};
	27
	28	has headers => (
	29	is => 'rw',
	30	isa => 'Headers',
	31	coerce => 1,
	32	);
	33	}
	34
	35	{
	36	package Request;
	37	use Mouse;
	38	use Mouse::TypeRegistry;
	39
	40	subtype 'Headers' => sub { defined $_ && eval { $_->isa('Request::Headers') } };
	41	coerce 'Headers' => +{
	42	HashRef => sub {
	43	Request::Headers->new(%{ $_ });
	44	},
	45	};
	46
	47	has headers => (
	48	is => 'rw',
	49	isa => 'Headers',
	50	coerce => 1,
	51	);
	52	}
	53
	54	{
	55	package Response;
	56	subtype 'Headers' => sub { defined $_ && eval { $_->isa('Response::Headers') } };
	57	coerce 'Headers' => +{
	58	HashRef => sub {
	59	Response::Headers->new(%{ $_ });
	60	},
	61	};
	62	}
	63
	64	my $req = Request->new(headers => { foo => 'bar' });
65	isa_ok($req->headers, 'Request::Headers');
66	is($req->headers->foo, 'bar');
67	$req->headers({foo => 'yay'});
68	isa_ok($req->headers, 'Request::Headers');
69	is($req->headers->foo, 'yay');
70
71	my $res = Response->new(headers => { foo => 'bar' });
72	isa_ok($res->headers, 'Response::Headers');
73	is($res->headers->foo, 'bar');
74	$res->headers({foo => 'yay'});
75	isa_ok($res->headers, 'Response::Headers');
76	is($res->headers->foo, 'yay');