1 #! /usr/local/bin/perl -w
4 use Switch qw(__ fallthrough);
6 my($C,$M);sub ok{$C++;$M.=$_[0]?"ok $C\n":"not ok $C (line ".(caller)[2].")\n"}
11 $case->{case} = { case => "case" };
17 eval { case 1 { ok(0) }; ok(0) } || ok(1);
23 case 1 { ok(0) } else { ok(1) }
24 case 2 { ok(0) } else { ok(1) }
25 case 3 { ok(1) } else { ok(0) }
30 eval { case __ <= 1 || __ > 2 { ok(0) } } || ok(1);
31 case __ <= 2 { ok(0) };
32 case __ <= 3 { ok(1) };
35 # POSSIBLE ARGS: NUMERIC, STRING, ARRAY, HASH, REGEX, CODE
43 case ($_) { ok(1) } else { ok(0) }
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) }
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) }
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) }
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) }
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
87 case ($_) { ok(1) } else { ok(0) }
90 case (1) { ok ($_ !~ /[a-c]/) } else { ok ($_ =~ /[a-c]/) }
91 case (1.0) { ok ($_ !~ /[a-c]/) } else { ok ($_ =~ /[a-c]/) }
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) }
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) }
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') }
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
124 for ([],[1,'a'],[2,'b'])
132 case (1) { ok ($iteration==2) } else { ok ($iteration!=2) }
133 case (1.0) { ok ($iteration==2) } else { ok ($iteration!=2) }
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) }
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) }
147 case ({}) { ok (0) } else { ok (1) }
148 case ({a=>'a', 1=>1, 2=>0}) { ok ($iteration==2) }
149 else { ok ($iteration!=2) }
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
171 case ($_) { ok(1) } else { ok(0) }
174 case (1) { ok (0) } else { ok (1) }
175 case (1.0) { ok (0) } else { ok (1) }
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) }
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) }
192 case ({}) { ok (0) } else { ok (1) }
193 case ({a=>'a', 1=>1, 2=>0}) { ok (0) } else { ok (1) }
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
210 sub { return 0 unless @_;
212 my $type = ref $data;
213 return $type eq 'HASH' && $data->{a}
214 || $type eq 'Regexp' && 'a' =~ /$data/
215 || $type eq "" && $data eq '1';
222 case ($_) { ok(1) } else { ok(0) }
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) }
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) }
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) }
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) }
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
264 switch ([9,"a",11]) {
267 case (1) { ok($count==1) }
268 else { ok($count!=1) }
269 case ([5,6]) { ok(0) } else { ok(1) }