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