lib/Switch/t/switch.t

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