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