sort.t revision 7c478bd95313f5f23a4c958a745db2134aa03244
#!./perl
BEGIN {
chdir 't' if -d 't';
}
use warnings;
print "1..57\n";
# these shouldn't hang
{
}
# Beware: in future this may become hairier because of possible
# collation complications: qw(A a B c) can be sorted at least as
# any of the following
#
# A a B b
# A B a b
# a b A B
# a A b B
#
# All the above orders make sense.
#
# That said, EBCDIC sorts all small letters first, as opposed
# to ASCII which sorts all big letters first.
$expected = $upperfirst ?
'AbelAxedCaincatchaseddoggonepunishedtoxyz' :
'catchaseddoggonepunishedtoxyzAbelAxedCain' ;
@a = ();
@b = reverse @a;
@a = (1);
@b = reverse @a;
@a = (1,2);
@b = reverse @a;
@a = (1,2,3);
@b = reverse @a;
@a = (1,2,3,4);
@b = reverse @a;
@a = (10,2,3,4);
@b = sort {$a <=> $b;} @a;
# literals, combinations
print "# x = '@b'\n";
print "# x = '@b'\n";
print "# x = '@b'\n";
print "# x = '@b'\n";
# redefining sort sub inside the sort sub should fail
# redefining sort subs outside the sort should not fail
print $@ ? "not ok 18\n" : "ok 18\n";
{
}
{
*twoface = sub {
eval 'sub twoface { $a <=> $b }';
$a <=> $b;
};
}
print $@ ? "$@" : "not ok 21\n";
eval <<'CODE';
CODE
print $@ ? "not ok 22\n# $@" : "ok 22\n";
my @result = sort 'one', 'two';
CODE
{
my $sortglobr = \*Backwards;
@b = sort $sortglobr 4,1,3,2;
}
{
my $sortsub = \&Backwards_stacked;
my $sortglob = *Backwards_stacked;
my $sortglobr = \*Backwards_stacked;
@b = sort $sortglobr 4,1,3,2;
}
{
local $sortglobr = \*Backwards;
@b = sort $sortglobr 4,1,3,2;
}
{
local $sortsub = \&Backwards_stacked;
local $sortglob = *Backwards_stacked;
local $sortglobr = \*Backwards_stacked;
@b = sort $sortglobr 4,1,3,2;
}
## exercise sort builtins... ($a <=> $b already tested)
@a = ( 5, 19, 1996, 255, 90 );
@b = sort {
my $dummy; # force blockness
return $b <=> $a
} @a;
print "# x = '@b'\n";
{
use integer;
@b = sort { $a <=> $b } @a;
print "# x = '@b'\n";
@b = sort { $b <=> $a } @a;
print "# x = '@b'\n";
}
# test that an optimized-away comparison block doesn't take any other
# arguments away with it
# test sorting in non-main package
@a = ( 5, 19, 1996, 255, 90 );
@b = sort { $b <=> $a } @a;
print "# x = '@b'\n";
@b = sort main::Backwards_stacked @a;
print "# x = '@b'\n";
# check if context for sort arguments is handled right
$test = 49;
sub test_if_list {
++$test;
}
my $m = sub { $a <=> $b };
sub test_if_scalar {
++$test;
}
$m = \&test_if_scalar;
sub cxt_six { sort test_if_scalar 1,2 }
# test against a reentrancy bug
{
}
{
@b = sort {
$a <=> $b
} qw/4 3 1 2/;
print "# x = '@b'\n";
}