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
1 BEGIN {
2     chdir 't' if -d 't';
3     @INC = '../lib';
4 }
5
6 use Carp;
7 use Switch qw(__ fallthrough);
8
9 my($C,$M);sub ok{$C++;$M.=$_[0]?"ok $C\n":"not ok $C (line ".(caller)[2].")\n"}
10 END{print"1..$C\n$M"}
11
12 # NON-case THINGS;
13
14 $case->{case} = { case => "case" };
15
16 *case = \&case;
17
18 # PREMATURE case
19
20 eval { case 1 { ok(0) }; ok(0) } || ok(1);
21
22 # H.O. FUNCS
23
24 switch (__ > 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
31 switch (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
42 for (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
86 for ('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
126 my $iteration = 0;
127 for ([],[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;
168 for ({},{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;
212 for ( 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
265 for 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 }