Subtypes is one word
[gitmo/Moose.git] / t / 040_type_constraints / 005_util_type_coercion.t
CommitLineData
182134e8 1#!/usr/bin/perl
2
3use strict;
4use warnings;
5
e90c03d0 6use Test::More tests => 14;
182134e8 7use Test::Exception;
8
9BEGIN {
10 use_ok('Moose::Util::TypeConstraints');
11}
12
13{
14 package HTTPHeader;
182134e8 15 use Moose;
16
17 has 'array' => (is => 'ro');
18 has 'hash' => (is => 'ro');
19}
20
21subtype Header =>
22 => as Object
23 => where { $_->isa('HTTPHeader') };
24
25coerce Header
d6e2d9a1 26 => from ArrayRef
27 => via { HTTPHeader->new(array => $_[0]) }
28 => from HashRef
29 => via { HTTPHeader->new(hash => $_[0]) };
81dc201f 30
182134e8 31
d9b40005 32Moose::Util::TypeConstraints->export_type_constraints_as_functions();
182134e8 33
34my $header = HTTPHeader->new();
35isa_ok($header, 'HTTPHeader');
36
37ok(Header($header), '... this passed the type test');
38ok(!Header([]), '... this did not pass the type test');
39ok(!Header({}), '... this did not pass the type test');
40
7c13858b 41my $coercion = find_type_constraint('Header')->coercion;
a27aa600 42isa_ok($coercion, 'Moose::Meta::TypeCoercion');
182134e8 43
e90c03d0 44{
a27aa600 45 my $coerced = $coercion->coerce([ 1, 2, 3 ]);
e90c03d0 46 isa_ok($coerced, 'HTTPHeader');
47
48 is_deeply(
49 $coerced->array(),
50 [ 1, 2, 3 ],
51 '... got the right array');
52 is($coerced->hash(), undef, '... nothing assigned to the hash');
53}
54
55{
a27aa600 56 my $coerced = $coercion->coerce({ one => 1, two => 2, three => 3 });
e90c03d0 57 isa_ok($coerced, 'HTTPHeader');
58
59 is_deeply(
60 $coerced->hash(),
61 { one => 1, two => 2, three => 3 },
62 '... got the right hash');
63 is($coerced->array(), undef, '... nothing assigned to the array');
64}
65
66{
67 my $scalar_ref = \(my $var);
a27aa600 68 my $coerced = $coercion->coerce($scalar_ref);
e90c03d0 69 is($coerced, $scalar_ref, '... got back what we put in');
70}
71
72{
a27aa600 73 my $coerced = $coercion->coerce("Foo");
e90c03d0 74 is($coerced, "Foo", '... got back what we put in');
75}
76