Commit | Line | Data |
471c4f09 |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
a28e50e4 |
6 | use Test::More; |
53a4d826 |
7 | use Test::Exception; |
471c4f09 |
8 | |
7ff56534 |
9 | |
471c4f09 |
10 | { |
11 | package HTTPHeader; |
471c4f09 |
12 | use Moose; |
05d9eaf6 |
13 | use Moose::Util::TypeConstraints; |
d03bd989 |
14 | |
471c4f09 |
15 | coerce 'HTTPHeader' |
d03bd989 |
16 | => from ArrayRef |
41e007e4 |
17 | => via { HTTPHeader->new(array => $_[0]) }; |
d03bd989 |
18 | |
41e007e4 |
19 | coerce 'HTTPHeader' |
d03bd989 |
20 | => from HashRef |
21 | => via { HTTPHeader->new(hash => $_[0]) }; |
22 | |
471c4f09 |
23 | has 'array' => (is => 'ro'); |
d03bd989 |
24 | has 'hash' => (is => 'ro'); |
471c4f09 |
25 | |
26 | package Engine; |
27 | use strict; |
28 | use warnings; |
29 | use Moose; |
d03bd989 |
30 | |
31 | has 'header' => (is => 'rw', isa => 'HTTPHeader', coerce => 1); |
471c4f09 |
32 | } |
33 | |
34 | { |
35 | my $engine = Engine->new(); |
36 | isa_ok($engine, 'Engine'); |
37 | |
38 | # try with arrays |
39 | |
53a4d826 |
40 | lives_ok { |
471c4f09 |
41 | $engine->header([ 1, 2, 3 ]); |
53a4d826 |
42 | } '... type was coerced without incident'; |
471c4f09 |
43 | isa_ok($engine->header, 'HTTPHeader'); |
44 | |
45 | is_deeply( |
46 | $engine->header->array, |
47 | [ 1, 2, 3 ], |
48 | '... got the right array value of the header'); |
49 | ok(!defined($engine->header->hash), '... no hash value set'); |
50 | |
51 | # try with hash |
52 | |
53a4d826 |
53 | lives_ok { |
471c4f09 |
54 | $engine->header({ one => 1, two => 2, three => 3 }); |
53a4d826 |
55 | } '... type was coerced without incident'; |
471c4f09 |
56 | isa_ok($engine->header, 'HTTPHeader'); |
57 | |
58 | is_deeply( |
59 | $engine->header->hash, |
60 | { one => 1, two => 2, three => 3 }, |
61 | '... got the right hash value of the header'); |
62 | ok(!defined($engine->header->array), '... no array value set'); |
63 | |
53a4d826 |
64 | dies_ok { |
d03bd989 |
65 | $engine->header("Foo"); |
53a4d826 |
66 | } '... dies with the wrong type, even after coercion'; |
471c4f09 |
67 | |
53a4d826 |
68 | lives_ok { |
d03bd989 |
69 | $engine->header(HTTPHeader->new); |
53a4d826 |
70 | } '... lives with the right type, even after coercion'; |
471c4f09 |
71 | } |
72 | |
73 | { |
74 | my $engine = Engine->new(header => [ 1, 2, 3 ]); |
75 | isa_ok($engine, 'Engine'); |
76 | |
77 | isa_ok($engine->header, 'HTTPHeader'); |
78 | |
79 | is_deeply( |
80 | $engine->header->array, |
81 | [ 1, 2, 3 ], |
82 | '... got the right array value of the header'); |
83 | ok(!defined($engine->header->hash), '... no hash value set'); |
84 | } |
85 | |
86 | { |
87 | my $engine = Engine->new(header => { one => 1, two => 2, three => 3 }); |
88 | isa_ok($engine, 'Engine'); |
89 | |
90 | isa_ok($engine->header, 'HTTPHeader'); |
91 | |
92 | is_deeply( |
93 | $engine->header->hash, |
94 | { one => 1, two => 2, three => 3 }, |
95 | '... got the right hash value of the header'); |
96 | ok(!defined($engine->header->array), '... no array value set'); |
97 | } |
98 | |
99 | { |
100 | my $engine = Engine->new(header => HTTPHeader->new()); |
101 | isa_ok($engine, 'Engine'); |
102 | |
103 | isa_ok($engine->header, 'HTTPHeader'); |
104 | |
105 | ok(!defined($engine->header->hash), '... no hash value set'); |
106 | ok(!defined($engine->header->array), '... no array value set'); |
107 | } |
108 | |
53a4d826 |
109 | dies_ok { |
471c4f09 |
110 | Engine->new(header => 'Foo'); |
53a4d826 |
111 | } '... dies correctly with bad params'; |
471c4f09 |
112 | |
53a4d826 |
113 | dies_ok { |
471c4f09 |
114 | Engine->new(header => \(my $var)); |
53a4d826 |
115 | } '... dies correctly with bad params'; |
471c4f09 |
116 | |
bb6ac54a |
117 | { |
118 | my $tc = Moose::Util::TypeConstraints::find_type_constraint('HTTPHeader'); |
119 | isa_ok($tc, 'Moose::Meta::TypeConstraint', 'HTTPHeader TC'); |
120 | |
121 | my $from_aref = $tc->assert_coerce([ 1, 2, 3 ]); |
122 | isa_ok($from_aref, 'HTTPHeader', 'assert_coerce from aref to HTTPHeader'); |
123 | is_deeply($from_aref->array, [ 1, 2, 3 ], '...and has the right guts'); |
124 | |
125 | my $from_href = $tc->assert_coerce({ a => 1 }); |
126 | isa_ok($from_href, 'HTTPHeader', 'assert_coerce from href to HTTPHeader'); |
127 | is_deeply($from_href->hash, { a => 1 }, '...and has the right guts'); |
128 | |
53a4d826 |
129 | throws_ok { $tc->assert_coerce('total garbage') } |
bb6ac54a |
130 | qr/Validation failed for .HTTPHeader./, |
131 | "assert_coerce throws if result is not acceptable"; |
132 | } |
133 | |
a28e50e4 |
134 | done_testing; |