2 use Switch qw(Perl6 __ fallthrough);
4 my($C,$M);sub ok{$C++;$M.=$_[0]?"ok $C\n":"not ok $C (line ".(caller)[2].")\n"}
9 $when->{when} = { when => "when" };
15 eval { when 1 { ok(0) }; ok(0) } || ok(1);
21 when 1 { ok(0) } else { ok(1) }
22 when 2 { ok(0) } else { ok(1) }
23 when 3 { ok(1) } else { ok(0) }
28 eval { when __ <= 1 || __ > 2 { ok(0) } } || ok(1);
29 when __ <= 2 { ok(0) };
30 when __ <= 3 { ok(1) };
33 # POSSIBLE ARGS: NUMERIC, STRING, ARRAY, HASH, REGEX, CODE
41 when ($_) { ok(1) } else { ok(0) }
44 when 1 { ok ($_==1) } else { ok($_!=1) }
45 when (1) { ok ($_==1) } else { ok($_!=1) }
46 when 3 { ok ($_==3) } else { ok($_!=3) }
47 when (4) { ok (0) } else { ok(1) }
48 when (2) { ok ($_==2) } else { ok($_!=2) }
51 when ('a') { ok (0) } else { ok(1) }
52 when 'a' { ok (0) } else { ok(1) }
53 when ('3') { ok ($_ == 3) } else { ok($_ != 3) }
54 when ('3.0') { ok (0) } else { ok(1) }
57 when ([10,5,1]) { ok ($_==1) } else { ok($_!=1) }
58 when [10,5,1] { ok ($_==1) } else { ok($_!=1) }
59 when (['a','b']) { ok (0) } else { ok(1) }
60 when (['a','b',3]) { ok ($_==3) } else { ok ($_!=3) }
61 when (['a','b',2.0]) { ok ($_==2) } else { ok ($_!=2) }
62 when ([]) { ok (0) } else { ok(1) }
65 when ({}) { ok (0) } else { ok (1) }
66 when {} { ok (0) } else { ok (1) }
67 when {1,1} { ok ($_==1) } else { ok($_!=1) }
68 when ({1=>1, 2=>0}) { ok ($_==1) } else { ok($_!=1) }
71 when (sub {$_[0]==2}) { ok ($_==2) } else { ok($_!=2) }
72 when {$_[0]==2} { ok ($_==2) } else { ok($_!=2) }
73 when {0} { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH
74 when {1} { ok (1) } else { ok (0) } # ; -> SUB, NOT HASH
85 when ($_) { ok(1) } else { ok(0) }
88 when (1) { ok ($_ !~ /[a-c]/) } else { ok ($_ =~ /[a-c]/) }
89 when (1.0) { ok ($_ !~ /[a-c]/) } else { ok ($_ =~ /[a-c]/) }
92 when ('a') { ok ($_ eq 'a') } else { ok($_ ne 'a') }
93 when ('b') { ok ($_ eq 'b') } else { ok($_ ne 'b') }
94 when ('c') { ok ($_ eq 'c') } else { ok($_ ne 'c') }
95 when ('1') { ok ($_ eq '1') } else { ok($_ ne '1') }
96 when ('d') { ok (0) } else { ok (1) }
99 when (['a','1']) { ok ($_ eq 'a' || $_ eq '1') }
100 else { ok ($_ ne 'a' && $_ ne '1') }
101 when (['z','2']) { ok (0) } else { ok(1) }
102 when ([]) { ok (0) } else { ok(1) }
105 when ({}) { ok (0) } else { ok (1) }
106 when ({a=>'a', 1=>1, 2=>0}) { ok ($_ eq 'a' || $_ eq '1') }
107 else { ok ($_ ne 'a' && $_ ne '1') }
110 when (sub{$_[0] eq 'a' }) { ok ($_ eq 'a') }
111 else { ok($_ ne 'a') }
112 when {$_[0] eq 'a'} { ok ($_ eq 'a') } else { ok($_ ne 'a') }
113 when {0} { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH
114 when {1} { ok (1) } else { ok (0) } # ; -> SUB, NOT HASH
122 for ([],[1,'a'],[2,'b'])
130 when (1) { ok ($iteration==2) } else { ok ($iteration!=2) }
131 when (1.0) { ok ($iteration==2) } else { ok ($iteration!=2) }
134 when ('a') { ok ($iteration==2) } else { ok ($iteration!=2) }
135 when ('b') { ok ($iteration==3) } else { ok ($iteration!=3) }
136 when ('1') { ok ($iteration==2) } else { ok ($iteration!=2) }
139 when (['a',2]) { ok ($iteration>=2) } else { ok ($iteration<2) }
140 when ([1,'a']) { ok ($iteration==2) } else { ok($iteration!=2) }
141 when ([]) { ok (0) } else { ok(1) }
142 when ([7..100]) { ok (0) } else { ok(1) }
145 when ({}) { ok (0) } else { ok (1) }
146 when ({a=>'a', 1=>1, 2=>0}) { ok ($iteration==2) }
147 else { ok ($iteration!=2) }
150 when {scalar grep /a/, @_} { ok ($iteration==2) }
151 else { ok ($iteration!=2) }
152 when (sub {scalar grep /a/, @_ }) { ok ($iteration==2) }
153 else { ok ($iteration!=2) }
154 when {0} { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH
155 when {1} { ok (1) } else { ok (0) } # ; -> SUB, NOT HASH
169 when ($_) { ok(1) } else { ok(0) }
172 when (1) { ok (0) } else { ok (1) }
173 when (1.0) { ok (0) } else { ok (1) }
176 when ('a') { ok ($iteration==2) } else { ok ($iteration!=2) }
177 when ('b') { ok (0) } else { ok (1) }
178 when ('c') { ok (0) } else { ok (1) }
181 when (['a',2]) { ok ($iteration==2) }
182 else { ok ($iteration!=2) }
183 when (['b','a']) { ok ($iteration==2) }
184 else { ok ($iteration!=2) }
185 when (['b','c']) { ok (0) } else { ok (1) }
186 when ([]) { ok (0) } else { ok(1) }
187 when ([7..100]) { ok (0) } else { ok(1) }
190 when ({}) { ok (0) } else { ok (1) }
191 when ({a=>'a', 1=>1, 2=>0}) { ok (0) } else { ok (1) }
194 when {$_[0]{a}} { ok ($iteration==2) }
195 else { ok ($iteration!=2) }
196 when (sub {$_[0]{a}}) { ok ($iteration==2) }
197 else { ok ($iteration!=2) }
198 when {0} { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH
199 when {1} { ok (1) } else { ok (0) } # ; -> SUB, NOT HASH
208 sub { return 0 unless @_;
210 my $type = ref $data;
211 return $type eq 'HASH' && $data->{a}
212 || $type eq 'Regexp' && 'a' =~ /$data/
213 || $type eq "" && $data eq '1';
220 when ($_) { ok(1) } else { ok(0) }
223 when (1) { ok ($iteration<=2) } else { ok ($iteration>2) }
224 when (1.0) { ok ($iteration<=2) } else { ok ($iteration>2) }
225 when (1.1) { ok ($iteration==1) } else { ok ($iteration!=1) }
228 when ('a') { ok ($iteration==1) } else { ok ($iteration!=1) }
229 when ('b') { ok ($iteration==1) } else { ok ($iteration!=1) }
230 when ('c') { ok ($iteration==1) } else { ok ($iteration!=1) }
231 when ('1') { ok ($iteration<=2) } else { ok ($iteration>2) }
234 when ([1, 'a']) { ok ($iteration<=2) }
235 else { ok ($iteration>2) }
236 when (['b','a']) { ok ($iteration==1) }
237 else { ok ($iteration!=1) }
238 when (['b','c']) { ok ($iteration==1) }
239 else { ok ($iteration!=1) }
240 when ([]) { ok ($iteration==1) } else { ok($iteration!=1) }
241 when ([7..100]) { ok ($iteration==1) }
242 else { ok($iteration!=1) }
245 when ({}) { ok ($iteration==1) } else { ok ($iteration!=1) }
246 when ({a=>'a', 1=>1, 2=>0}) { ok ($iteration<=2) }
247 else { ok ($iteration>2) }
250 when {$_[0]->{a}} { ok (0) } else { ok (1) }
251 when (sub {$_[0]{a}}) { ok (0) } else { ok (1) }
252 when {0} { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH
253 when {1} { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH
265 when (1) { ok($count==1) }
266 else { ok($count!=1) }
267 when ([5,6]) { ok(0) } else { ok(1) }