BEGIN {
if ($ENV{PERL_CORE}) {
chdir('t') if -d 't';
@INC = qw(../lib);
}
}
use Carp;
use Switch qw(Perl6 __ fallthrough);
my($C,$M);sub ok{$C++;$M.=$_[0]?"ok $C\n":"not ok $C (line ".(caller)[2].")\n"}
END{print"1..$C\n$M"}
# NON-when THINGS;
$when->{when} = { when => "when" };
*when = \&when;
# PREMATURE when
eval { when 1 { ok(0) }; ok(0) } || ok(1);
# H.O. FUNCS
given __ > 2 {
when 1 { ok(0) } else { ok(1) }
when 2 { ok(0) } else { ok(1) }
when 3 { ok(1) } else { ok(0) }
}
given (3) {
eval { when __ <= 1 || __ > 2 { ok(0) } } || ok(1);
when __ <= 2 { ok(0) };
when __ <= 3 { ok(1) };
}
# POSSIBLE ARGS: NUMERIC, STRING, ARRAY, HASH, REGEX, CODE
# 1. NUMERIC SWITCH
for (1..3)
{
given ($_) {
# SELF
when ($_) { ok(1) } else { ok(0) }
# NUMERIC
when 1 { ok ($_==1) } else { ok($_!=1) }
when (1) { ok ($_==1) } else { ok($_!=1) }
when 3 { ok ($_==3) } else { ok($_!=3) }
when (4) { ok (0) } else { ok(1) }
when (2) { ok ($_==2) } else { ok($_!=2) }
# STRING
when ('a') { ok (0) } else { ok(1) }
when 'a' { ok (0) } else { ok(1) }
when ('3') { ok ($_ == 3) } else { ok($_ != 3) }
when ('3.0') { ok (0) } else { ok(1) }
# ARRAY
when ([10,5,1]) { ok ($_==1) } else { ok($_!=1) }
when [10,5,1] { ok ($_==1) } else { ok($_!=1) }
when (['a','b']) { ok (0) } else { ok(1) }
when (['a','b',3]) { ok ($_==3) } else { ok ($_!=3) }
when (['a','b',2.0]) { ok ($_==2) } else { ok ($_!=2) }
when ([]) { ok (0) } else { ok(1) }
# HASH
when ({}) { ok (0) } else { ok (1) }
when {} { ok (0) } else { ok (1) }
when {1,1} { ok ($_==1) } else { ok($_!=1) }
when ({1=>1, 2=>0}) { ok ($_==1) } else { ok($_!=1) }
# SUB/BLOCK
when (sub {$_[0]==2}) { ok ($_==2) } else { ok($_!=2) }
when {$_[0]==2} { ok ($_==2) } else { ok($_!=2) }
when {0} { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH
when {1} { ok (1) } else { ok (0) } # ; -> SUB, NOT HASH
}
}
# 2. STRING SWITCH
for ('a'..'c','1')
{
given ($_) {
# SELF
when ($_) { ok(1) } else { ok(0) }
# NUMERIC
when (1) { ok ($_ !~ /[a-c]/) } else { ok ($_ =~ /[a-c]/) }
when (1.0) { ok ($_ !~ /[a-c]/) } else { ok ($_ =~ /[a-c]/) }
# STRING
when ('a') { ok ($_ eq 'a') } else { ok($_ ne 'a') }
when ('b') { ok ($_ eq 'b') } else { ok($_ ne 'b') }
when ('c') { ok ($_ eq 'c') } else { ok($_ ne 'c') }
when ('1') { ok ($_ eq '1') } else { ok($_ ne '1') }
when ('d') { ok (0) } else { ok (1) }
# ARRAY
when (['a','1']) { ok ($_ eq 'a' || $_ eq '1') }
else { ok ($_ ne 'a' && $_ ne '1') }
when (['z','2']) { ok (0) } else { ok(1) }
when ([]) { ok (0) } else { ok(1) }
# HASH
when ({}) { ok (0) } else { ok (1) }
when ({a=>'a', 1=>1, 2=>0}) { ok ($_ eq 'a' || $_ eq '1') }
else { ok ($_ ne 'a' && $_ ne '1') }
# SUB/BLOCK
when (sub{$_[0] eq 'a' }) { ok ($_ eq 'a') }
else { ok($_ ne 'a') }
when {$_[0] eq 'a'} { ok ($_ eq 'a') } else { ok($_ ne 'a') }
when {0} { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH
when {1} { ok (1) } else { ok (0) } # ; -> SUB, NOT HASH
}
}
# 3. ARRAY SWITCH
my $iteration = 0;
for ([],[1,'a'],[2,'b'])
{
given ($_) {
$iteration++;
# SELF
when ($_) { ok(1) }
# NUMERIC
when (1) { ok ($iteration==2) } else { ok ($iteration!=2) }
when (1.0) { ok ($iteration==2) } else { ok ($iteration!=2) }
# STRING
when ('a') { ok ($iteration==2) } else { ok ($iteration!=2) }
when ('b') { ok ($iteration==3) } else { ok ($iteration!=3) }
when ('1') { ok ($iteration==2) } else { ok ($iteration!=2) }
# ARRAY
when (['a',2]) { ok ($iteration>=2) } else { ok ($iteration<2) }
when ([1,'a']) { ok ($iteration==2) } else { ok($iteration!=2) }
when ([]) { ok (0) } else { ok(1) }
when ([7..100]) { ok (0) } else { ok(1) }
# HASH
when ({}) { ok (0) } else { ok (1) }
when ({a=>'a', 1=>1, 2=>0}) { ok ($iteration==2) }
else { ok ($iteration!=2) }
# SUB/BLOCK
when {scalar grep /a/, @_} { ok ($iteration==2) }
else { ok ($iteration!=2) }
when (sub {scalar grep /a/, @_ }) { ok ($iteration==2) }
else { ok ($iteration!=2) }
when {0} { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH
when {1} { ok (1) } else { ok (0) } # ; -> SUB, NOT HASH
}
}
# 4. HASH SWITCH
$iteration = 0;
for ({},{a=>1,b=>0})
{
given ($_) {
$iteration++;
# SELF
when ($_) { ok(1) } else { ok(0) }
# NUMERIC
when (1) { ok (0) } else { ok (1) }
when (1.0) { ok (0) } else { ok (1) }
# STRING
when ('a') { ok ($iteration==2) } else { ok ($iteration!=2) }
when ('b') { ok (0) } else { ok (1) }
when ('c') { ok (0) } else { ok (1) }
# ARRAY
when (['a',2]) { ok ($iteration==2) }
else { ok ($iteration!=2) }
when (['b','a']) { ok ($iteration==2) }
else { ok ($iteration!=2) }
when (['b','c']) { ok (0) } else { ok (1) }
when ([]) { ok (0) } else { ok(1) }
when ([7..100]) { ok (0) } else { ok(1) }
# HASH
when ({}) { ok (0) } else { ok (1) }
when ({a=>'a', 1=>1, 2=>0}) { ok (0) } else { ok (1) }
# SUB/BLOCK
when {$_[0]{a}} { ok ($iteration==2) }
else { ok ($iteration!=2) }
when (sub {$_[0]{a}}) { ok ($iteration==2) }
else { ok ($iteration!=2) }
when {0} { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH
when {1} { ok (1) } else { ok (0) } # ; -> SUB, NOT HASH
}
}
# 5. CODE SWITCH
$iteration = 0;
for ( sub {1},
sub { return 0 unless @_;
my ($data) = @_;
my $type = ref $data;
return $type eq 'HASH' && $data->{a}
|| $type eq 'Regexp' && 'a' =~ /$data/
|| $type eq "" && $data eq '1';
},
sub {0} )
{
given ($_) {
$iteration++;
# SELF
when ($_) { ok(1) } else { ok(0) }
# NUMERIC
when (1) { ok ($iteration<=2) } else { ok ($iteration>2) }
when (1.0) { ok ($iteration<=2) } else { ok ($iteration>2) }
when (1.1) { ok ($iteration==1) } else { ok ($iteration!=1) }
# STRING
when ('a') { ok ($iteration==1) } else { ok ($iteration!=1) }
when ('b') { ok ($iteration==1) } else { ok ($iteration!=1) }
when ('c') { ok ($iteration==1) } else { ok ($iteration!=1) }
when ('1') { ok ($iteration<=2) } else { ok ($iteration>2) }
# ARRAY
when ([1, 'a']) { ok ($iteration<=2) }
else { ok ($iteration>2) }
when (['b','a']) { ok ($iteration==1) }
else { ok ($iteration!=1) }
when (['b','c']) { ok ($iteration==1) }
else { ok ($iteration!=1) }
when ([]) { ok ($iteration==1) } else { ok($iteration!=1) }
when ([7..100]) { ok ($iteration==1) }
else { ok($iteration!=1) }
# HASH
when ({}) { ok ($iteration==1) } else { ok ($iteration!=1) }
when ({a=>'a', 1=>1, 2=>0}) { ok ($iteration<=2) }
else { ok ($iteration>2) }
# SUB/BLOCK
when {$_[0]->{a}} { ok (0) } else { ok (1) }
when (sub {$_[0]{a}}) { ok (0) } else { ok (1) }
when {0} { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH
when {1} { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH
}
}
# NESTED SWITCHES
for my $count (1..3)
{
given ([9,"a",11]) {
when (qr/\d/) {
given ($count) {
when (1) { ok($count==1) }
else { ok($count!=1) }
when ([5,6]) { ok(0) } else { ok(1) }
}
}
ok(1) when 11;
}
}
|