Finish converting overload.t to Test::More
[p5sagit/p5-mst-13.2.git] / lib / Switch / t / given.t
CommitLineData
88587957 1BEGIN {
6596d39b 2 if ($ENV{PERL_CORE}) {
3 chdir('t') if -d 't';
4 @INC = qw(../lib);
5 }
88587957 6}
7
74a6a946 8use Carp;
9use Switch qw(Perl6 __ fallthrough);
10
11my($C,$M);sub ok{$C++;$M.=$_[0]?"ok $C\n":"not ok $C (line ".(caller)[2].")\n"}
12END{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
6596d39b 22eval { when 1 { ok(0) }; ok(0) } || ok(1);
74a6a946 23
24# H.O. FUNCS
25
6596d39b 26given __ > 2 {
74a6a946 27
6596d39b 28 when 1 { ok(0) } else { ok(1) }
29 when 2 { ok(0) } else { ok(1) }
30 when 3 { ok(1) } else { ok(0) }
74a6a946 31}
32
33given (3) {
34
6596d39b 35 eval { when __ <= 1 || __ > 2 { ok(0) } } || ok(1);
36 when __ <= 2 { ok(0) };
37 when __ <= 3 { ok(1) };
74a6a946 38}
39
40# POSSIBLE ARGS: NUMERIC, STRING, ARRAY, HASH, REGEX, CODE
41
42# 1. NUMERIC SWITCH
43
44for (1..3)
45{
46 given ($_) {
47 # SELF
6596d39b 48 when ($_) { ok(1) } else { ok(0) }
74a6a946 49
50 # NUMERIC
6596d39b 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) }
74a6a946 56
57 # STRING
6596d39b 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) }
74a6a946 62
63 # ARRAY
6596d39b 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) }
74a6a946 70
71 # HASH
6596d39b 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) }
74a6a946 76
77 # SUB/BLOCK
6596d39b 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
74a6a946 82 }
83}
84
85
86# 2. STRING SWITCH
87
88for ('a'..'c','1')
89{
90 given ($_) {
91 # SELF
6596d39b 92 when ($_) { ok(1) } else { ok(0) }
74a6a946 93
94 # NUMERIC
6596d39b 95 when (1) { ok ($_ !~ /[a-c]/) } else { ok ($_ =~ /[a-c]/) }
96 when (1.0) { ok ($_ !~ /[a-c]/) } else { ok ($_ =~ /[a-c]/) }
74a6a946 97
98 # STRING
6596d39b 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) }
74a6a946 104
105 # ARRAY
6596d39b 106 when (['a','1']) { ok ($_ eq 'a' || $_ eq '1') }
74a6a946 107 else { ok ($_ ne 'a' && $_ ne '1') }
6596d39b 108 when (['z','2']) { ok (0) } else { ok(1) }
109 when ([]) { ok (0) } else { ok(1) }
74a6a946 110
111 # HASH
6596d39b 112 when ({}) { ok (0) } else { ok (1) }
113 when ({a=>'a', 1=>1, 2=>0}) { ok ($_ eq 'a' || $_ eq '1') }
74a6a946 114 else { ok ($_ ne 'a' && $_ ne '1') }
115
116 # SUB/BLOCK
6596d39b 117 when (sub{$_[0] eq 'a' }) { ok ($_ eq 'a') }
74a6a946 118 else { ok($_ ne 'a') }
6596d39b 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
74a6a946 122 }
123}
124
125
126# 3. ARRAY SWITCH
127
128my $iteration = 0;
129for ([],[1,'a'],[2,'b'])
130{
131 given ($_) {
132 $iteration++;
133 # SELF
6596d39b 134 when ($_) { ok(1) }
74a6a946 135
136 # NUMERIC
6596d39b 137 when (1) { ok ($iteration==2) } else { ok ($iteration!=2) }
138 when (1.0) { ok ($iteration==2) } else { ok ($iteration!=2) }
74a6a946 139
140 # STRING
6596d39b 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) }
74a6a946 144
145 # ARRAY
6596d39b 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) }
74a6a946 150
151 # HASH
6596d39b 152 when ({}) { ok (0) } else { ok (1) }
153 when ({a=>'a', 1=>1, 2=>0}) { ok ($iteration==2) }
74a6a946 154 else { ok ($iteration!=2) }
155
156 # SUB/BLOCK
6596d39b 157 when {scalar grep /a/, @_} { ok ($iteration==2) }
74a6a946 158 else { ok ($iteration!=2) }
6596d39b 159 when (sub {scalar grep /a/, @_ }) { ok ($iteration==2) }
74a6a946 160 else { ok ($iteration!=2) }
6596d39b 161 when {0} { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH
162 when {1} { ok (1) } else { ok (0) } # ; -> SUB, NOT HASH
74a6a946 163 }
164}
165
166
167# 4. HASH SWITCH
168
169$iteration = 0;
170for ({},{a=>1,b=>0})
171{
172 given ($_) {
173 $iteration++;
174
175 # SELF
6596d39b 176 when ($_) { ok(1) } else { ok(0) }
74a6a946 177
178 # NUMERIC
6596d39b 179 when (1) { ok (0) } else { ok (1) }
180 when (1.0) { ok (0) } else { ok (1) }
74a6a946 181
182 # STRING
6596d39b 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) }
74a6a946 186
187 # ARRAY
6596d39b 188 when (['a',2]) { ok ($iteration==2) }
74a6a946 189 else { ok ($iteration!=2) }
6596d39b 190 when (['b','a']) { ok ($iteration==2) }
74a6a946 191 else { ok ($iteration!=2) }
6596d39b 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) }
74a6a946 195
196 # HASH
6596d39b 197 when ({}) { ok (0) } else { ok (1) }
198 when ({a=>'a', 1=>1, 2=>0}) { ok (0) } else { ok (1) }
74a6a946 199
200 # SUB/BLOCK
6596d39b 201 when {$_[0]{a}} { ok ($iteration==2) }
74a6a946 202 else { ok ($iteration!=2) }
6596d39b 203 when (sub {$_[0]{a}}) { ok ($iteration==2) }
74a6a946 204 else { ok ($iteration!=2) }
6596d39b 205 when {0} { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH
206 when {1} { ok (1) } else { ok (0) } # ; -> SUB, NOT HASH
74a6a946 207 }
208}
209
210
211# 5. CODE SWITCH
212
213$iteration = 0;
214for ( 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
6596d39b 227 when ($_) { ok(1) } else { ok(0) }
74a6a946 228
229 # NUMERIC
6596d39b 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) }
74a6a946 233
234 # STRING
6596d39b 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) }
74a6a946 239
240 # ARRAY
6596d39b 241 when ([1, 'a']) { ok ($iteration<=2) }
74a6a946 242 else { ok ($iteration>2) }
6596d39b 243 when (['b','a']) { ok ($iteration==1) }
74a6a946 244 else { ok ($iteration!=1) }
6596d39b 245 when (['b','c']) { ok ($iteration==1) }
74a6a946 246 else { ok ($iteration!=1) }
6596d39b 247 when ([]) { ok ($iteration==1) } else { ok($iteration!=1) }
248 when ([7..100]) { ok ($iteration==1) }
74a6a946 249 else { ok($iteration!=1) }
250
251 # HASH
6596d39b 252 when ({}) { ok ($iteration==1) } else { ok ($iteration!=1) }
253 when ({a=>'a', 1=>1, 2=>0}) { ok ($iteration<=2) }
74a6a946 254 else { ok ($iteration>2) }
255
256 # SUB/BLOCK
6596d39b 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
74a6a946 261 }
262}
263
264
265# NESTED SWITCHES
266
267for my $count (1..3)
268{
269 given ([9,"a",11]) {
6596d39b 270 when (qr/\d/) {
74a6a946 271 given ($count) {
6596d39b 272 when (1) { ok($count==1) }
74a6a946 273 else { ok($count!=1) }
6596d39b 274 when ([5,6]) { ok(0) } else { ok(1) }
74a6a946 275 }
276 }
277 ok(1) when 11;
278 }
279}