[gitmo/Moose.git] / t / 056_util_more_type_coercion.t

#!/usr/bin/perl

use strict;
use warnings;

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

BEGIN {
    use_ok('Moose');           
}

{
    package HTTPHeader;
    use strict;
    use warnings;
    use Moose;
    use Moose::Util::TypeConstraints;
    
    coerce 'HTTPHeader'
        => from ArrayRef 
            => via { HTTPHeader->new(array => $_[0]) }
        => from HashRef 
            => via { HTTPHeader->new(hash => $_[0]) };    
    
    has 'array' => (is => 'ro');
    has 'hash'  => (is => 'ro');    

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