Commit | Line | Data |
f374ae86 |
1 | use strict; |
2 | use warnings; |
61a02a3a |
3 | use Test::More tests => 14; |
f374ae86 |
4 | |
5 | { |
6 | package Response::Headers; |
7 | use Mouse; |
8 | has 'foo' => ( is => 'rw' ); |
9 | } |
10 | { |
11 | package Request::Headers; |
12 | use Mouse; |
13 | has 'foo' => ( is => 'rw' ); |
14 | } |
15 | |
16 | { |
17 | package Response; |
18 | use Mouse; |
19 | use Mouse::TypeRegistry; |
20 | |
61a02a3a |
21 | subtype 'Headers' => where { defined $_ && eval { $_->isa('Response::Headers') } }; |
22 | coerce 'Headers' => |
23 | from 'HashRef' => via { |
f374ae86 |
24 | Response::Headers->new(%{ $_ }); |
25 | }, |
61a02a3a |
26 | ; |
f374ae86 |
27 | |
28 | has headers => ( |
29 | is => 'rw', |
30 | isa => 'Headers', |
31 | coerce => 1, |
32 | ); |
33 | } |
34 | |
61a02a3a |
35 | eval { |
36 | package Request; |
37 | use Mouse::TypeRegistry; |
38 | |
39 | subtype 'Headers' => where { defined $_ && eval { $_->isa('Request::Headers') } }; |
40 | }; |
41 | like $@, qr/The type constraint 'Headers' has already been created, cannot be created again in Request/; |
42 | |
43 | eval { |
44 | package Request; |
45 | use Mouse::TypeRegistry; |
46 | |
47 | coerce 'TooBad' => |
48 | from 'HashRef' => via { |
49 | Request::Headers->new(%{ $_ }); |
50 | }, |
51 | ; |
52 | }; |
53 | like $@, qr/Cannot find type 'TooBad', perhaps you forgot to load it./; |
54 | |
55 | eval { |
56 | package Request; |
57 | use Mouse::TypeRegistry; |
58 | |
59 | coerce 'Headers' => |
60 | from 'HashRef' => via { |
61 | Request::Headers->new(%{ $_ }); |
62 | }, |
63 | ; |
64 | }; |
65 | like $@, qr/A coercion action already exists for 'HashRef'/; |
66 | |
67 | eval { |
f374ae86 |
68 | package Request; |
f374ae86 |
69 | use Mouse::TypeRegistry; |
70 | |
61a02a3a |
71 | coerce 'Headers' => |
72 | from 'HashRefa' => via { |
f374ae86 |
73 | Request::Headers->new(%{ $_ }); |
74 | }, |
61a02a3a |
75 | ; |
76 | }; |
77 | like $@, qr/Could not find the type constraint \(HashRefa\) to coerce from/; |
78 | |
79 | eval { |
80 | package Request; |
81 | use Mouse::TypeRegistry; |
82 | |
83 | coerce 'Headers' => |
84 | from 'ArrayRef' => via { |
85 | Request::Headers->new(%{ $_ }); |
86 | }, |
87 | ; |
88 | }; |
89 | ok !$@; |
90 | |
91 | eval { |
92 | package Response; |
93 | subtype 'Headers' => where { defined $_ && eval { $_->isa('Response::Headers') } }; |
94 | }; |
95 | like $@, qr/The type constraint 'Headers' has already been created, cannot be created again in Response/; |
96 | |
97 | { |
98 | package Request; |
99 | use Mouse; |
f374ae86 |
100 | |
101 | has headers => ( |
102 | is => 'rw', |
103 | isa => 'Headers', |
104 | coerce => 1, |
105 | ); |
106 | } |
107 | |
f374ae86 |
108 | |
109 | my $req = Request->new(headers => { foo => 'bar' }); |
61a02a3a |
110 | isa_ok($req->headers, 'Response::Headers'); |
f374ae86 |
111 | is($req->headers->foo, 'bar'); |
112 | $req->headers({foo => 'yay'}); |
61a02a3a |
113 | isa_ok($req->headers, 'Response::Headers'); |
f374ae86 |
114 | is($req->headers->foo, 'yay'); |
115 | |
116 | my $res = Response->new(headers => { foo => 'bar' }); |
117 | isa_ok($res->headers, 'Response::Headers'); |
118 | is($res->headers->foo, 'bar'); |
119 | $res->headers({foo => 'yay'}); |
120 | isa_ok($res->headers, 'Response::Headers'); |
121 | is($res->headers->foo, 'yay'); |