sub
shuffle {
my
@out
;
while
(
@_
) {
push
@out
,
splice
@_
,
rand
(
@_
), 1 };
return
@out
}
sub
arrays_match {
my
$array
=
shift
;
CANDIDATE:
foreach
my
$candidate
(
@_
) {
next
CANDIDATE
unless
(
$#$array
=
$#$candidate
);
foreach
my
$idx
( 0 ..
$#$array
) {
next
CANDIDATE
unless
(
$array
->[
$idx
] eq
$candidate
->[
$idx
]
or
$array
->[
$idx
] != 0 and
$array
->[
$idx
] ==
$candidate
->[
$idx
] );
}
return
1;
}
return
}
sub
test_sort_cases {
my
@tests
=
@_
;
foreach
my
$test
(
@tests
) {
my
@values
= @{
$test
->{
values
} };
my
@acceptable
= (
$test
->{okvals} ? @{
$test
->{okvals} } :
$test
->{okidxs} ?
map
({[
map
$values
[
$_
-1],
@$_
]} @{
$test
->{okidxs} }) :
$test
->{
values
}
);
my
@params
= @{
$test
->{sorted} };
my
$sort_function
= Data::Sorting::sort_function(
@params
);
unless
( arrays_match( [
$sort_function
->(
@values
) ], \
@values
) ) {
ok( 0,
"not stable"
);
next
;
};
my
@rc
;
foreach
( 1 .. 10 ) {
my
@shuffled
= shuffle(
@values
);
my
@sorted
=
$sort_function
->(
@shuffled
);
push
@rc
, arrays_match( \
@sorted
,
@acceptable
);
}
ok( !
grep
{ !
$_
}
@rc
,
"not repeatable"
);
}
}
1;