Commit | Line | Data |
4b598ea3 |
1 | #!/usr/bin/perl |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
00867c44 |
6 | use Test::More tests => 26; |
4b598ea3 |
7 | use Test::Exception; |
8 | |
4b598ea3 |
9 | BEGIN { |
10 | use_ok('Moose'); |
11 | } |
12 | |
13 | { |
14 | package HTTPHeader; |
15 | use strict; |
16 | use warnings; |
17 | use Moose; |
18 | |
b509f553 |
19 | coerce 'HTTPHeader' |
d6e2d9a1 |
20 | => from ArrayRef |
21 | => via { HTTPHeader->new(array => $_[0]) } |
22 | => from HashRef |
23 | => via { HTTPHeader->new(hash => $_[0]) }; |
b509f553 |
24 | |
4b598ea3 |
25 | has 'array' => (is => 'ro'); |
26 | has 'hash' => (is => 'ro'); |
27 | |
28 | package Engine; |
29 | use strict; |
30 | use warnings; |
31 | use Moose; |
32 | |
4b598ea3 |
33 | has 'header' => (is => 'rw', isa => 'HTTPHeader', coerce => 1); |
34 | } |
35 | |
00867c44 |
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 | } |
4b598ea3 |
74 | |
00867c44 |
75 | { |
76 | my $engine = Engine->new(header => [ 1, 2, 3 ]); |
77 | isa_ok($engine, 'Engine'); |
4b598ea3 |
78 | |
00867c44 |
79 | isa_ok($engine->header, 'HTTPHeader'); |
4b598ea3 |
80 | |
00867c44 |
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 | } |
4b598ea3 |
87 | |
00867c44 |
88 | { |
89 | my $engine = Engine->new(header => { one => 1, two => 2, three => 3 }); |
90 | isa_ok($engine, 'Engine'); |
4b598ea3 |
91 | |
00867c44 |
92 | isa_ok($engine->header, 'HTTPHeader'); |
4b598ea3 |
93 | |
00867c44 |
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 | } |
4b598ea3 |
100 | |
00867c44 |
101 | { |
102 | my $engine = Engine->new(header => HTTPHeader->new()); |
103 | isa_ok($engine, 'Engine'); |
4b598ea3 |
104 | |
00867c44 |
105 | isa_ok($engine->header, 'HTTPHeader'); |
4b598ea3 |
106 | |
00867c44 |
107 | ok(!defined($engine->header->hash), '... no hash value set'); |
108 | ok(!defined($engine->header->array), '... no array value set'); |
109 | } |
4b598ea3 |
110 | |
00867c44 |
111 | dies_ok { |
112 | Engine->new(header => 'Foo'); |
113 | } '... dies correctly with bad params'; |
4b598ea3 |
114 | |
00867c44 |
115 | dies_ok { |
116 | Engine->new(header => \(my $var)); |
117 | } '... dies correctly with bad params'; |
4b598ea3 |
118 | |