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 | |