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