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 | |
c9ecd506 |
202 | |
1fa27116 |
203 | done_testing; |
204 | |
205 | |
206 | __END__ |
207 | |
208 | use MooseX::Types -declare=>[qw(Set UniqueInt PositiveSet PositiveUniqueInt )]; |
209 | |
210 | subtype Set, |
211 | as class_type("Set::Scalar"); |
212 | |
213 | subtype UniqueInt, |
214 | as Parameterizable[Int, Set], |
215 | where { |
216 | my ($int, $set) = @_; |
217 | !$set->has($int); |
218 | }; |
219 | |
220 | subtype PositiveSet, |
221 | as Set, |
222 | where { |
223 | my ($set) = @_; |
224 | ! grep { $_ < 0 } $set->members; |
225 | }; |
226 | |
227 | subtype PositiveUniqueInt, |
228 | as UniqueInt[PositiveSet]; |
229 | |
230 | my $set = Set::Scalar->new(-1,-2,1,2,3); |
231 | my $positive_set = Set::Scalar->new(1,2,3); |
232 | my $negative_set = Set::Scalar->new(-1,-2,-3); |
233 | |
234 | ok Set->check($set), |
235 | 'Is a Set'; |
236 | |
237 | ok Set->check($positive_set), |
238 | 'Is a Set'; |
239 | |
240 | ok Set->check($negative_set), |
241 | 'Is a Set'; |
242 | |
243 | ok !PositiveSet->check($set), |
244 | 'Is Not a Positive Set'; |
245 | |
246 | ok PositiveSet->check($positive_set), |
247 | 'Is a Positive Set'; |
248 | |
249 | ok !PositiveSet->check($negative_set), |
250 | 'Is Not a Positive Set'; |
251 | |
252 | ok UniqueInt([$set])->check(100), |
253 | '100 not in Set'; |
254 | |
255 | ok UniqueInt([$positive_set])->check(100), |
256 | '100 not in Set'; |
257 | |
258 | ok UniqueInt([$negative_set])->check(100), |
259 | '100 not in Set'; |
260 | |
261 | ok UniqueInt([$set])->check(-99), |
262 | '-99 not in Set'; |
263 | |
264 | ok UniqueInt([$positive_set])->check(-99), |
265 | '-99 not in Set'; |
266 | |
267 | ok UniqueInt([$negative_set])->check(-99), |
268 | '-99 not in Set'; |
269 | |
270 | ok !UniqueInt([$set])->check(2), |
271 | '2 in Set'; |
272 | |
273 | ok !UniqueInt([$positive_set])->check(2), |
274 | '2 in Set'; |
275 | |
276 | ok UniqueInt([$negative_set])->check(2), |
277 | '2 not in Set'; |
278 | |
279 | |
280 | __END__ |
281 | |
282 | ok UniqueInt([$set])->check(100); ## Okay, 100 isn't in (1,2,3) |
283 | ok UniqueInt([$set])->check(-99); ## Okay, -99 isn't in (1,2,3) |
284 | ok !UniqueInt([$set])->check(2); ## Not OK, 2 is in (1,2,3) |
285 | |
286 | ok PositiveUniqueInt([$set])->check(100); ## Okay, 100 isn't in (1,2,3) |
287 | ok !PositiveUniqueInt([$set])->check(-99); ## Not OK, -99 not Positive Int |
288 | ok !PositiveUniqueInt([$set])->check(2); ## Not OK, 2 is in (1,2,3) |
289 | |
290 | my $negative_set = Set::Scalar->new(-1,-2,-3); |
291 | |
292 | ok UniqueInt([$negative_set])->check(100); ## Throws exception |
293 | |