use Test::More tests => @TestSizes * 2 # sort() tests
* 4 # number of pragmas to test
+ 1 # extra test for qsort instability
- + 3; # tests for sort::current
+ + 3 # tests for sort::current
+ + 3; # tests for "defaults" and "no sort"
# Generate array of specified size for testing sort.
#
sub checkorder {
my $aref = shift;
my $status = ''; # so far, so good
- my $i;
+ my ($i, $disorder);
for ($i = 0; $i < $#$aref; ++$i) {
- next if ($aref->[$i] lt $aref->[$i+1]);
- $status = (substr($aref->[$i], 0, $RootWidth) eq
- substr($aref->[$i+1], 0, $RootWidth)) ?
- "Instability" : "Disorder";
- $status .= " at element $i between $aref->[$i] and $aref->[$i+1]";
- last;
+ # Equality shouldn't happen, but catch it in the contents check
+ next if ($aref->[$i] le $aref->[$i+1]);
+ $disorder = (substr($aref->[$i], 0, $RootWidth) eq
+ substr($aref->[$i+1], 0, $RootWidth)) ?
+ "Instability" : "Disorder";
+ # Keep checking if merely unstable... disorder is much worse.
+ $status =
+ "$disorder at element $i between $aref->[$i] and $aref->[$i+1]";
+ last unless ($disorder eq "Instability");
}
return $status;
}
$status = checkequal(\@sorted, $unsorted);
is($status, '', "contents ok for size $ts");
}
+ # If the following test (#58) fails, see the comments in pp_sort.c
+ # for Perl_sortsv().
if ($expect_unstable) {
ok($unstable_num > 0, 'Instability ok');
}
# XXX We're using this eval "..." trick to force recompilation,
# to ensure that the correct pragma is enabled when main() is run.
-# Currently 'use sort' modifies $^H{SORT} at compile-time, but
-# pp_sort() fetches its value at run-time : thus the lexical scoping
-# of %^H is of no utility.
+# Currently 'use sort' modifies $sort::hints at compile-time, but
+# pp_sort() fetches its value at run-time.
# The order of those evals is important.
eval q{
main(0);
};
die $@ if $@;
+
+# Tests added to check "defaults" subpragma, and "no sort"
+
+eval q{
+ no sort qw(_qsort);
+ is(sort::current(), 'stable', 'sort::current after no _qsort');
+};
+die $@ if $@;
+
+eval q{
+ use sort qw(defaults _qsort);
+ is(sort::current(), 'quicksort', 'sort::current after defaults _qsort');
+};
+die $@ if $@;
+
+eval q{
+ use sort qw(defaults stable);
+ is(sort::current(), 'stable', 'sort::current after defaults stable');
+};
+die $@ if $@;