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