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 print "1..293\n";
  10
  11 my $count = 0;
  12 sub 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
  28 eval { case 1 { ok(0) }; ok(0) } || ok(1);
  29
  30 # H.O. FUNCS
  31
  32 switch (__ > 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
  39 switch (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
  50 for (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
  94 for ('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
 134 my $iteration = 0;
 135 for ([],[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;
 176 for ({},{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;
 220 for ( 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
 273 for 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 }