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