1BEGIN { 2 if ($ENV{PERL_CORE}) { 3 chdir('t') if -d 't'; 4 @INC = qw(../lib); 5 } 6} 7 8use Carp; 9use Switch qw(__ 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-case THINGS; 15 16$case->{case} = { case => "case" }; 17 18*case = \&case; 19 20# PREMATURE case 21 22eval { case 1 { ok(0) }; ok(0) } || ok(1); 23 24# H.O. FUNCS 25 26switch (__ > 2) { 27 28 case 1 { ok(0) } else { ok(1) } 29 case 2 { ok(0) } else { ok(1) } 30 case 3 { ok(1) } else { ok(0) } 31} 32 33switch (3) { 34 35 eval { case __ <= 1 || __ > 2 { ok(0) } } || ok(1); 36 case __ <= 2 { ok(0) }; 37 case __ <= 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 switch ($_) { 47 # SELF 48 case ($_) { ok(1) } else { ok(0) } 49 50 # NUMERIC 51 case (1) { ok ($_==1) } else { ok($_!=1) } 52 case 1 { ok ($_==1) } else { ok($_!=1) } 53 case (3) { ok ($_==3) } else { ok($_!=3) } 54 case (4) { ok (0) } else { ok(1) } 55 case (2) { ok ($_==2) } else { ok($_!=2) } 56 57 # STRING 58 case ('a') { ok (0) } else { ok(1) } 59 case 'a' { ok (0) } else { ok(1) } 60 case ('3') { ok ($_ == 3) } else { ok($_ != 3) } 61 case ('3.0') { ok (0) } else { ok(1) } 62 63 # ARRAY 64 case ([10,5,1]) { ok ($_==1) } else { ok($_!=1) } 65 case [10,5,1] { ok ($_==1) } else { ok($_!=1) } 66 case (['a','b']) { ok (0) } else { ok(1) } 67 case (['a','b',3]) { ok ($_==3) } else { ok ($_!=3) } 68 case (['a','b',2.0]) { ok ($_==2) } else { ok ($_!=2) } 69 case ([]) { ok (0) } else { ok(1) } 70 71 # HASH 72 case ({}) { ok (0) } else { ok (1) } 73 case {} { ok (0) } else { ok (1) } 74 case {1,1} { ok ($_==1) } else { ok($_!=1) } 75 case ({1=>1, 2=>0}) { ok ($_==1) } else { ok($_!=1) } 76 77 # SUB/BLOCK 78 case (sub {$_[0]==2}) { ok ($_==2) } else { ok($_!=2) } 79 case {$_[0]==2} { ok ($_==2) } else { ok($_!=2) } 80 case {0} { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH 81 case {1} { ok (1) } else { ok (0) } # ; -> SUB, NOT HASH 82 } 83} 84 85 86# 2. STRING SWITCH 87 88for ('a'..'c','1') 89{ 90 switch ($_) { 91 # SELF 92 case ($_) { ok(1) } else { ok(0) } 93 94 # NUMERIC 95 case (1) { ok ($_ !~ /[a-c]/) } else { ok ($_ =~ /[a-c]/) } 96 case (1.0) { ok ($_ !~ /[a-c]/) } else { ok ($_ =~ /[a-c]/) } 97 98 # STRING 99 case ('a') { ok ($_ eq 'a') } else { ok($_ ne 'a') } 100 case ('b') { ok ($_ eq 'b') } else { ok($_ ne 'b') } 101 case ('c') { ok ($_ eq 'c') } else { ok($_ ne 'c') } 102 case ('1') { ok ($_ eq '1') } else { ok($_ ne '1') } 103 case ('d') { ok (0) } else { ok (1) } 104 105 # ARRAY 106 case (['a','1']) { ok ($_ eq 'a' || $_ eq '1') } 107 else { ok ($_ ne 'a' && $_ ne '1') } 108 case (['z','2']) { ok (0) } else { ok(1) } 109 case ([]) { ok (0) } else { ok(1) } 110 111 # HASH 112 case ({}) { ok (0) } else { ok (1) } 113 case ({a=>'a', 1=>1, 2=>0}) { ok ($_ eq 'a' || $_ eq '1') } 114 else { ok ($_ ne 'a' && $_ ne '1') } 115 116 # SUB/BLOCK 117 case (sub{$_[0] eq 'a' }) { ok ($_ eq 'a') } 118 else { ok($_ ne 'a') } 119 case {$_[0] eq 'a'} { ok ($_ eq 'a') } else { ok($_ ne 'a') } 120 case {0} { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH 121 case {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 switch ($_) { 132 $iteration++; 133 # SELF 134 case ($_) { ok(1) } 135 136 # NUMERIC 137 case (1) { ok ($iteration==2) } else { ok ($iteration!=2) } 138 case (1.0) { ok ($iteration==2) } else { ok ($iteration!=2) } 139 140 # STRING 141 case ('a') { ok ($iteration==2) } else { ok ($iteration!=2) } 142 case ('b') { ok ($iteration==3) } else { ok ($iteration!=3) } 143 case ('1') { ok ($iteration==2) } else { ok ($iteration!=2) } 144 145 # ARRAY 146 case (['a',2]) { ok ($iteration>=2) } else { ok ($iteration<2) } 147 case ([1,'a']) { ok ($iteration==2) } else { ok($iteration!=2) } 148 case ([]) { ok (0) } else { ok(1) } 149 case ([7..100]) { ok (0) } else { ok(1) } 150 151 # HASH 152 case ({}) { ok (0) } else { ok (1) } 153 case ({a=>'a', 1=>1, 2=>0}) { ok ($iteration==2) } 154 else { ok ($iteration!=2) } 155 156 # SUB/BLOCK 157 case {scalar grep /a/, @_} { ok ($iteration==2) } 158 else { ok ($iteration!=2) } 159 case (sub {scalar grep /a/, @_ }) { ok ($iteration==2) } 160 else { ok ($iteration!=2) } 161 case {0} { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH 162 case {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 switch ($_) { 173 $iteration++; 174 175 # SELF 176 case ($_) { ok(1) } else { ok(0) } 177 178 # NUMERIC 179 case (1) { ok (0) } else { ok (1) } 180 case (1.0) { ok (0) } else { ok (1) } 181 182 # STRING 183 case ('a') { ok ($iteration==2) } else { ok ($iteration!=2) } 184 case ('b') { ok (0) } else { ok (1) } 185 case ('c') { ok (0) } else { ok (1) } 186 187 # ARRAY 188 case (['a',2]) { ok ($iteration==2) } 189 else { ok ($iteration!=2) } 190 case (['b','a']) { ok ($iteration==2) } 191 else { ok ($iteration!=2) } 192 case (['b','c']) { ok (0) } else { ok (1) } 193 case ([]) { ok (0) } else { ok(1) } 194 case ([7..100]) { ok (0) } else { ok(1) } 195 196 # HASH 197 case ({}) { ok (0) } else { ok (1) } 198 case ({a=>'a', 1=>1, 2=>0}) { ok (0) } else { ok (1) } 199 200 # SUB/BLOCK 201 case {$_[0]{a}} { ok ($iteration==2) } 202 else { ok ($iteration!=2) } 203 case (sub {$_[0]{a}}) { ok ($iteration==2) } 204 else { ok ($iteration!=2) } 205 case {0} { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH 206 case {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 switch ($_) { 225 $iteration++; 226 # SELF 227 case ($_) { ok(1) } else { ok(0) } 228 229 # NUMERIC 230 case (1) { ok ($iteration<=2) } else { ok ($iteration>2) } 231 case (1.0) { ok ($iteration<=2) } else { ok ($iteration>2) } 232 case (1.1) { ok ($iteration==1) } else { ok ($iteration!=1) } 233 234 # STRING 235 case ('a') { ok ($iteration==1) } else { ok ($iteration!=1) } 236 case ('b') { ok ($iteration==1) } else { ok ($iteration!=1) } 237 case ('c') { ok ($iteration==1) } else { ok ($iteration!=1) } 238 case ('1') { ok ($iteration<=2) } else { ok ($iteration>2) } 239 240 # ARRAY 241 case ([1, 'a']) { ok ($iteration<=2) } 242 else { ok ($iteration>2) } 243 case (['b','a']) { ok ($iteration==1) } 244 else { ok ($iteration!=1) } 245 case (['b','c']) { ok ($iteration==1) } 246 else { ok ($iteration!=1) } 247 case ([]) { ok ($iteration==1) } else { ok($iteration!=1) } 248 case ([7..100]) { ok ($iteration==1) } 249 else { ok($iteration!=1) } 250 251 # HASH 252 case ({}) { ok ($iteration==1) } else { ok ($iteration!=1) } 253 case ({a=>'a', 1=>1, 2=>0}) { ok ($iteration<=2) } 254 else { ok ($iteration>2) } 255 256 # SUB/BLOCK 257 case {$_[0]->{a}} { ok (0) } else { ok (1) } 258 case (sub {$_[0]{a}}) { ok (0) } else { ok (1) } 259 case {0} { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH 260 case {1} { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH 261 } 262} 263 264 265# NESTED SWITCHES 266 267for my $count (1..3) 268{ 269 switch ([9,"a",11]) { 270 case (qr/\d/) { 271 switch ($count) { 272 case (1) { ok($count==1) } 273 else { ok($count!=1) } 274 case ([5,6]) { ok(0) } else { ok(1) } 275 } 276 } 277 ok(1) case (11); 278 } 279} 280