Commit | Line | Data |
74a6a946 |
1 | #! /usr/local/bin/perl -w |
2 | |
3 | use Carp; |
4 | use Switch qw(Perl6 __ fallthrough); |
5 | |
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"} |
8 | |
9 | # NON-when THINGS; |
10 | |
11 | $when->{when} = { when => "when" }; |
12 | |
13 | *when = \&when; |
14 | |
15 | # PREMATURE when |
16 | |
17 | eval { when 1: { ok(0) }; ok(0) } || ok(1); |
18 | |
19 | # H.O. FUNCS |
20 | |
21 | given (__ > 2) { |
22 | |
23 | when 1: { ok(0) } else { ok(1) } |
24 | when 2: { ok(0) } else { ok(1) } |
25 | when 3: { ok(1) } else { ok(0) } |
26 | } |
27 | |
28 | given (3) { |
29 | |
30 | eval { when __ <= 1 || __ > 2: { ok(0) } } || ok(1); |
31 | when __ <= 2: { ok(0) }; |
32 | when __ <= 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 | given ($_) { |
42 | # SELF |
43 | when $_: { ok(1) } else { ok(0) } |
44 | |
45 | # NUMERIC |
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) } |
51 | |
52 | # STRING |
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) } |
57 | |
58 | # ARRAY |
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) } |
65 | |
66 | # HASH |
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) } |
71 | |
72 | # SUB/BLOCK |
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 |
77 | } |
78 | } |
79 | |
80 | |
81 | # 2. STRING SWITCH |
82 | |
83 | for ('a'..'c','1') |
84 | { |
85 | given ($_) { |
86 | # SELF |
87 | when ($_) : { ok(1) } else { ok(0) } |
88 | |
89 | # NUMERIC |
90 | when (1) : { ok ($_ !~ /[a-c]/) } else { ok ($_ =~ /[a-c]/) } |
91 | when (1.0) : { ok ($_ !~ /[a-c]/) } else { ok ($_ =~ /[a-c]/) } |
92 | |
93 | # STRING |
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) } |
99 | |
100 | # ARRAY |
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) } |
105 | |
106 | # HASH |
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') } |
110 | |
111 | # SUB/BLOCK |
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 |
117 | } |
118 | } |
119 | |
120 | |
121 | # 3. ARRAY SWITCH |
122 | |
123 | my $iteration = 0; |
124 | for ([],[1,'a'],[2,'b']) |
125 | { |
126 | given ($_) { |
127 | $iteration++; |
128 | # SELF |
129 | when ($_) : { ok(1) } |
130 | |
131 | # NUMERIC |
132 | when (1) : { ok ($iteration==2) } else { ok ($iteration!=2) } |
133 | when (1.0) : { ok ($iteration==2) } else { ok ($iteration!=2) } |
134 | |
135 | # STRING |
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) } |
139 | |
140 | # ARRAY |
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) } |
145 | |
146 | # HASH |
147 | when ({}) : { ok (0) } else { ok (1) } |
148 | when ({a=>'a', 1=>1, 2=>0}) : { ok ($iteration==2) } |
149 | else { ok ($iteration!=2) } |
150 | |
151 | # SUB/BLOCK |
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 |
158 | } |
159 | } |
160 | |
161 | |
162 | # 4. HASH SWITCH |
163 | |
164 | $iteration = 0; |
165 | for ({},{a=>1,b=>0}) |
166 | { |
167 | given ($_) { |
168 | $iteration++; |
169 | |
170 | # SELF |
171 | when ($_) : { ok(1) } else { ok(0) } |
172 | |
173 | # NUMERIC |
174 | when (1) : { ok (0) } else { ok (1) } |
175 | when (1.0) : { ok (0) } else { ok (1) } |
176 | |
177 | # STRING |
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) } |
181 | |
182 | # ARRAY |
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) } |
190 | |
191 | # HASH |
192 | when ({}) : { ok (0) } else { ok (1) } |
193 | when ({a=>'a', 1=>1, 2=>0}) : { ok (0) } else { ok (1) } |
194 | |
195 | # SUB/BLOCK |
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 |
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 | given ($_) { |
220 | $iteration++; |
221 | # SELF |
222 | when ($_) : { ok(1) } else { ok(0) } |
223 | |
224 | # NUMERIC |
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) } |
228 | |
229 | # STRING |
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) } |
234 | |
235 | # ARRAY |
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) } |
245 | |
246 | # HASH |
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) } |
250 | |
251 | # SUB/BLOCK |
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 |
256 | } |
257 | } |
258 | |
259 | |
260 | # NESTED SWITCHES |
261 | |
262 | for my $count (1..3) |
263 | { |
264 | given ([9,"a",11]) { |
265 | when (qr/\d/) : { |
266 | given ($count) { |
267 | when (1) : { ok($count==1) } |
268 | else { ok($count!=1) } |
269 | when ([5,6]) : { ok(0) } else { ok(1) } |
270 | } |
271 | } |
272 | ok(1) when 11; |
273 | } |
274 | } |