dslinux/user/perl/lib/Switch/t given.t nested.t switch.t
cayenne
dslinux_cayenne at user.in-berlin.de
Tue Dec 5 05:27:18 CET 2006
Update of /cvsroot/dslinux/dslinux/user/perl/lib/Switch/t
In directory antilope:/tmp/cvs-serv7729/lib/Switch/t
Added Files:
given.t nested.t switch.t
Log Message:
Adding fresh perl source to HEAD to branch from
--- NEW FILE: switch.t ---
BEGIN {
if ($ENV{PERL_CORE}) {
chdir('t') if -d 't';
@INC = qw(../lib);
}
}
use Carp;
use Switch qw(__ 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-case THINGS;
$case->{case} = { case => "case" };
*case = \&case;
# PREMATURE case
eval { case 1 { ok(0) }; ok(0) } || ok(1);
# H.O. FUNCS
switch (__ > 2) {
case 1 { ok(0) } else { ok(1) }
case 2 { ok(0) } else { ok(1) }
case 3 { ok(1) } else { ok(0) }
}
switch (3) {
eval { case __ <= 1 || __ > 2 { ok(0) } } || ok(1);
case __ <= 2 { ok(0) };
case __ <= 3 { ok(1) };
}
# POSSIBLE ARGS: NUMERIC, STRING, ARRAY, HASH, REGEX, CODE
# 1. NUMERIC SWITCH
for (1..3)
{
switch ($_) {
# SELF
case ($_) { ok(1) } else { ok(0) }
# NUMERIC
case (1) { ok ($_==1) } else { ok($_!=1) }
case 1 { ok ($_==1) } else { ok($_!=1) }
case (3) { ok ($_==3) } else { ok($_!=3) }
case (4) { ok (0) } else { ok(1) }
case (2) { ok ($_==2) } else { ok($_!=2) }
# STRING
case ('a') { ok (0) } else { ok(1) }
case 'a' { ok (0) } else { ok(1) }
case ('3') { ok ($_ == 3) } else { ok($_ != 3) }
case ('3.0') { ok (0) } else { ok(1) }
# ARRAY
case ([10,5,1]) { ok ($_==1) } else { ok($_!=1) }
case [10,5,1] { ok ($_==1) } else { ok($_!=1) }
case (['a','b']) { ok (0) } else { ok(1) }
case (['a','b',3]) { ok ($_==3) } else { ok ($_!=3) }
case (['a','b',2.0]) { ok ($_==2) } else { ok ($_!=2) }
case ([]) { ok (0) } else { ok(1) }
# HASH
case ({}) { ok (0) } else { ok (1) }
case {} { ok (0) } else { ok (1) }
case {1,1} { ok ($_==1) } else { ok($_!=1) }
case ({1=>1, 2=>0}) { ok ($_==1) } else { ok($_!=1) }
# SUB/BLOCK
case (sub {$_[0]==2}) { ok ($_==2) } else { ok($_!=2) }
case {$_[0]==2} { ok ($_==2) } else { ok($_!=2) }
case {0} { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH
case {1} { ok (1) } else { ok (0) } # ; -> SUB, NOT HASH
}
}
# 2. STRING SWITCH
for ('a'..'c','1')
{
switch ($_) {
# SELF
case ($_) { ok(1) } else { ok(0) }
# NUMERIC
case (1) { ok ($_ !~ /[a-c]/) } else { ok ($_ =~ /[a-c]/) }
case (1.0) { ok ($_ !~ /[a-c]/) } else { ok ($_ =~ /[a-c]/) }
# STRING
case ('a') { ok ($_ eq 'a') } else { ok($_ ne 'a') }
case ('b') { ok ($_ eq 'b') } else { ok($_ ne 'b') }
case ('c') { ok ($_ eq 'c') } else { ok($_ ne 'c') }
case ('1') { ok ($_ eq '1') } else { ok($_ ne '1') }
case ('d') { ok (0) } else { ok (1) }
# ARRAY
case (['a','1']) { ok ($_ eq 'a' || $_ eq '1') }
else { ok ($_ ne 'a' && $_ ne '1') }
case (['z','2']) { ok (0) } else { ok(1) }
case ([]) { ok (0) } else { ok(1) }
# HASH
case ({}) { ok (0) } else { ok (1) }
case ({a=>'a', 1=>1, 2=>0}) { ok ($_ eq 'a' || $_ eq '1') }
else { ok ($_ ne 'a' && $_ ne '1') }
# SUB/BLOCK
case (sub{$_[0] eq 'a' }) { ok ($_ eq 'a') }
else { ok($_ ne 'a') }
case {$_[0] eq 'a'} { ok ($_ eq 'a') } else { ok($_ ne 'a') }
case {0} { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH
case {1} { ok (1) } else { ok (0) } # ; -> SUB, NOT HASH
}
}
# 3. ARRAY SWITCH
my $iteration = 0;
for ([],[1,'a'],[2,'b'])
{
switch ($_) {
$iteration++;
# SELF
case ($_) { ok(1) }
# NUMERIC
case (1) { ok ($iteration==2) } else { ok ($iteration!=2) }
case (1.0) { ok ($iteration==2) } else { ok ($iteration!=2) }
# STRING
case ('a') { ok ($iteration==2) } else { ok ($iteration!=2) }
case ('b') { ok ($iteration==3) } else { ok ($iteration!=3) }
case ('1') { ok ($iteration==2) } else { ok ($iteration!=2) }
# ARRAY
case (['a',2]) { ok ($iteration>=2) } else { ok ($iteration<2) }
case ([1,'a']) { ok ($iteration==2) } else { ok($iteration!=2) }
case ([]) { ok (0) } else { ok(1) }
case ([7..100]) { ok (0) } else { ok(1) }
# HASH
case ({}) { ok (0) } else { ok (1) }
case ({a=>'a', 1=>1, 2=>0}) { ok ($iteration==2) }
else { ok ($iteration!=2) }
# SUB/BLOCK
case {scalar grep /a/, @_} { ok ($iteration==2) }
else { ok ($iteration!=2) }
case (sub {scalar grep /a/, @_ }) { ok ($iteration==2) }
else { ok ($iteration!=2) }
case {0} { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH
case {1} { ok (1) } else { ok (0) } # ; -> SUB, NOT HASH
}
}
# 4. HASH SWITCH
$iteration = 0;
for ({},{a=>1,b=>0})
{
switch ($_) {
$iteration++;
# SELF
case ($_) { ok(1) } else { ok(0) }
# NUMERIC
case (1) { ok (0) } else { ok (1) }
case (1.0) { ok (0) } else { ok (1) }
# STRING
case ('a') { ok ($iteration==2) } else { ok ($iteration!=2) }
case ('b') { ok (0) } else { ok (1) }
case ('c') { ok (0) } else { ok (1) }
# ARRAY
case (['a',2]) { ok ($iteration==2) }
else { ok ($iteration!=2) }
case (['b','a']) { ok ($iteration==2) }
else { ok ($iteration!=2) }
case (['b','c']) { ok (0) } else { ok (1) }
case ([]) { ok (0) } else { ok(1) }
case ([7..100]) { ok (0) } else { ok(1) }
# HASH
case ({}) { ok (0) } else { ok (1) }
case ({a=>'a', 1=>1, 2=>0}) { ok (0) } else { ok (1) }
# SUB/BLOCK
case {$_[0]{a}} { ok ($iteration==2) }
else { ok ($iteration!=2) }
case (sub {$_[0]{a}}) { ok ($iteration==2) }
else { ok ($iteration!=2) }
case {0} { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH
case {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} )
{
switch ($_) {
$iteration++;
# SELF
case ($_) { ok(1) } else { ok(0) }
# NUMERIC
case (1) { ok ($iteration<=2) } else { ok ($iteration>2) }
case (1.0) { ok ($iteration<=2) } else { ok ($iteration>2) }
case (1.1) { ok ($iteration==1) } else { ok ($iteration!=1) }
# STRING
case ('a') { ok ($iteration==1) } else { ok ($iteration!=1) }
case ('b') { ok ($iteration==1) } else { ok ($iteration!=1) }
case ('c') { ok ($iteration==1) } else { ok ($iteration!=1) }
case ('1') { ok ($iteration<=2) } else { ok ($iteration>2) }
# ARRAY
case ([1, 'a']) { ok ($iteration<=2) }
else { ok ($iteration>2) }
case (['b','a']) { ok ($iteration==1) }
else { ok ($iteration!=1) }
case (['b','c']) { ok ($iteration==1) }
else { ok ($iteration!=1) }
case ([]) { ok ($iteration==1) } else { ok($iteration!=1) }
case ([7..100]) { ok ($iteration==1) }
else { ok($iteration!=1) }
# HASH
case ({}) { ok ($iteration==1) } else { ok ($iteration!=1) }
case ({a=>'a', 1=>1, 2=>0}) { ok ($iteration<=2) }
else { ok ($iteration>2) }
# SUB/BLOCK
case {$_[0]->{a}} { ok (0) } else { ok (1) }
case (sub {$_[0]{a}}) { ok (0) } else { ok (1) }
case {0} { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH
case {1} { ok (0) } else { ok (1) } # ; -> SUB, NOT HASH
}
}
# NESTED SWITCHES
for my $count (1..3)
{
switch ([9,"a",11]) {
case (qr/\d/) {
switch ($count) {
case (1) { ok($count==1) }
else { ok($count!=1) }
case ([5,6]) { ok(0) } else { ok(1) }
}
}
ok(1) case (11);
}
}
--- NEW FILE: nested.t ---
BEGIN {
if ($ENV{PERL_CORE}) {
chdir('t') if -d 't';
@INC = qw(../lib);
}
}
use Switch;
print "1..4\n";
my $count = 1;
for my $count (1..3, 'four')
{
switch ([$count])
{
=pod
=head1 Test
We also test if Switch is POD-friendly here
=cut
case qr/\d/ {
switch ($count) {
case 1 { print "ok 1\n" }
case [2,3] { print "ok $count\n" }
}
}
case 'four' { print "ok 4\n" }
}
}
__END__
=head1 Another test
Still friendly???
=cut
--- NEW FILE: given.t ---
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;
}
}
More information about the dslinux-commit
mailing list