lib/Switch/t/given.t

   1 #! /usr/local/bin/perl -w
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     @INC = '../lib';
   6 }
   7
   8 use Carp;
   9 use Switch qw(Perl6 __ 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-when THINGS;
  15
  16 $when->{when} = { when => "when" };
  17
  18 *when = \&when;
  19
  20 # PREMATURE when
  21
  22 eval { when 1: { ok(0) }; ok(0) } || ok(1);
  23
  24 # H.O. FUNCS
  25
  26 given (__ > 2) {
  27
  28         when 1: { ok(0) } else { ok(1) }
  29         when 2: { ok(0) } else { ok(1) }
  30         when 3: { ok(1) } else { ok(0) }
  31 }
  32
  33 given (3) {
  34
  35         eval { when __ <= 1 || __ > 2:  { ok(0) } } || ok(1);
  36         when __ <= 2:           { ok(0) };
  37         when __ <= 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         given ($_) {
  47                 # SELF
  48                 when $_: { ok(1) } else { ok(0) }
  49
  50                 # NUMERIC
  51                 when 1: { ok ($_==1) } else { ok($_!=1) }
  52                 when (1):  { ok ($_==1) } else { ok($_!=1) }
  53                 when 3: { ok ($_==3) } else { ok($_!=3) }
  54                 when (4): { ok (0) } else { ok(1) }
  55                 when (2): { ok ($_==2) } else { ok($_!=2) }
  56
  57                 # STRING
  58                 when ('a'): { ok (0) } else { ok(1) }
  59                 when  'a' : { ok (0) } else { ok(1) }
  60                 when ('3'): { ok ($_ == 3) } else { ok($_ != 3) }
  61                 when ('3.0'): { ok (0) } else { ok(1) }
  62
  63                 # ARRAY
  64                 when ([10,5,1]): { ok ($_==1) } else { ok($_!=1) }
  65                 when  [10,5,1]:  { ok ($_==1) } else { ok($_!=1) }
  66                 when (['a','b']): { ok (0) } else { ok(1) }
  67                 when (['a','b',3]): { ok ($_==3) } else { ok ($_!=3) }
  68                 when (['a','b',2.0]) : { ok ($_==2) } else { ok ($_!=2) }
  69                 when ([]) : { ok (0) } else { ok(1) }
  70
  71                 # HASH
  72                 when ({}) : { ok (0) } else { ok (1) }
  73                 when {} : { ok (0) } else { ok (1) }
  74                 when {1,1} : { ok ($_==1) } else { ok($_!=1) }
  75                 when ({1=>1, 2=>0}) : { ok ($_==1) } else { ok($_!=1) }
  76
  77                 # SUB/BLOCK
  78                 when (sub {$_[0]==2}) : { ok ($_==2) } else { ok($_!=2) }
  79                 when {$_[0]==2} : { ok ($_==2) } else { ok($_!=2) }
  80                 when {0} : { ok (0) } else { ok (1) }   # ; -> SUB, NOT HASH
  81                 when {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         given ($_) {
  91                 # SELF
  92                 when ($_) : { ok(1) } else { ok(0) }
  93
  94                 # NUMERIC
  95                 when (1)  : { ok ($_ !~ /[a-c]/) } else { ok ($_ =~ /[a-c]/) }
  96                 when (1.0) : { ok ($_ !~ /[a-c]/) } else { ok ($_ =~ /[a-c]/) }
  97
  98                 # STRING
  99                 when ('a') : { ok ($_ eq 'a') } else { ok($_ ne 'a') }
 100                 when ('b') : { ok ($_ eq 'b') } else { ok($_ ne 'b') }
 101                 when ('c') : { ok ($_ eq 'c') } else { ok($_ ne 'c') }
 102                 when ('1') : { ok ($_ eq '1') } else { ok($_ ne '1') }
 103                 when ('d') : { ok (0) } else { ok (1) }
 104
 105                 # ARRAY
 106                 when (['a','1']) : { ok ($_ eq 'a' || $_ eq '1') }
 107                         else { ok ($_ ne 'a' && $_ ne '1') }
 108                 when (['z','2']) : { ok (0) } else { ok(1) }
 109                 when ([]) : { ok (0) } else { ok(1) }
 110
 111                 # HASH
 112                 when ({}) : { ok (0) } else { ok (1) }
 113                 when ({a=>'a', 1=>1, 2=>0}) : { ok ($_ eq 'a' || $_ eq '1') }
 114                         else { ok ($_ ne 'a' && $_ ne '1') }
 115
 116                 # SUB/BLOCK
 117                 when (sub{$_[0] eq 'a' }) : { ok ($_ eq 'a') }
 118                         else { ok($_ ne 'a') }
 119                 when {$_[0] eq 'a'} : { ok ($_ eq 'a') } else { ok($_ ne 'a') }
 120                 when {0} : { ok (0) } else { ok (1) }   # ; -> SUB, NOT HASH
 121                 when {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         given ($_) {
 132         $iteration++;
 133                 # SELF
 134                 when ($_) : { ok(1) }
 135
 136                 # NUMERIC
 137                 when (1) : { ok ($iteration==2) } else { ok ($iteration!=2) }
 138                 when (1.0) : { ok ($iteration==2) } else { ok ($iteration!=2) }
 139
 140                 # STRING
 141                 when ('a') : { ok ($iteration==2) } else { ok ($iteration!=2) }
 142                 when ('b') : { ok ($iteration==3) } else { ok ($iteration!=3) }
 143                 when ('1') : { ok ($iteration==2) } else { ok ($iteration!=2) }
 144
 145                 # ARRAY
 146                 when (['a',2]) : { ok ($iteration>=2) } else { ok ($iteration<2) }
 147                 when ([1,'a']) : { ok ($iteration==2) } else { ok($iteration!=2) }
 148                 when ([]) : { ok (0) } else { ok(1) }
 149                 when ([7..100]) : { ok (0) } else { ok(1) }
 150
 151                 # HASH
 152                 when ({}) : { ok (0) } else { ok (1) }
 153                 when ({a=>'a', 1=>1, 2=>0}) : { ok ($iteration==2) }
 154                         else { ok ($iteration!=2) }
 155
 156                 # SUB/BLOCK
 157                 when {scalar grep /a/, @_} : { ok ($iteration==2) }
 158                         else { ok ($iteration!=2) }
 159                 when (sub {scalar grep /a/, @_ }) : { ok ($iteration==2) }
 160                         else { ok ($iteration!=2) }
 161                 when {0} : { ok (0) } else { ok (1) }   # ; -> SUB, NOT HASH
 162                 when {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         given ($_) {
 173         $iteration++;
 174
 175                 # SELF
 176                 when ($_) : { ok(1) } else { ok(0) }
 177
 178                 # NUMERIC
 179                 when (1) : { ok (0) } else { ok (1) }
 180                 when (1.0) : { ok (0) } else { ok (1) }
 181
 182                 # STRING
 183                 when ('a') : { ok ($iteration==2) } else { ok ($iteration!=2) }
 184                 when ('b') : { ok (0) } else { ok (1) }
 185                 when ('c') : { ok (0) } else { ok (1) }
 186
 187                 # ARRAY
 188                 when (['a',2]) : { ok ($iteration==2) }
 189                         else { ok ($iteration!=2) }
 190                 when (['b','a']) : { ok ($iteration==2) }
 191                         else { ok ($iteration!=2) }
 192                 when (['b','c']) : { ok (0) } else { ok (1) }
 193                 when ([]) : { ok (0) } else { ok(1) }
 194                 when ([7..100]) : { ok (0) } else { ok(1) }
 195
 196                 # HASH
 197                 when ({}) : { ok (0) } else { ok (1) }
 198                 when ({a=>'a', 1=>1, 2=>0}) : { ok (0) } else { ok (1) }
 199
 200                 # SUB/BLOCK
 201                 when {$_[0]{a}} : { ok ($iteration==2) }
 202                         else { ok ($iteration!=2) }
 203                 when (sub {$_[0]{a}}) : { ok ($iteration==2) }
 204                         else { ok ($iteration!=2) }
 205                 when {0} : { ok (0) } else { ok (1) }   # ; -> SUB, NOT HASH
 206                 when {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         given ($_) {
 225         $iteration++;
 226                 # SELF
 227                 when ($_) : { ok(1) } else { ok(0) }
 228
 229                 # NUMERIC
 230                 when (1) : { ok ($iteration<=2) } else { ok ($iteration>2) }
 231                 when (1.0) : { ok ($iteration<=2) } else { ok ($iteration>2) }
 232                 when (1.1) : { ok ($iteration==1) } else { ok ($iteration!=1) }
 233
 234                 # STRING
 235                 when ('a') : { ok ($iteration==1) } else { ok ($iteration!=1) }
 236                 when ('b') : { ok ($iteration==1) } else { ok ($iteration!=1) }
 237                 when ('c') : { ok ($iteration==1) } else { ok ($iteration!=1) }
 238                 when ('1') : { ok ($iteration<=2) } else { ok ($iteration>2) }
 239
 240                 # ARRAY
 241                 when ([1, 'a']) : { ok ($iteration<=2) }
 242                         else { ok ($iteration>2) }
 243                 when (['b','a']) : { ok ($iteration==1) }
 244                         else { ok ($iteration!=1) }
 245                 when (['b','c']) : { ok ($iteration==1) }
 246                         else { ok ($iteration!=1) }
 247                 when ([]) : { ok ($iteration==1) } else { ok($iteration!=1) }
 248                 when ([7..100]) : { ok ($iteration==1) }
 249                         else { ok($iteration!=1) }
 250
 251                 # HASH
 252                 when ({}) : { ok ($iteration==1) } else { ok ($iteration!=1) }
 253                 when ({a=>'a', 1=>1, 2=>0}) : { ok ($iteration<=2) }
 254                         else { ok ($iteration>2) }
 255
 256                 # SUB/BLOCK
 257                 when {$_[0]->{a}} : { ok (0) } else { ok (1) }
 258                 when (sub {$_[0]{a}}) : { ok (0) } else { ok (1) }
 259                 when {0} : { ok (0) } else { ok (1) }   # ; -> SUB, NOT HASH
 260                 when {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         given ([9,"a",11]) {
 270                 when (qr/\d/) : {
 271                                 given ($count) {
 272                                         when (1)     : { ok($count==1) }
 273                                                 else { ok($count!=1) }
 274                                         when ([5,6]) : { ok(0) } else { ok(1) }
 275                                 }
 276                             }
 277                 ok(1) when 11;
 278         }
 279 }