Commit | Line | Data |
1fa27116 |
1 | use strict; |
2 | use warnings; |
3 | |
4 | use Test::More; |
5 | |
6 | eval "use Set::Scalar"; if($@) { |
7 | plan skip_all => 'Set::Scalar not installed'; |
8 | } |
9 | |
10 | |
11 | { |
12 | package Test::MooseX::Types::Parameterizable::Synopsis; |
13 | |
14 | use Moose; |
15 | use MooseX::Types::Parameterizable qw(Parameterizable); |
16 | use MooseX::Types::Moose qw(Str Int); |
17 | use MooseX::Types -declare=>[qw(Varchar)]; |
18 | |
3b297820 |
19 | ## Create a type constraint that is a string but parameterizes an integer |
20 | ## that is used as a maximum length constraint on that string, similar to |
21 | ## an SQL Varchar type. |
22 | |
1fa27116 |
23 | subtype Varchar, |
24 | as Parameterizable[Str,Int], |
25 | where { |
26 | my($string, $int) = @_; |
27 | $int >= length($string) ? 1:0; |
28 | }, |
29 | message { "'$_' is too long" }; |
30 | |
31 | my $varchar_five = Varchar[5]; |
32 | |
33 | Test::More::ok $varchar_five->check('four'); |
34 | Test::More::ok ! $varchar_five->check('verylongstrong'); |
35 | |
36 | my $varchar_ten = Varchar[10]; |
37 | |
38 | Test::More::ok $varchar_ten->check( 'X' x 9 ); |
39 | Test::More::ok ! $varchar_ten->check( 'X' x 12 ); |
40 | |
41 | has varchar_five => (isa=>Varchar[5], is=>'ro'); |
42 | has varchar_ten => (isa=>Varchar[10], is=>'ro'); |
43 | |
44 | my $object1 = __PACKAGE__->new( |
45 | varchar_five => '1234', |
46 | varchar_ten => '123456789', |
47 | ); |
48 | |
49 | eval { |
50 | my $object2 = __PACKAGE__->new( |
51 | varchar_five => '12345678', |
52 | varchar_ten => '123456789', |
53 | ); |
54 | }; |
55 | |
56 | Test::More::ok $@, 'There was an error'; |
57 | Test::More::like $@, qr('12345678' is too long), 'Correct custom error'; |
58 | } |
59 | |
60 | done_testing; |
61 | |
62 | |
63 | __END__ |
64 | |
65 | use MooseX::Types -declare=>[qw(Set UniqueInt PositiveSet PositiveUniqueInt )]; |
66 | |
67 | subtype Set, |
68 | as class_type("Set::Scalar"); |
69 | |
70 | subtype UniqueInt, |
71 | as Parameterizable[Int, Set], |
72 | where { |
73 | my ($int, $set) = @_; |
74 | !$set->has($int); |
75 | }; |
76 | |
77 | subtype PositiveSet, |
78 | as Set, |
79 | where { |
80 | my ($set) = @_; |
81 | ! grep { $_ < 0 } $set->members; |
82 | }; |
83 | |
84 | subtype PositiveUniqueInt, |
85 | as UniqueInt[PositiveSet]; |
86 | |
87 | my $set = Set::Scalar->new(-1,-2,1,2,3); |
88 | my $positive_set = Set::Scalar->new(1,2,3); |
89 | my $negative_set = Set::Scalar->new(-1,-2,-3); |
90 | |
91 | ok Set->check($set), |
92 | 'Is a Set'; |
93 | |
94 | ok Set->check($positive_set), |
95 | 'Is a Set'; |
96 | |
97 | ok Set->check($negative_set), |
98 | 'Is a Set'; |
99 | |
100 | ok !PositiveSet->check($set), |
101 | 'Is Not a Positive Set'; |
102 | |
103 | ok PositiveSet->check($positive_set), |
104 | 'Is a Positive Set'; |
105 | |
106 | ok !PositiveSet->check($negative_set), |
107 | 'Is Not a Positive Set'; |
108 | |
109 | ok UniqueInt([$set])->check(100), |
110 | '100 not in Set'; |
111 | |
112 | ok UniqueInt([$positive_set])->check(100), |
113 | '100 not in Set'; |
114 | |
115 | ok UniqueInt([$negative_set])->check(100), |
116 | '100 not in Set'; |
117 | |
118 | ok UniqueInt([$set])->check(-99), |
119 | '-99 not in Set'; |
120 | |
121 | ok UniqueInt([$positive_set])->check(-99), |
122 | '-99 not in Set'; |
123 | |
124 | ok UniqueInt([$negative_set])->check(-99), |
125 | '-99 not in Set'; |
126 | |
127 | ok !UniqueInt([$set])->check(2), |
128 | '2 in Set'; |
129 | |
130 | ok !UniqueInt([$positive_set])->check(2), |
131 | '2 in Set'; |
132 | |
133 | ok UniqueInt([$negative_set])->check(2), |
134 | '2 not in Set'; |
135 | |
136 | |
137 | __END__ |
138 | |
139 | ok UniqueInt([$set])->check(100); ## Okay, 100 isn't in (1,2,3) |
140 | ok UniqueInt([$set])->check(-99); ## Okay, -99 isn't in (1,2,3) |
141 | ok !UniqueInt([$set])->check(2); ## Not OK, 2 is in (1,2,3) |
142 | |
143 | ok PositiveUniqueInt([$set])->check(100); ## Okay, 100 isn't in (1,2,3) |
144 | ok !PositiveUniqueInt([$set])->check(-99); ## Not OK, -99 not Positive Int |
145 | ok !PositiveUniqueInt([$set])->check(2); ## Not OK, 2 is in (1,2,3) |
146 | |
147 | my $negative_set = Set::Scalar->new(-1,-2,-3); |
148 | |
149 | ok UniqueInt([$negative_set])->check(100); ## Throws exception |
150 | |