[gitmo/Mouse.git] / t / 040_type_constraints / 007_util_more_type_coercion.t

#!/usr/bin/perl

use strict;
use warnings;

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


{
    package HTTPHeader;
    use Mouse;
    use Mouse::Util::TypeConstraints;

    coerce 'HTTPHeader'
        => from ArrayRef
            => via { HTTPHeader->new(array => $_[0]) };

    coerce 'HTTPHeader'
        => from HashRef
            => via { HTTPHeader->new(hash => $_[0]) };

    has 'array' => (is => 'ro');
    has 'hash'  => (is => 'ro');

    package Engine;
    use strict;
    use warnings;
    use Mouse;

    has 'header' => (is => 'rw', isa => 'HTTPHeader', coerce => 1);
}

{
    my $engine = Engine->new();
    isa_ok($engine, 'Engine');

    # try with arrays

    lives_ok {
        $engine->header([ 1, 2, 3 ]);
    } '... type was coerced without incident';
    isa_ok($engine->header, 'HTTPHeader');

    is_deeply(
        $engine->header->array,
        [ 1, 2, 3 ],
        '... got the right array value of the header');
    ok(!defined($engine->header->hash), '... no hash value set');

    # try with hash

    lives_ok {
        $engine->header({ one => 1, two => 2, three => 3 });
    } '... type was coerced without incident';
    isa_ok($engine->header, 'HTTPHeader');

    is_deeply(
        $engine->header->hash,
        { one => 1, two => 2, three => 3 },
        '... got the right hash value of the header');
    ok(!defined($engine->header->array), '... no array value set');

    dies_ok {
       $engine->header("Foo");
    } '... dies with the wrong type, even after coercion';

    lives_ok {
       $engine->header(HTTPHeader->new);
    } '... lives with the right type, even after coercion';
}

{
    my $engine = Engine->new(header => [ 1, 2, 3 ]);
    isa_ok($engine, 'Engine');

    isa_ok($engine->header, 'HTTPHeader');

    is_deeply(
        $engine->header->array,
        [ 1, 2, 3 ],
        '... got the right array value of the header');
    ok(!defined($engine->header->hash), '... no hash value set');
}

{
    my $engine = Engine->new(header => { one => 1, two => 2, three => 3 });
    isa_ok($engine, 'Engine');

    isa_ok($engine->header, 'HTTPHeader');

    is_deeply(
        $engine->header->hash,
        { one => 1, two => 2, three => 3 },
        '... got the right hash value of the header');
    ok(!defined($engine->header->array), '... no array value set');
}

{
    my $engine = Engine->new(header => HTTPHeader->new());
    isa_ok($engine, 'Engine');

    isa_ok($engine->header, 'HTTPHeader');

    ok(!defined($engine->header->hash), '... no hash value set');
    ok(!defined($engine->header->array), '... no array value set');
}

dies_ok {
    Engine->new(header => 'Foo');
} '... dies correctly with bad params';

dies_ok {
    Engine->new(header => \(my $var));
} '... dies correctly with bad params';
Commit	Line	Data
b2b106d7	1	#!/usr/bin/perl
	2
	3	use strict;
	4	use warnings;
	5
	6	use Test::More tests => 25;
	7	use Test::Exception;
	8
	9
	10
	11	{
	12	package HTTPHeader;
	13	use Mouse;
	14	use Mouse::Util::TypeConstraints;
	15
	16	coerce 'HTTPHeader'
	17	=> from ArrayRef
	18	=> via { HTTPHeader->new(array => $_[0]) };
	19
	20	coerce 'HTTPHeader'
	21	=> from HashRef
	22	=> via { HTTPHeader->new(hash => $_[0]) };
	23
	24	has 'array' => (is => 'ro');
	25	has 'hash' => (is => 'ro');
	26
	27	package Engine;
	28	use strict;
	29	use warnings;
	30	use Mouse;
	31
	32	has 'header' => (is => 'rw', isa => 'HTTPHeader', coerce => 1);
	33	}
	34
	35	{
	36	my $engine = Engine->new();
	37	isa_ok($engine, 'Engine');
	38
	39	# try with arrays
	40
	41	lives_ok {
	42	$engine->header([ 1, 2, 3 ]);
	43	} '... type was coerced without incident';
	44	isa_ok($engine->header, 'HTTPHeader');
	45
	46	is_deeply(
	47	$engine->header->array,
	48	[ 1, 2, 3 ],
	49	'... got the right array value of the header');
	50	ok(!defined($engine->header->hash), '... no hash value set');
	51
	52	# try with hash
	53
	54	lives_ok {
	55	$engine->header({ one => 1, two => 2, three => 3 });
	56	} '... type was coerced without incident';
	57	isa_ok($engine->header, 'HTTPHeader');
	58
	59	is_deeply(
	60	$engine->header->hash,
	61	{ one => 1, two => 2, three => 3 },
	62	'... got the right hash value of the header');
	63	ok(!defined($engine->header->array), '... no array value set');
	64
65	dies_ok {
66	$engine->header("Foo");
67	} '... dies with the wrong type, even after coercion';
68
69	lives_ok {
70	$engine->header(HTTPHeader->new);
71	} '... lives with the right type, even after coercion';
72	}
73
74	{
75	my $engine = Engine->new(header => [ 1, 2, 3 ]);
76	isa_ok($engine, 'Engine');
77
78	isa_ok($engine->header, 'HTTPHeader');
79
80	is_deeply(
81	$engine->header->array,
82	[ 1, 2, 3 ],
83	'... got the right array value of the header');
84	ok(!defined($engine->header->hash), '... no hash value set');
85	}
86
87	{
88	my $engine = Engine->new(header => { one => 1, two => 2, three => 3 });
89	isa_ok($engine, 'Engine');
90
91	isa_ok($engine->header, 'HTTPHeader');
92
93	is_deeply(
94	$engine->header->hash,
95	{ one => 1, two => 2, three => 3 },
96	'... got the right hash value of the header');
97	ok(!defined($engine->header->array), '... no array value set');
98	}
99
100	{
101	my $engine = Engine->new(header => HTTPHeader->new());
102	isa_ok($engine, 'Engine');
103
104	isa_ok($engine->header, 'HTTPHeader');
105
106	ok(!defined($engine->header->hash), '... no hash value set');
107	ok(!defined($engine->header->array), '... no array value set');
108	}
109
110	dies_ok {
111	Engine->new(header => 'Foo');
112	} '... dies correctly with bad params';
113
114	dies_ok {
115	Engine->new(header => \(my $var));
116	} '... dies correctly with bad params';
117