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