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 | |
114 | |
1fa27116 |
115 | done_testing; |
116 | |
117 | |
118 | __END__ |
119 | |
120 | use MooseX::Types -declare=>[qw(Set UniqueInt PositiveSet PositiveUniqueInt )]; |
121 | |
122 | subtype Set, |
123 | as class_type("Set::Scalar"); |
124 | |
125 | subtype UniqueInt, |
126 | as Parameterizable[Int, Set], |
127 | where { |
128 | my ($int, $set) = @_; |
129 | !$set->has($int); |
130 | }; |
131 | |
132 | subtype PositiveSet, |
133 | as Set, |
134 | where { |
135 | my ($set) = @_; |
136 | ! grep { $_ < 0 } $set->members; |
137 | }; |
138 | |
139 | subtype PositiveUniqueInt, |
140 | as UniqueInt[PositiveSet]; |
141 | |
142 | my $set = Set::Scalar->new(-1,-2,1,2,3); |
143 | my $positive_set = Set::Scalar->new(1,2,3); |
144 | my $negative_set = Set::Scalar->new(-1,-2,-3); |
145 | |
146 | ok Set->check($set), |
147 | 'Is a Set'; |
148 | |
149 | ok Set->check($positive_set), |
150 | 'Is a Set'; |
151 | |
152 | ok Set->check($negative_set), |
153 | 'Is a Set'; |
154 | |
155 | ok !PositiveSet->check($set), |
156 | 'Is Not a Positive Set'; |
157 | |
158 | ok PositiveSet->check($positive_set), |
159 | 'Is a Positive Set'; |
160 | |
161 | ok !PositiveSet->check($negative_set), |
162 | 'Is Not a Positive Set'; |
163 | |
164 | ok UniqueInt([$set])->check(100), |
165 | '100 not in Set'; |
166 | |
167 | ok UniqueInt([$positive_set])->check(100), |
168 | '100 not in Set'; |
169 | |
170 | ok UniqueInt([$negative_set])->check(100), |
171 | '100 not in Set'; |
172 | |
173 | ok UniqueInt([$set])->check(-99), |
174 | '-99 not in Set'; |
175 | |
176 | ok UniqueInt([$positive_set])->check(-99), |
177 | '-99 not in Set'; |
178 | |
179 | ok UniqueInt([$negative_set])->check(-99), |
180 | '-99 not in Set'; |
181 | |
182 | ok !UniqueInt([$set])->check(2), |
183 | '2 in Set'; |
184 | |
185 | ok !UniqueInt([$positive_set])->check(2), |
186 | '2 in Set'; |
187 | |
188 | ok UniqueInt([$negative_set])->check(2), |
189 | '2 not in Set'; |
190 | |
191 | |
192 | __END__ |
193 | |
194 | ok UniqueInt([$set])->check(100); ## Okay, 100 isn't in (1,2,3) |
195 | ok UniqueInt([$set])->check(-99); ## Okay, -99 isn't in (1,2,3) |
196 | ok !UniqueInt([$set])->check(2); ## Not OK, 2 is in (1,2,3) |
197 | |
198 | ok PositiveUniqueInt([$set])->check(100); ## Okay, 100 isn't in (1,2,3) |
199 | ok !PositiveUniqueInt([$set])->check(-99); ## Not OK, -99 not Positive Int |
200 | ok !PositiveUniqueInt([$set])->check(2); ## Not OK, 2 is in (1,2,3) |
201 | |
202 | my $negative_set = Set::Scalar->new(-1,-2,-3); |
203 | |
204 | ok UniqueInt([$negative_set])->check(100); ## Throws exception |
205 | |