Commit | Line | Data |
1fa27116 |
1 | use strict; |
2 | use warnings; |
3 | |
4 | use Test::More; |
5 | |
1fa27116 |
6 | { |
7 | package Test::MooseX::Types::Parameterizable::Synopsis; |
8 | |
9 | use Moose; |
10 | use MooseX::Types::Parameterizable qw(Parameterizable); |
2d8c1bf6 |
11 | use MooseX::Types::Moose qw(Str Int ArrayRef); |
1fa27116 |
12 | use MooseX::Types -declare=>[qw(Varchar)]; |
13 | |
14 | subtype Varchar, |
15 | as Parameterizable[Str,Int], |
16 | where { |
17 | my($string, $int) = @_; |
18 | $int >= length($string) ? 1:0; |
19 | }, |
20 | message { "'$_' is too long" }; |
21 | |
2d8c1bf6 |
22 | coerce Varchar, |
23 | from ArrayRef, |
24 | via { |
25 | my ($arrayref, $int) = @_; |
26 | join('', @$arrayref); |
27 | }; |
28 | |
1fa27116 |
29 | my $varchar_five = Varchar[5]; |
30 | |
31 | Test::More::ok $varchar_five->check('four'); |
32 | Test::More::ok ! $varchar_five->check('verylongstrong'); |
33 | |
34 | my $varchar_ten = Varchar[10]; |
35 | |
36 | Test::More::ok $varchar_ten->check( 'X' x 9 ); |
37 | Test::More::ok ! $varchar_ten->check( 'X' x 12 ); |
38 | |
94aff721 |
39 | has varchar_five => (isa=>Varchar[5], is=>'ro', coerce=>1); |
1fa27116 |
40 | has varchar_ten => (isa=>Varchar[10], is=>'ro'); |
41 | |
42 | my $object1 = __PACKAGE__->new( |
43 | varchar_five => '1234', |
44 | varchar_ten => '123456789', |
45 | ); |
46 | |
47 | eval { |
48 | my $object2 = __PACKAGE__->new( |
49 | varchar_five => '12345678', |
50 | varchar_ten => '123456789', |
51 | ); |
52 | }; |
53 | |
54 | Test::More::ok $@, 'There was an error'; |
55 | Test::More::like $@, qr('12345678' is too long), 'Correct custom error'; |
afdaaf52 |
56 | |
57 | my $object3 = __PACKAGE__->new( |
58 | varchar_five => [qw/aa bb/], |
59 | varchar_ten => '123456789', |
60 | ); |
61 | |
62 | Test::More::is $object3->varchar_five, 'aabb', |
63 | 'coercion as expected'; |
1fa27116 |
64 | } |
65 | |
c9ecd506 |
66 | { |
67 | package Test::MooseX::Types::Parameterizable::Description; |
68 | |
69 | use Moose; |
70 | use MooseX::Types::Parameterizable qw(Parameterizable); |
71 | use MooseX::Types::Moose qw(HashRef Int); |
72 | use MooseX::Types -declare=>[qw(Range RangedInt)]; |
73 | |
74 | ## Minor change from docs to avoid additional test dependencies |
75 | subtype Range, |
76 | as HashRef[Int], |
77 | where { |
78 | my ($range) = @_; |
79 | return $range->{max} > $range->{min}; |
80 | }, |
81 | message { "Not a Valid range [ $_->{max} not > $_->{min} ] " }; |
82 | |
83 | subtype RangedInt, |
84 | as Parameterizable[Int, Range], |
85 | where { |
86 | my ($value, $range) = @_; |
87 | return ($value >= $range->{min} && |
88 | $value <= $range->{max}); |
89 | }; |
90 | |
91 | Test::More::ok RangedInt([{min=>10,max=>100}])->check(50); |
92 | Test::More::ok !RangedInt([{min=>50, max=>75}])->check(99); |
93 | |
94 | eval { |
95 | Test::More::ok !RangedInt([{min=>99, max=>10}])->check(10); |
96 | }; |
97 | |
98 | Test::More::ok $@, 'There was an error'; |
99 | Test::More::like $@, qr(Not a Valid range), 'Correct custom error'; |
100 | |
101 | Test::More::ok RangedInt([min=>10,max=>100])->check(50); |
102 | Test::More::ok ! RangedInt([min=>50, max=>75])->check(99); |
103 | |
104 | eval { |
105 | RangedInt([min=>99, max=>10])->check(10); |
106 | }; |
107 | |
108 | Test::More::ok $@, 'There was an error'; |
109 | Test::More::like $@, qr(Not a Valid range), 'Correct custom error'; |
110 | |
111 | |
112 | } |
113 | |
80b1af4c |
114 | { |
115 | package Test::MooseX::Types::Parameterizable::Subtypes; |
116 | |
117 | use Moose; |
118 | use MooseX::Types::Parameterizable qw(Parameterizable); |
119 | use MooseX::Types::Moose qw(HashRef Int); |
120 | use MooseX::Types -declare=>[qw(Range RangedInt PositiveRangedInt |
121 | PositiveInt PositiveRange PositiveRangedInt2 )]; |
122 | |
123 | ## Minor change from docs to avoid additional test dependencies |
124 | subtype Range, |
125 | as HashRef[Int], |
126 | where { |
127 | my ($range) = @_; |
128 | return $range->{max} > $range->{min}; |
129 | }, |
130 | message { "Not a Valid range [ $_->{max} not > $_->{min} ] " }; |
131 | |
132 | subtype RangedInt, |
133 | as Parameterizable[Int, Range], |
134 | where { |
135 | my ($value, $range) = @_; |
136 | return ($value >= $range->{min} && |
137 | $value <= $range->{max}); |
138 | }; |
139 | |
140 | subtype PositiveRangedInt, |
141 | as RangedInt, |
142 | where { |
143 | shift >= 0; |
144 | }; |
145 | |
146 | Test::More::ok PositiveRangedInt([{min=>10,max=>100}])->check(50); |
147 | Test::More::ok !PositiveRangedInt([{min=>50, max=>75}])->check(99); |
148 | |
149 | eval { |
150 | Test::More::ok !PositiveRangedInt([{min=>99, max=>10}])->check(10); |
151 | }; |
152 | |
153 | Test::More::ok $@, 'There was an error'; |
154 | Test::More::like $@, qr(Not a Valid range), 'Correct custom error'; |
155 | |
156 | Test::More::ok PositiveRangedInt([min=>10,max=>100])->check(50); |
157 | Test::More::ok ! PositiveRangedInt([min=>50, max=>75])->check(99); |
158 | |
159 | eval { |
160 | PositiveRangedInt([min=>99, max=>10])->check(10); |
161 | }; |
162 | |
163 | Test::More::ok $@, 'There was an error'; |
164 | Test::More::like $@, qr(Not a Valid range), 'Correct custom error'; |
165 | |
166 | Test::More::ok !PositiveRangedInt([{min=>-10, max=>75}])->check(-5); |
167 | |
168 | ## Subtype of Int for positive numbers |
169 | subtype PositiveInt, |
170 | as Int, |
171 | where { |
172 | my ($value, $range) = @_; |
173 | return $value >= 0; |
174 | }; |
175 | |
176 | ## subtype Range to re-parameterize Range with subtypes. Minor change from |
177 | ## docs to reduce test dependencies |
178 | |
179 | subtype PositiveRange, |
180 | as Range[PositiveInt], |
181 | message { "[ $_->{max} not > $_->{min} ] is not a positive range " }; |
182 | |
183 | ## create subtype via reparameterizing |
184 | subtype PositiveRangedInt2, |
185 | as RangedInt[PositiveRange]; |
186 | |
187 | Test::More::ok PositiveRangedInt2([{min=>10,max=>100}])->check(50); |
188 | Test::More::ok !PositiveRangedInt2([{min=>50, max=>75}])->check(99); |
189 | |
190 | eval { |
191 | Test::More::ok !PositiveRangedInt2([{min=>99, max=>10}])->check(10); |
192 | }; |
193 | |
194 | Test::More::ok $@, 'There was an error'; |
195 | Test::More::like $@, qr(not a positive range), 'Correct custom error'; |
196 | |
197 | Test::More::ok !PositiveRangedInt2([{min=>10, max=>75}])->check(-5); |
198 | |
199 | ## See t/02-types-parameterizable-extended.t for remaining examples tests |
200 | } |
201 | |
52ed7d4d |
202 | { |
203 | package Test::MooseX::Types::Parameterizable::Coercions; |
c9ecd506 |
204 | |
52ed7d4d |
205 | use Moose; |
206 | use MooseX::Types::Parameterizable qw(Parameterizable); |
207 | use MooseX::Types::Moose qw(HashRef ArrayRef Object Str Int); |
208 | use MooseX::Types -declare=>[qw(Varchar MySpecialVarchar )]; |
1fa27116 |
209 | |
1fa27116 |
210 | |
52ed7d4d |
211 | subtype Varchar, |
212 | as Parameterizable[Str, Int], |
213 | where { |
214 | my($string, $int) = @_; |
215 | $int >= length($string) ? 1:0; |
216 | }, |
217 | message { "'$_' is too long" }; |
1fa27116 |
218 | |
1fa27116 |
219 | |
52ed7d4d |
220 | coerce Varchar, |
221 | from Object, |
222 | via { "$_"; }, ## stringify the object |
223 | from ArrayRef, |
224 | via { join '',@$_ }; ## convert array to string |
1fa27116 |
225 | |
52ed7d4d |
226 | subtype MySpecialVarchar, |
227 | as Varchar; |
1fa27116 |
228 | |
52ed7d4d |
229 | coerce MySpecialVarchar, |
230 | from HashRef, |
231 | via { join '', keys %$_ }; |
1fa27116 |
232 | |
1fa27116 |
233 | |
52ed7d4d |
234 | Test::More::is Varchar([40])->coerce("abc"), 'abc'; |
235 | Test::More::is Varchar([40])->coerce([qw/d e f/]), 'def'; |
1fa27116 |
236 | |
52ed7d4d |
237 | Test::More::is MySpecialVarchar([40])->coerce("abc"), 'abc'; |
238 | Test::More::is_deeply( MySpecialVarchar([40])->coerce([qw/d e f/]), [qw/d e f/]); |
239 | Test::More::is MySpecialVarchar([40])->coerce({a=>1, b=>2}), 'ab'; |
240 | } |
1fa27116 |
241 | |
7fcab9b4 |
242 | { |
243 | package Test::MooseX::Types::Parameterizable::Recursion; |
244 | |
245 | use Moose; |
246 | use MooseX::Types::Parameterizable qw(Parameterizable); |
247 | use MooseX::Types::Moose qw( ); |
248 | use MooseX::Types -declare=>[qw( )]; |
249 | |
250 | ## To be done when I can think of a use case |
251 | } |
252 | |
52ed7d4d |
253 | done_testing; |
1fa27116 |
254 | |