Commit | Line | Data |
f374ae86 |
1 | use strict; |
2 | use warnings; |
7f408f4a |
3 | use Test::More tests => 13; |
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; |
3b46bd49 |
19 | use Mouse::Util::TypeConstraints; |
f374ae86 |
20 | |
3fa6f35d |
21 | type 'Headers' => where { defined $_ && eval { $_->isa('Response::Headers') } }; |
61a02a3a |
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; |
3b46bd49 |
37 | use Mouse::Util::TypeConstraints; |
61a02a3a |
38 | |
3fa6f35d |
39 | type 'Headers' => where { defined $_ && eval { $_->isa('Request::Headers') } }; |
61a02a3a |
40 | }; |
7dbebb1b |
41 | like $@, qr/The type constraint 'Headers' has already been created in Response and cannot be created again in Request/; |
61a02a3a |
42 | |
43 | eval { |
44 | package Request; |
3b46bd49 |
45 | use Mouse::Util::TypeConstraints; |
61a02a3a |
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; |
3b46bd49 |
57 | use Mouse::Util::TypeConstraints; |
61a02a3a |
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; |
3b46bd49 |
69 | use Mouse::Util::TypeConstraints; |
f374ae86 |
70 | |
da9a5e9d |
71 | coerce 'Int' => |
6c416942 |
72 | from 'XXX' => via { |
da9a5e9d |
73 | 1 |
f374ae86 |
74 | }, |
61a02a3a |
75 | ; |
76 | }; |
6c416942 |
77 | like $@, qr/Could not find the type constraint \(XXX\) to coerce from/; |
61a02a3a |
78 | |
79 | eval { |
80 | package Request; |
3b46bd49 |
81 | use Mouse::Util::TypeConstraints; |
61a02a3a |
82 | |
83 | coerce 'Headers' => |
84 | from 'ArrayRef' => via { |
85 | Request::Headers->new(%{ $_ }); |
86 | }, |
87 | ; |
88 | }; |
89 | ok !$@; |
90 | |
61a02a3a |
91 | { |
92 | package Request; |
93 | use Mouse; |
f374ae86 |
94 | |
95 | has headers => ( |
96 | is => 'rw', |
97 | isa => 'Headers', |
98 | coerce => 1, |
99 | ); |
100 | } |
101 | |
f374ae86 |
102 | my $req = Request->new(headers => { foo => 'bar' }); |
61a02a3a |
103 | isa_ok($req->headers, 'Response::Headers'); |
f374ae86 |
104 | is($req->headers->foo, 'bar'); |
105 | $req->headers({foo => 'yay'}); |
61a02a3a |
106 | isa_ok($req->headers, 'Response::Headers'); |
f374ae86 |
107 | is($req->headers->foo, 'yay'); |
108 | |
109 | my $res = Response->new(headers => { foo => 'bar' }); |
110 | isa_ok($res->headers, 'Response::Headers'); |
111 | is($res->headers->foo, 'bar'); |
112 | $res->headers({foo => 'yay'}); |
113 | isa_ok($res->headers, 'Response::Headers'); |
114 | is($res->headers->foo, 'yay'); |
7f408f4a |
115 | |