lib/Switch/t/given.t

   1 #! /usr/local/bin/perl -w
   2
   3 use Carp;
   4 use Switch qw(Perl6 __ 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-when THINGS;
  10
  11 $when->{when} = { when => "when" };
  12
  13 *when = \&when;
  14
  15 # PREMATURE when
  16
  17 eval { when 1: { ok(0) }; ok(0) } || ok(1);
  18
  19 # H.O. FUNCS
  20
  21 given (__ > 2) {
  22
  23         when 1: { ok(0) } else { ok(1) }
  24         when 2: { ok(0) } else { ok(1) }
  25         when 3: { ok(1) } else { ok(0) }
  26 }
  27
  28 given (3) {
  29
  30         eval { when __ <= 1 || __ > 2:  { ok(0) } } || ok(1);
  31         when __ <= 2:           { ok(0) };
  32         when __ <= 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         given ($_) {
  42                 # SELF
  43                 when $_: { ok(1) } else { ok(0) }
  44
  45                 # NUMERIC
  46                 when 1: { ok ($_==1) } else { ok($_!=1) }
  47                 when (1):  { ok ($_==1) } else { ok($_!=1) }
  48                 when 3: { ok ($_==3) } else { ok($_!=3) }
  49                 when (4): { ok (0) } else { ok(1) }
  50                 when (2): { ok ($_==2) } else { ok($_!=2) }
  51
  52                 # STRING
  53                 when ('a'): { ok (0) } else { ok(1) }
  54                 when  'a' : { ok (0) } else { ok(1) }
  55                 when ('3'): { ok ($_ == 3) } else { ok($_ != 3) }
  56                 when ('3.0'): { ok (0) } else { ok(1) }
  57
  58                 # ARRAY
  59                 when ([10,5,1]): { ok ($_==1) } else { ok($_!=1) }
  60                 when  [10,5,1]:  { ok ($_==1) } else { ok($_!=1) }
  61                 when (['a','b']): { ok (0) } else { ok(1) }
  62                 when (['a','b',3]): { ok ($_==3) } else { ok ($_!=3) }
  63                 when (['a','b',2.0]) : { ok ($_==2) } else { ok ($_!=2) }
  64                 when ([]) : { ok (0) } else { ok(1) }
  65
  66                 # HASH
  67                 when ({}) : { ok (0) } else { ok (1) }
  68                 when {} : { ok (0) } else { ok (1) }
  69                 when {1,1} : { ok ($_==1) } else { ok($_!=1) }
  70                 when ({1=>1, 2=>0}) : { ok ($_==1) } else { ok($_!=1) }
  71
  72                 # SUB/BLOCK
  73                 when (sub {$_[0]==2}) : { ok ($_==2) } else { ok($_!=2) }
  74                 when {$_[0]==2} : { ok ($_==2) } else { ok($_!=2) }
  75                 when {0} : { ok (0) } else { ok (1) }   # ; -> SUB, NOT HASH
  76                 when {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         given ($_) {
  86                 # SELF
  87                 when ($_) : { ok(1) } else { ok(0) }
  88
  89                 # NUMERIC
  90                 when (1)  : { ok ($_ !~ /[a-c]/) } else { ok ($_ =~ /[a-c]/) }
  91                 when (1.0) : { ok ($_ !~ /[a-c]/) } else { ok ($_ =~ /[a-c]/) }
  92
  93                 # STRING
  94                 when ('a') : { ok ($_ eq 'a') } else { ok($_ ne 'a') }
  95                 when ('b') : { ok ($_ eq 'b') } else { ok($_ ne 'b') }
  96                 when ('c') : { ok ($_ eq 'c') } else { ok($_ ne 'c') }
  97                 when ('1') : { ok ($_ eq '1') } else { ok($_ ne '1') }
  98                 when ('d') : { ok (0) } else { ok (1) }
  99
 100                 # ARRAY
 101                 when (['a','1']) : { ok ($_ eq 'a' || $_ eq '1') }
 102                         else { ok ($_ ne 'a' && $_ ne '1') }
 103                 when (['z','2']) : { ok (0) } else { ok(1) }
 104                 when ([]) : { ok (0) } else { ok(1) }
 105
 106                 # HASH
 107                 when ({}) : { ok (0) } else { ok (1) }
 108                 when ({a=>'a', 1=>1, 2=>0}) : { ok ($_ eq 'a' || $_ eq '1') }
 109                         else { ok ($_ ne 'a' && $_ ne '1') }
 110
 111                 # SUB/BLOCK
 112                 when (sub{$_[0] eq 'a' }) : { ok ($_ eq 'a') }
 113                         else { ok($_ ne 'a') }
 114                 when {$_[0] eq 'a'} : { ok ($_ eq 'a') } else { ok($_ ne 'a') }
 115                 when {0} : { ok (0) } else { ok (1) }   # ; -> SUB, NOT HASH
 116                 when {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         given ($_) {
 127         $iteration++;
 128                 # SELF
 129                 when ($_) : { ok(1) }
 130
 131                 # NUMERIC
 132                 when (1) : { ok ($iteration==2) } else { ok ($iteration!=2) }
 133                 when (1.0) : { ok ($iteration==2) } else { ok ($iteration!=2) }
 134
 135                 # STRING
 136                 when ('a') : { ok ($iteration==2) } else { ok ($iteration!=2) }
 137                 when ('b') : { ok ($iteration==3) } else { ok ($iteration!=3) }
 138                 when ('1') : { ok ($iteration==2) } else { ok ($iteration!=2) }
 139
 140                 # ARRAY
 141                 when (['a',2]) : { ok ($iteration>=2) } else { ok ($iteration<2) }
 142                 when ([1,'a']) : { ok ($iteration==2) } else { ok($iteration!=2) }
 143                 when ([]) : { ok (0) } else { ok(1) }
 144                 when ([7..100]) : { ok (0) } else { ok(1) }
 145
 146                 # HASH
 147                 when ({}) : { ok (0) } else { ok (1) }
 148                 when ({a=>'a', 1=>1, 2=>0}) : { ok ($iteration==2) }
 149                         else { ok ($iteration!=2) }
 150
 151                 # SUB/BLOCK
 152                 when {scalar grep /a/, @_} : { ok ($iteration==2) }
 153                         else { ok ($iteration!=2) }
 154                 when (sub {scalar grep /a/, @_ }) : { ok ($iteration==2) }
 155                         else { ok ($iteration!=2) }
 156                 when {0} : { ok (0) } else { ok (1) }   # ; -> SUB, NOT HASH
 157                 when {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         given ($_) {
 168         $iteration++;
 169
 170                 # SELF
 171                 when ($_) : { ok(1) } else { ok(0) }
 172
 173                 # NUMERIC
 174                 when (1) : { ok (0) } else { ok (1) }
 175                 when (1.0) : { ok (0) } else { ok (1) }
 176
 177                 # STRING
 178                 when ('a') : { ok ($iteration==2) } else { ok ($iteration!=2) }
 179                 when ('b') : { ok (0) } else { ok (1) }
 180                 when ('c') : { ok (0) } else { ok (1) }
 181
 182                 # ARRAY
 183                 when (['a',2]) : { ok ($iteration==2) }
 184                         else { ok ($iteration!=2) }
 185                 when (['b','a']) : { ok ($iteration==2) }
 186                         else { ok ($iteration!=2) }
 187                 when (['b','c']) : { ok (0) } else { ok (1) }
 188                 when ([]) : { ok (0) } else { ok(1) }
 189                 when ([7..100]) : { ok (0) } else { ok(1) }
 190
 191                 # HASH
 192                 when ({}) : { ok (0) } else { ok (1) }
 193                 when ({a=>'a', 1=>1, 2=>0}) : { ok (0) } else { ok (1) }
 194
 195                 # SUB/BLOCK
 196                 when {$_[0]{a}} : { ok ($iteration==2) }
 197                         else { ok ($iteration!=2) }
 198                 when (sub {$_[0]{a}}) : { ok ($iteration==2) }
 199                         else { ok ($iteration!=2) }
 200                 when {0} : { ok (0) } else { ok (1) }   # ; -> SUB, NOT HASH
 201                 when {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         given ($_) {
 220         $iteration++;
 221                 # SELF
 222                 when ($_) : { ok(1) } else { ok(0) }
 223
 224                 # NUMERIC
 225                 when (1) : { ok ($iteration<=2) } else { ok ($iteration>2) }
 226                 when (1.0) : { ok ($iteration<=2) } else { ok ($iteration>2) }
 227                 when (1.1) : { ok ($iteration==1) } else { ok ($iteration!=1) }
 228
 229                 # STRING
 230                 when ('a') : { ok ($iteration==1) } else { ok ($iteration!=1) }
 231                 when ('b') : { ok ($iteration==1) } else { ok ($iteration!=1) }
 232                 when ('c') : { ok ($iteration==1) } else { ok ($iteration!=1) }
 233                 when ('1') : { ok ($iteration<=2) } else { ok ($iteration>2) }
 234
 235                 # ARRAY
 236                 when ([1, 'a']) : { ok ($iteration<=2) }
 237                         else { ok ($iteration>2) }
 238                 when (['b','a']) : { ok ($iteration==1) }
 239                         else { ok ($iteration!=1) }
 240                 when (['b','c']) : { ok ($iteration==1) }
 241                         else { ok ($iteration!=1) }
 242                 when ([]) : { ok ($iteration==1) } else { ok($iteration!=1) }
 243                 when ([7..100]) : { ok ($iteration==1) }
 244                         else { ok($iteration!=1) }
 245
 246                 # HASH
 247                 when ({}) : { ok ($iteration==1) } else { ok ($iteration!=1) }
 248                 when ({a=>'a', 1=>1, 2=>0}) : { ok ($iteration<=2) }
 249                         else { ok ($iteration>2) }
 250
 251                 # SUB/BLOCK
 252                 when {$_[0]->{a}} : { ok (0) } else { ok (1) }
 253                 when (sub {$_[0]{a}}) : { ok (0) } else { ok (1) }
 254                 when {0} : { ok (0) } else { ok (1) }   # ; -> SUB, NOT HASH
 255                 when {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         given ([9,"a",11]) {
 265                 when (qr/\d/) : {
 266                                 given ($count) {
 267                                         when (1)     : { ok($count==1) }
 268                                                 else { ok($count!=1) }
 269                                         when ([5,6]) : { ok(0) } else { ok(1) }
 270                                 }
 271                             }
 272                 ok(1) when 11;
 273         }
 274 }