Commit | Line | Data |
c9ecd506 |
1 | BEGIN { |
d1cfb043 |
2 | use strict; |
3 | use warnings; |
c9ecd506 |
4 | |
5 | use Test::More; |
6 | eval "use MooseX::Types::Structured qw(Tuple Dict slurpy)"; if($@) { |
d1cfb043 |
7 | plan skip_all => "MooseX::Types:Structured Required for advanced Tests"; |
8 | } else { |
9 | eval "use Set::Scalar"; if($@) { |
10 | plan skip_all => "Set::Scalar Required for advanced Tests"; |
11 | } else { |
12 | plan tests => 37; |
13 | } |
14 | } |
c9ecd506 |
15 | } |
54f0d8d6 |
16 | |
c9ecd506 |
17 | use MooseX::Types::Parameterizable qw(Parameterizable); |
18 | use MooseX::Types::Moose qw(Int Str); |
19 | use Moose::Util::TypeConstraints; |
20 | |
21 | use MooseX::Types -declare=>[qw( |
22 | Set UniqueInt UniqueInSet Range RangedInt PositiveRangedInt1 |
23 | PositiveRangedInt2 PositiveInt PositiveRange NameAge NameBetween18and35Age |
24 | )]; |
25 | |
26 | ok class_type("Set::Scalar"), 'Created Set::Scalar class_type'; |
27 | ok subtype( Set, as "Set::Scalar"), 'Created Set subtype'; |
28 | |
29 | ok subtype( UniqueInt, |
30 | as Parameterizable[Int, Set], |
31 | where { |
32 | my ($int, $set) = @_; |
33 | return !$set->has($int); |
34 | }), 'Created UniqueInt Parameterizable Type'; |
35 | |
36 | ok( (my $set_obj = Set::Scalar->new(1,2,3,4,5)), 'Create Set Object'); |
37 | |
38 | ok !UniqueInt([$set_obj])->check(1), "Not OK, since one isn't unique in $set_obj"; |
39 | ok !UniqueInt([$set_obj])->check('AAA'), "Not OK, since AAA is not an Int"; |
40 | ok UniqueInt([$set_obj])->check(100), "OK, since 100 isn't in the set"; |
41 | |
42 | ok( (my $unique = UniqueInt[$set_obj]), 'Created Anonymous typeconstraint'); |
43 | ok $unique->check(10), "OK, 10 is unique"; |
44 | ok !$unique->check(2), "Not OK, '2' is already in the set"; |
45 | |
46 | ok( subtype(UniqueInSet, as UniqueInt[$set_obj]), 'Created Subtype'); |
47 | ok UniqueInSet->check(99), '99 is unique'; |
48 | ok !UniqueInSet->check(3), 'Not OK, 3 is already in the set'; |
49 | |
50 | CHECKHARDEXCEPTION: { |
51 | eval { UniqueInt->check(1000) }; |
52 | like $@, |
53 | qr/Validation failed for 'main::Set' with value undef/, |
54 | 'Got Expected Error'; |
55 | |
56 | eval { UniqueInt->validate(1000) }; |
57 | like $@, |
58 | qr/Validation failed for 'main::Set' with value undef/, |
59 | 'Got Expected Error'; |
60 | } |
61 | |
62 | subtype Range, |
63 | as Dict[max=>Int, min=>Int], |
64 | where { |
65 | my ($range) = @_; |
66 | return $range->{max} > $range->{min}; |
67 | }; |
68 | |
69 | subtype RangedInt, |
70 | as Parameterizable[Int, Range], |
71 | where { |
72 | my ($value, $range) = @_; |
73 | return ($value >= $range->{min} && |
74 | $value <= $range->{max}); |
75 | }; |
d1cfb043 |
76 | |
c9ecd506 |
77 | ok RangedInt([{min=>10,max=>100}])->check(50), '50 in the range'; |
78 | ok !RangedInt([{min=>50, max=>75}])->check(99),'99 exceeds max'; |
79 | ok !RangedInt([{min=>50, max=>75}])->check('aa'), '"aa" not even an Int'; |
80 | |
81 | CHECKRANGEDINT: { |
82 | eval { |
83 | RangedInt([{min=>99, max=>10}])->check(10); ## Not OK, not a valid Range! |
84 | }; |
54f0d8d6 |
85 | |
c9ecd506 |
86 | like $@, |
87 | qr/Validation failed for 'main::Range'/, |
88 | 'Got Expected Error'; |
89 | } |
90 | |
91 | ok RangedInt([min=>10,max=>100])->check(50), '50 in the range'; |
92 | ok !RangedInt([min=>50, max=>75])->check(99),'99 exceeds max'; |
93 | ok !RangedInt([min=>50, max=>75])->check('aa'), '"aa" not even an Int'; |
94 | |
95 | CHECKRANGEDINT2: { |
96 | eval { |
97 | RangedInt([min=>99, max=>10])->check(10); ## Not OK, not a valid Range! |
98 | }; |
d1cfb043 |
99 | |
c9ecd506 |
100 | like $@, |
101 | qr/Validation failed for 'main::Range'/, |
102 | 'Got Expected Error'; |
103 | } |
104 | |
105 | subtype PositiveRangedInt1, |
106 | as RangedInt, |
107 | where { |
108 | shift >= 0; |
109 | }; |
110 | |
111 | ok PositiveRangedInt1([min=>10,max=>100])->check(50), '50 in the range'; |
112 | ok !PositiveRangedInt1([min=>50, max=>75])->check(99),'99 exceeds max'; |
113 | ok !PositiveRangedInt1([min=>50, max=>75])->check('aa'), '"aa" not even an Int'; |
114 | |
115 | CHECKRANGEDINT2: { |
116 | eval { |
117 | PositiveRangedInt1([min=>99, max=>10])->check(10); ## Not OK, not a valid Range! |
118 | }; |
d1cfb043 |
119 | |
c9ecd506 |
120 | like $@, |
121 | qr/Validation failed for 'main::Range'/, |
122 | 'Got Expected Error'; |
123 | } |
54f0d8d6 |
124 | |
c9ecd506 |
125 | ok !PositiveRangedInt1([min=>-100,max=>100])->check(-10), '-10 is not positive'; |
54f0d8d6 |
126 | |
c9ecd506 |
127 | subtype PositiveInt, |
128 | as Int, |
129 | where { |
130 | my ($value, $range) = @_; |
131 | return $value >= 0; |
132 | }; |
54f0d8d6 |
133 | |
c9ecd506 |
134 | ## subtype Range to re-parameterize Range with subtypes |
135 | subtype PositiveRange, |
136 | as Range[max=>PositiveInt, min=>PositiveInt]; |
54f0d8d6 |
137 | |
c9ecd506 |
138 | ## create subtype via reparameterizing |
139 | subtype PositiveRangedInt2, |
140 | as RangedInt[PositiveRange]; |
54f0d8d6 |
141 | |
c9ecd506 |
142 | ok PositiveRangedInt2([min=>10,max=>100])->check(50), '50 in the range'; |
143 | ok !PositiveRangedInt2([min=>50, max=>75])->check(99),'99 exceeds max'; |
144 | ok !PositiveRangedInt2([min=>50, max=>75])->check('aa'), '"aa" not even an Int'; |
54f0d8d6 |
145 | |
c9ecd506 |
146 | CHECKRANGEDINT2: { |
147 | eval { |
148 | PositiveRangedInt2([min=>-100,max=>100])->check(-10); ## Not OK, not a valid Range! |
149 | }; |
d1cfb043 |
150 | |
c9ecd506 |
151 | like $@, |
152 | qr/Validation failed for 'main::PositiveRange'/, |
153 | 'Got Expected Error'; |
88f7dcd2 |
154 | } |
c9ecd506 |
155 | |
156 | subtype NameAge, |
157 | as Tuple[Str, Int]; |
158 | |
159 | ok NameAge->check(['John',28]), 'Good NameAge'; |
160 | ok !NameAge->check(['John','Napiorkowski']), 'Bad NameAge'; |
161 | |
162 | subtype NameBetween18and35Age, |
163 | as NameAge[ |
164 | Str, |
165 | PositiveRangedInt2[min=>18,max=>35], |
166 | ]; |
167 | |
168 | ok NameBetween18and35Age->check(['John',28]), 'Good NameBetween18and35Age'; |
169 | ok !NameBetween18and35Age->check(['John','Napiorkowski']), 'Bad NameBetween18and35Age'; |
170 | ok !NameBetween18and35Age->check(['John',99]), 'Bad NameBetween18and35Age'; |
171 | |