1BEGIN { 2 if ($ENV{PERL_CORE}) { 3 chdir('t') if -d 't'; 4 @INC = qw(../lib); 5 } 6} 7 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 22eval { when 1 { ok(0) }; ok(0) } || ok(1); 23 24# H.O. FUNCS 25 26given __ > 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 33given (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 44for (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 88for ('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 128my $iteration = 0; 129for ([],[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; 170for ({},{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; 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 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 267for 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} 280