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