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