1 #! /usr/local/bin/perl -w
4 use Switch qw(Perl6 __ fallthrough);
6 my($C,$M);sub ok{$C++;$M.=$_[0]?"ok $C\n":"not ok $C (line ".(caller)[2].")\n"}
11 $when->{when} = { when => "when" };
17 eval { when 1: { ok(0) }; ok(0) } || ok(1);
23 when 1: { ok(0) } else { ok(1) }
24 when 2: { ok(0) } else { ok(1) }
25 when 3: { ok(1) } else { ok(0) }
30 eval { when __ <= 1 || __ > 2: { ok(0) } } || ok(1);
31 when __ <= 2: { ok(0) };
32 when __ <= 3: { ok(1) };
35 # POSSIBLE ARGS: NUMERIC, STRING, ARRAY, HASH, REGEX, CODE
43 when $_: { ok(1) } else { ok(0) }
46 when 1: { ok ($_==1) } else { ok($_!=1) }
47 when (1): { ok ($_==1) } else { ok($_!=1) }
48 when 3: { ok ($_==3) } else { ok($_!=3) }
49 when (4): { ok (0) } else { ok(1) }
50 when (2): { ok ($_==2) } else { ok($_!=2) }
53 when ('a'): { ok (0) } else { ok(1) }
54 when 'a' : { ok (0) } else { ok(1) }
55 when ('3'): { ok ($_ == 3) } else { ok($_ != 3) }
56 when ('3.0'): { ok (0) } else { ok(1) }
59 when ([10,5,1]): { ok ($_==1) } else { ok($_!=1) }
60 when [10,5,1]: { ok ($_==1) } else { ok($_!=1) }
61 when (['a','b']): { ok (0) } else { ok(1) }
62 when (['a','b',3]): { ok ($_==3) } else { ok ($_!=3) }
63 when (['a','b',2.0]) : { ok ($_==2) } else { ok ($_!=2) }
64 when ([]) : { ok (0) } else { ok(1) }
67 when ({}) : { ok (0) } else { ok (1) }
68 when {} : { ok (0) } else { ok (1) }
69 when {1,1} : { ok ($_==1) } else { ok($_!=1) }
70 when ({1=>1, 2=>0}) : { ok ($_==1) } else { ok($_!=1) }
73 when (sub {$_[0]==2}) : { ok ($_==2) } else { ok($_!=2) }
74 when {$_[0]==2} : { ok ($_==2) } else { ok($_!=2) }
75 when {0} : { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH
76 when {1} : { ok (1) } else { ok (0) } # ; -> SUB, NOT HASH
87 when ($_) : { ok(1) } else { ok(0) }
90 when (1) : { ok ($_ !~ /[a-c]/) } else { ok ($_ =~ /[a-c]/) }
91 when (1.0) : { ok ($_ !~ /[a-c]/) } else { ok ($_ =~ /[a-c]/) }
94 when ('a') : { ok ($_ eq 'a') } else { ok($_ ne 'a') }
95 when ('b') : { ok ($_ eq 'b') } else { ok($_ ne 'b') }
96 when ('c') : { ok ($_ eq 'c') } else { ok($_ ne 'c') }
97 when ('1') : { ok ($_ eq '1') } else { ok($_ ne '1') }
98 when ('d') : { ok (0) } else { ok (1) }
101 when (['a','1']) : { ok ($_ eq 'a' || $_ eq '1') }
102 else { ok ($_ ne 'a' && $_ ne '1') }
103 when (['z','2']) : { ok (0) } else { ok(1) }
104 when ([]) : { ok (0) } else { ok(1) }
107 when ({}) : { ok (0) } else { ok (1) }
108 when ({a=>'a', 1=>1, 2=>0}) : { ok ($_ eq 'a' || $_ eq '1') }
109 else { ok ($_ ne 'a' && $_ ne '1') }
112 when (sub{$_[0] eq 'a' }) : { ok ($_ eq 'a') }
113 else { ok($_ ne 'a') }
114 when {$_[0] eq 'a'} : { ok ($_ eq 'a') } else { ok($_ ne 'a') }
115 when {0} : { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH
116 when {1} : { ok (1) } else { ok (0) } # ; -> SUB, NOT HASH
124 for ([],[1,'a'],[2,'b'])
129 when ($_) : { ok(1) }
132 when (1) : { ok ($iteration==2) } else { ok ($iteration!=2) }
133 when (1.0) : { ok ($iteration==2) } else { ok ($iteration!=2) }
136 when ('a') : { ok ($iteration==2) } else { ok ($iteration!=2) }
137 when ('b') : { ok ($iteration==3) } else { ok ($iteration!=3) }
138 when ('1') : { ok ($iteration==2) } else { ok ($iteration!=2) }
141 when (['a',2]) : { ok ($iteration>=2) } else { ok ($iteration<2) }
142 when ([1,'a']) : { ok ($iteration==2) } else { ok($iteration!=2) }
143 when ([]) : { ok (0) } else { ok(1) }
144 when ([7..100]) : { ok (0) } else { ok(1) }
147 when ({}) : { ok (0) } else { ok (1) }
148 when ({a=>'a', 1=>1, 2=>0}) : { ok ($iteration==2) }
149 else { ok ($iteration!=2) }
152 when {scalar grep /a/, @_} : { ok ($iteration==2) }
153 else { ok ($iteration!=2) }
154 when (sub {scalar grep /a/, @_ }) : { ok ($iteration==2) }
155 else { ok ($iteration!=2) }
156 when {0} : { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH
157 when {1} : { ok (1) } else { ok (0) } # ; -> SUB, NOT HASH
171 when ($_) : { ok(1) } else { ok(0) }
174 when (1) : { ok (0) } else { ok (1) }
175 when (1.0) : { ok (0) } else { ok (1) }
178 when ('a') : { ok ($iteration==2) } else { ok ($iteration!=2) }
179 when ('b') : { ok (0) } else { ok (1) }
180 when ('c') : { ok (0) } else { ok (1) }
183 when (['a',2]) : { ok ($iteration==2) }
184 else { ok ($iteration!=2) }
185 when (['b','a']) : { ok ($iteration==2) }
186 else { ok ($iteration!=2) }
187 when (['b','c']) : { ok (0) } else { ok (1) }
188 when ([]) : { ok (0) } else { ok(1) }
189 when ([7..100]) : { ok (0) } else { ok(1) }
192 when ({}) : { ok (0) } else { ok (1) }
193 when ({a=>'a', 1=>1, 2=>0}) : { ok (0) } else { ok (1) }
196 when {$_[0]{a}} : { ok ($iteration==2) }
197 else { ok ($iteration!=2) }
198 when (sub {$_[0]{a}}) : { ok ($iteration==2) }
199 else { ok ($iteration!=2) }
200 when {0} : { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH
201 when {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 when ($_) : { ok(1) } else { ok(0) }
225 when (1) : { ok ($iteration<=2) } else { ok ($iteration>2) }
226 when (1.0) : { ok ($iteration<=2) } else { ok ($iteration>2) }
227 when (1.1) : { ok ($iteration==1) } else { ok ($iteration!=1) }
230 when ('a') : { ok ($iteration==1) } else { ok ($iteration!=1) }
231 when ('b') : { ok ($iteration==1) } else { ok ($iteration!=1) }
232 when ('c') : { ok ($iteration==1) } else { ok ($iteration!=1) }
233 when ('1') : { ok ($iteration<=2) } else { ok ($iteration>2) }
236 when ([1, 'a']) : { ok ($iteration<=2) }
237 else { ok ($iteration>2) }
238 when (['b','a']) : { ok ($iteration==1) }
239 else { ok ($iteration!=1) }
240 when (['b','c']) : { ok ($iteration==1) }
241 else { ok ($iteration!=1) }
242 when ([]) : { ok ($iteration==1) } else { ok($iteration!=1) }
243 when ([7..100]) : { ok ($iteration==1) }
244 else { ok($iteration!=1) }
247 when ({}) : { ok ($iteration==1) } else { ok ($iteration!=1) }
248 when ({a=>'a', 1=>1, 2=>0}) : { ok ($iteration<=2) }
249 else { ok ($iteration>2) }
252 when {$_[0]->{a}} : { ok (0) } else { ok (1) }
253 when (sub {$_[0]{a}}) : { ok (0) } else { ok (1) }
254 when {0} : { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH
255 when {1} : { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH
267 when (1) : { ok($count==1) }
268 else { ok($count!=1) }
269 when ([5,6]) : { ok(0) } else { ok(1) }