dist/Switch/t/switch.t

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