Commit | Line | Data |
3ed9f206 |
1 | BEGIN { |
2 | chdir 't' if -d 't'; |
3 | @INC = '../lib'; |
4 | } |
5 | |
6 | use Carp; |
7 | use Switch qw(__ fallthrough); |
8 | |
3961318e |
9 | my($C,$M);sub ok{$C++;$M.=$_[0]?"ok $C\n":"not ok $C (line ".(caller)[2].")\n"} |
10 | END{print"1..$C\n$M"} |
3ed9f206 |
11 | |
12 | # NON-case THINGS; |
13 | |
14 | $case->{case} = { case => "case" }; |
15 | |
16 | *case = \&case; |
17 | |
18 | # PREMATURE case |
19 | |
20 | eval { case 1 { ok(0) }; ok(0) } || ok(1); |
21 | |
22 | # H.O. FUNCS |
23 | |
24 | switch (__ > 2) { |
25 | |
26 | case 1 { ok(0) } else { ok(1) } |
27 | case 2 { ok(0) } else { ok(1) } |
28 | case 3 { ok(1) } else { ok(0) } |
29 | } |
30 | |
31 | switch (3) { |
32 | |
33 | eval { case __ <= 1 || __ > 2 { ok(0) } } || ok(1); |
34 | case __ <= 2 { ok(0) }; |
35 | case __ <= 3 { ok(1) }; |
36 | } |
37 | |
38 | # POSSIBLE ARGS: NUMERIC, STRING, ARRAY, HASH, REGEX, CODE |
39 | |
40 | # 1. NUMERIC SWITCH |
41 | |
42 | for (1..3) |
43 | { |
44 | switch ($_) { |
45 | # SELF |
46 | case ($_) { ok(1) } else { ok(0) } |
47 | |
48 | # NUMERIC |
49 | case (1) { ok ($_==1) } else { ok($_!=1) } |
50 | case 1 { ok ($_==1) } else { ok($_!=1) } |
51 | case (3) { ok ($_==3) } else { ok($_!=3) } |
52 | case (4) { ok (0) } else { ok(1) } |
53 | case (2) { ok ($_==2) } else { ok($_!=2) } |
54 | |
55 | # STRING |
56 | case ('a') { ok (0) } else { ok(1) } |
57 | case 'a' { ok (0) } else { ok(1) } |
58 | case ('3') { ok ($_ == 3) } else { ok($_ != 3) } |
59 | case ('3.0') { ok (0) } else { ok(1) } |
60 | |
61 | # ARRAY |
62 | case ([10,5,1]) { ok ($_==1) } else { ok($_!=1) } |
63 | case [10,5,1] { ok ($_==1) } else { ok($_!=1) } |
64 | case (['a','b']) { ok (0) } else { ok(1) } |
65 | case (['a','b',3]) { ok ($_==3) } else { ok ($_!=3) } |
66 | case (['a','b',2.0]) { ok ($_==2) } else { ok ($_!=2) } |
67 | case ([]) { ok (0) } else { ok(1) } |
68 | |
69 | # HASH |
70 | case ({}) { ok (0) } else { ok (1) } |
71 | case {} { ok (0) } else { ok (1) } |
72 | case {1,1} { ok ($_==1) } else { ok($_!=1) } |
73 | case ({1=>1, 2=>0}) { ok ($_==1) } else { ok($_!=1) } |
74 | |
75 | # SUB/BLOCK |
76 | case (sub {$_[0]==2}) { ok ($_==2) } else { ok($_!=2) } |
77 | case {$_[0]==2} { ok ($_==2) } else { ok($_!=2) } |
78 | case {0} { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH |
79 | case {1} { ok (1) } else { ok (0) } # ; -> SUB, NOT HASH |
80 | } |
81 | } |
82 | |
83 | |
84 | # 2. STRING SWITCH |
85 | |
86 | for ('a'..'c','1') |
87 | { |
88 | switch ($_) { |
89 | # SELF |
90 | case ($_) { ok(1) } else { ok(0) } |
91 | |
92 | # NUMERIC |
93 | case (1) { ok ($_ !~ /[a-c]/) } else { ok ($_ =~ /[a-c]/) } |
94 | case (1.0) { ok ($_ !~ /[a-c]/) } else { ok ($_ =~ /[a-c]/) } |
95 | |
96 | # STRING |
97 | case ('a') { ok ($_ eq 'a') } else { ok($_ ne 'a') } |
98 | case ('b') { ok ($_ eq 'b') } else { ok($_ ne 'b') } |
99 | case ('c') { ok ($_ eq 'c') } else { ok($_ ne 'c') } |
100 | case ('1') { ok ($_ eq '1') } else { ok($_ ne '1') } |
101 | case ('d') { ok (0) } else { ok (1) } |
102 | |
103 | # ARRAY |
104 | case (['a','1']) { ok ($_ eq 'a' || $_ eq '1') } |
105 | else { ok ($_ ne 'a' && $_ ne '1') } |
106 | case (['z','2']) { ok (0) } else { ok(1) } |
107 | case ([]) { ok (0) } else { ok(1) } |
108 | |
109 | # HASH |
110 | case ({}) { ok (0) } else { ok (1) } |
111 | case ({a=>'a', 1=>1, 2=>0}) { ok ($_ eq 'a' || $_ eq '1') } |
112 | else { ok ($_ ne 'a' && $_ ne '1') } |
113 | |
114 | # SUB/BLOCK |
115 | case (sub{$_[0] eq 'a' }) { ok ($_ eq 'a') } |
116 | else { ok($_ ne 'a') } |
117 | case {$_[0] eq 'a'} { ok ($_ eq 'a') } else { ok($_ ne 'a') } |
118 | case {0} { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH |
119 | case {1} { ok (1) } else { ok (0) } # ; -> SUB, NOT HASH |
120 | } |
121 | } |
122 | |
123 | |
124 | # 3. ARRAY SWITCH |
125 | |
126 | my $iteration = 0; |
127 | for ([],[1,'a'],[2,'b']) |
128 | { |
129 | switch ($_) { |
130 | $iteration++; |
131 | # SELF |
132 | case ($_) { ok(1) } |
133 | |
134 | # NUMERIC |
135 | case (1) { ok ($iteration==2) } else { ok ($iteration!=2) } |
136 | case (1.0) { ok ($iteration==2) } else { ok ($iteration!=2) } |
137 | |
138 | # STRING |
139 | case ('a') { ok ($iteration==2) } else { ok ($iteration!=2) } |
140 | case ('b') { ok ($iteration==3) } else { ok ($iteration!=3) } |
141 | case ('1') { ok ($iteration==2) } else { ok ($iteration!=2) } |
142 | |
143 | # ARRAY |
144 | case (['a',2]) { ok ($iteration>=2) } else { ok ($iteration<2) } |
145 | case ([1,'a']) { ok ($iteration==2) } else { ok($iteration!=2) } |
146 | case ([]) { ok (0) } else { ok(1) } |
147 | case ([7..100]) { ok (0) } else { ok(1) } |
148 | |
149 | # HASH |
150 | case ({}) { ok (0) } else { ok (1) } |
151 | case ({a=>'a', 1=>1, 2=>0}) { ok ($iteration==2) } |
152 | else { ok ($iteration!=2) } |
153 | |
154 | # SUB/BLOCK |
155 | case {scalar grep /a/, @_} { ok ($iteration==2) } |
156 | else { ok ($iteration!=2) } |
157 | case (sub {scalar grep /a/, @_ }) { ok ($iteration==2) } |
158 | else { ok ($iteration!=2) } |
159 | case {0} { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH |
160 | case {1} { ok (1) } else { ok (0) } # ; -> SUB, NOT HASH |
161 | } |
162 | } |
163 | |
164 | |
165 | # 4. HASH SWITCH |
166 | |
167 | $iteration = 0; |
168 | for ({},{a=>1,b=>0}) |
169 | { |
170 | switch ($_) { |
171 | $iteration++; |
172 | |
173 | # SELF |
174 | case ($_) { ok(1) } else { ok(0) } |
175 | |
176 | # NUMERIC |
177 | case (1) { ok (0) } else { ok (1) } |
178 | case (1.0) { ok (0) } else { ok (1) } |
179 | |
180 | # STRING |
181 | case ('a') { ok ($iteration==2) } else { ok ($iteration!=2) } |
182 | case ('b') { ok (0) } else { ok (1) } |
183 | case ('c') { ok (0) } else { ok (1) } |
184 | |
185 | # ARRAY |
186 | case (['a',2]) { ok ($iteration==2) } |
187 | else { ok ($iteration!=2) } |
188 | case (['b','a']) { ok ($iteration==2) } |
189 | else { ok ($iteration!=2) } |
190 | case (['b','c']) { ok (0) } else { ok (1) } |
191 | case ([]) { ok (0) } else { ok(1) } |
192 | case ([7..100]) { ok (0) } else { ok(1) } |
193 | |
194 | # HASH |
195 | case ({}) { ok (0) } else { ok (1) } |
196 | case ({a=>'a', 1=>1, 2=>0}) { ok (0) } else { ok (1) } |
197 | |
198 | # SUB/BLOCK |
199 | case {$_[0]{a}} { ok ($iteration==2) } |
200 | else { ok ($iteration!=2) } |
201 | case (sub {$_[0]{a}}) { ok ($iteration==2) } |
202 | else { ok ($iteration!=2) } |
203 | case {0} { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH |
204 | case {1} { ok (1) } else { ok (0) } # ; -> SUB, NOT HASH |
205 | } |
206 | } |
207 | |
208 | |
209 | # 5. CODE SWITCH |
210 | |
211 | $iteration = 0; |
212 | for ( sub {1}, |
213 | sub { return 0 unless @_; |
214 | my ($data) = @_; |
215 | my $type = ref $data; |
216 | return $type eq 'HASH' && $data->{a} |
217 | || $type eq 'Regexp' && 'a' =~ /$data/ |
218 | || $type eq "" && $data eq '1'; |
219 | }, |
220 | sub {0} ) |
221 | { |
222 | switch ($_) { |
223 | $iteration++; |
224 | # SELF |
225 | case ($_) { ok(1) } else { ok(0) } |
226 | |
227 | # NUMERIC |
228 | case (1) { ok ($iteration<=2) } else { ok ($iteration>2) } |
229 | case (1.0) { ok ($iteration<=2) } else { ok ($iteration>2) } |
230 | case (1.1) { ok ($iteration==1) } else { ok ($iteration!=1) } |
231 | |
232 | # STRING |
233 | case ('a') { ok ($iteration==1) } else { ok ($iteration!=1) } |
234 | case ('b') { ok ($iteration==1) } else { ok ($iteration!=1) } |
235 | case ('c') { ok ($iteration==1) } else { ok ($iteration!=1) } |
236 | case ('1') { ok ($iteration<=2) } else { ok ($iteration>2) } |
237 | |
238 | # ARRAY |
239 | case ([1, 'a']) { ok ($iteration<=2) } |
240 | else { ok ($iteration>2) } |
241 | case (['b','a']) { ok ($iteration==1) } |
242 | else { ok ($iteration!=1) } |
243 | case (['b','c']) { ok ($iteration==1) } |
244 | else { ok ($iteration!=1) } |
245 | case ([]) { ok ($iteration==1) } else { ok($iteration!=1) } |
246 | case ([7..100]) { ok ($iteration==1) } |
247 | else { ok($iteration!=1) } |
248 | |
249 | # HASH |
250 | case ({}) { ok ($iteration==1) } else { ok ($iteration!=1) } |
251 | case ({a=>'a', 1=>1, 2=>0}) { ok ($iteration<=2) } |
252 | else { ok ($iteration>2) } |
253 | |
254 | # SUB/BLOCK |
255 | case {$_[0]->{a}} { ok (0) } else { ok (1) } |
256 | case (sub {$_[0]{a}}) { ok (0) } else { ok (1) } |
257 | case {0} { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH |
258 | case {1} { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH |
259 | } |
260 | } |
261 | |
262 | |
263 | # NESTED SWITCHES |
264 | |
265 | for my $count (1..3) |
266 | { |
267 | switch ([9,"a",11]) { |
268 | case (qr/\d/) { |
269 | switch ($count) { |
270 | case (1) { ok($count==1) } |
271 | else { ok($count!=1) } |
272 | case ([5,6]) { ok(0) } else { ok(1) } |
273 | } |
274 | } |
275 | ok(1) case (11); |
276 | } |
277 | } |