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