lib/Switch/t/switch.t

   1 BEGIN {
   2     if ($ENV{PERL_CORE}) {
   3         chdir('t') if -d 't';
   4         @INC = qw(../lib);
   5     }
   6 }
   7
   8 use Carp;
   9 use Switch qw(__ fallthrough);
  10
  11 my($C,$M);sub ok{$C++;$M.=$_[0]?"ok $C\n":"not ok $C (line ".(caller)[2].")\n"}
  12 END{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
  22 eval { case 1 { ok(0) }; ok(0) } || ok(1);
  23
  24 # H.O. FUNCS
  25
  26 switch (__ > 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
  33 switch (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
  44 for (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
  88 for ('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
 128 my $iteration = 0;
 129 for ([],[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;
 170 for ({},{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;
 214 for ( 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
 267 for 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 }