|
use open ':std' => ':utf8' ;
my %test_cases = (
valid => [
{
data => [
],
},
{
data => [
[1, 2],
[1, 3],
[1, 4],
],
},
{
data => [
[1, 2],
[2, 3],
[1, 4],
[1, 5],
[4, 5],
[3, 4],
],
},
{
data => [
[ 'aa' , 'bb' ],
[ 'cc' , 'dd' ],
],
},
{
data => [
[ 'a' , 'b' ],
[ 'a' , 'c' ],
[ 'c' , 'x' ],
[ 'b' , 'x' ],
[ 'x' , 'y' ],
[ 'y' , 'z' ],
],
},
{
data => [
[ 'арбуз' , 'белка' ],
[ 'арбуз' , 'вагон' ],
[ 'вагон' , 'хамелеон' ],
[ 'белка' , 'хамелеон' ],
[ 'хамелеон' , 'юрта' ],
[ 'юрта' , 'янтарь' ],
],
},
],
invalid => [
{
name => 'not an arrref' ,
data => [
{},
],
},
{
name => '3 elements in a row' ,
data => [
[1, 2, 3],
[1, 2],
[2, 3],
],
},
{
name => '1 elements in a row' ,
data => [
[1, 2],
[1],
[2, 3],
],
},
{
name => '1 elements in a row x2' ,
data => [
[1, 2],
[1],
[4],
[2, 3],
],
},
{
name => '5 elements in a row' ,
data => [
[1, 2],
[2, 3],
[1, 2, 3, 4, 5],
],
},
{
name => '6 elements in a row' ,
data => [
[1, 2, 3, 4, 5, 6],
[2, 3],
[4, 5],
],
},
{
name => 'a 2-loop' ,
data => [
[1, 2],
[2, 1],
],
},
{
name => 'a 2-loop + some other edges' ,
data => [
[1, 4],
[1, 2],
[2, 3],
[2, 1],
[4, 5],
],
},
{
name => 'a 3-loop' ,
data => [
[1, 2],
[2, 3],
[3, 1],
],
},
{
name => 'a 3-loop + some other edges' ,
data => [
[1, 2],
[1, 4],
[2, 3],
[3, 1],
[2, 3],
[4, 5],
],
},
],
);
for my $tc ( @{ $test_cases {valid}} ){
my $sorted = tsort( $tc ->{data});
my %index = map { $sorted ->[ $_ ] => $_ } ( 0 .. scalar @$sorted - 1);
my @partial_order = map { @$_ } @{ $tc ->{data}};
while ( @partial_order > 0){
my $less = shift @partial_order ;
my $greater = shift @partial_order ;
ok( exists $index { $less });
ok( exists $index { $greater });
ok( $index { $less } < $index { $greater }, "$less < $greater" );
}
}
for my $tc ( @{ $test_cases {invalid}} ){
dies_ok {tsort( $tc ->{data}) } $tc ->{name};
}
done_testing();
|