#!/usr/bin/perl -w
use strict;
use warnings;
use lib 't/lib';
use Test::More;
use TAP::Parser::Scheduler;
my $perl_rules = {
par => [
{ seq => '../ext/DB_File/t/*' },
{ seq => '../ext/IO_Compress_Zlib/t/*' },
{ seq => '../lib/CPANPLUS/*' },
{ seq => '../lib/ExtUtils/t/*' },
'*'
]
};
my $incomplete_rules = { par => [ { seq => [ '*A', '*D' ] } ] };
my $some_tests = [
'../ext/DB_File/t/A',
'foo',
'../ext/DB_File/t/B',
'../ext/DB_File/t/C',
'../lib/CPANPLUS/D',
'../lib/CPANPLUS/E',
'bar',
'../lib/CPANPLUS/F',
'../ext/DB_File/t/D',
'../ext/DB_File/t/E',
'../ext/DB_File/t/F',
];
my @schedule = (
{ name => 'Sequential, no rules',
tests => $some_tests,
jobs => 1,
},
{ name => 'Sequential, Perl rules',
rules => $perl_rules,
tests => $some_tests,
jobs => 1,
},
{ name => 'Two in parallel, Perl rules',
rules => $perl_rules,
tests => $some_tests,
jobs => 2,
},
{ name => 'Massively parallel, Perl rules',
rules => $perl_rules,
tests => $some_tests,
jobs => 1000,
},
{ name => 'Massively parallel, no rules',
tests => $some_tests,
jobs => 1000,
},
{ name => 'Sequential, incomplete rules',
rules => $incomplete_rules,
tests => $some_tests,
jobs => 1,
},
{ name => 'Two in parallel, incomplete rules',
rules => $incomplete_rules,
tests => $some_tests,
jobs => 2,
},
{ name => 'Massively parallel, incomplete rules',
rules => $incomplete_rules,
tests => $some_tests,
jobs => 1000,
},
);
plan tests => @schedule * 2 + 266;
for my $test (@schedule) {
test_scheduler(
$test->{name},
$test->{tests},
$test->{rules},
$test->{jobs}
);
}
# An ad-hoc test
{
my @tests = qw(
A1 A2 A3 B1 C1 C8 C5 C7 C4 C6 C3 C2 C9 D1 D2 D3 E3 E2 E1
);
my $rules = {
par => [
{ seq => 'A*' },
{ par => 'B*' },
{ seq => [ 'C1', 'C2' ] },
{ par => [
{ seq => [ 'C3', 'C4', 'C5' ] },
{ seq => [ 'C6', 'C7', 'C8' ] }
]
},
{ seq => [
{ par => ['D*'] },
{ par => ['E*'] }
]
},
]
};
my $scheduler = TAP::Parser::Scheduler->new(
tests => \@tests,
rules => $rules
);
# diag $scheduler->as_string;
my $A1 = ok_job( $scheduler, 'A1' );
my $B1 = ok_job( $scheduler, 'B1' );
finish($A1);
my $A2 = ok_job( $scheduler, 'A2' );
my $C1 = ok_job( $scheduler, 'C1' );
finish( $A2, $C1 );
my $A3 = ok_job( $scheduler, 'A3' );
my $C2 = ok_job( $scheduler, 'C2' );
finish( $A3, $C2 );
my $C3 = ok_job( $scheduler, 'C3' );
my $C6 = ok_job( $scheduler, 'C6' );
my $D1 = ok_job( $scheduler, 'D1' );
my $D2 = ok_job( $scheduler, 'D2' );
finish($C6);
my $C7 = ok_job( $scheduler, 'C7' );
my $D3 = ok_job( $scheduler, 'D3' );
ok_job( $scheduler, '#' );
ok_job( $scheduler, '#' );
finish( $D3, $C3, $D1, $B1 );
my $C4 = ok_job( $scheduler, 'C4' );
finish( $C4, $C7 );
my $C5 = ok_job( $scheduler, 'C5' );
my $C8 = ok_job( $scheduler, 'C8' );
ok_job( $scheduler, '#' );
finish($D2);
my $E3 = ok_job( $scheduler, 'E3' );
my $E2 = ok_job( $scheduler, 'E2' );
my $E1 = ok_job( $scheduler, 'E1' );
finish( $E1, $E2, $E3, $C5, $C8 );
my $C9 = ok_job( $scheduler, 'C9' );
ok_job( $scheduler, undef );
}
{
my @tests = ();
for my $t ( 'A' .. 'Z' ) {
push @tests, map {"$t$_"} 1 .. 9;
}
my $rules = { par => [ map { { seq => "$_*" } } 'A' .. 'Z' ] };
my $scheduler = TAP::Parser::Scheduler->new(
tests => \@tests,
rules => $rules
);
# diag $scheduler->as_string;
for my $n ( 1 .. 9 ) {
my @got = ();
push @got, ok_job( $scheduler, "$_$n" ) for 'A' .. 'Z';
ok_job( $scheduler, $n == 9 ? undef : '#' );
finish(@got);
}
}
sub finish { $_->finish for @_ }
sub ok_job {
my ( $scheduler, $want ) = @_;
my $job = $scheduler->get_job;
if ( !defined $want ) {
ok !defined $job, 'undef';
}
elsif ( $want eq '#' ) {
ok $job->is_spinner, 'spinner';
}
else {
is $job->filename, $want, $want;
}
return $job;
}
sub test_scheduler {
my ( $name, $tests, $rules, $jobs ) = @_;
ok my $scheduler = TAP::Parser::Scheduler->new(
tests => $tests,
defined $rules ? ( rules => $rules ) : (),
),
"$name: new";
# diag $scheduler->as_string;
my @pipeline = ();
my @got = ();
while ( defined( my $job = $scheduler->get_job ) ) {
# diag $scheduler->as_string;
if ( $job->is_spinner || @pipeline >= $jobs ) {
die "Oops! Spinner!" unless @pipeline;
my $done = shift @pipeline;
$done->finish;
# diag "Completed ", $done->filename;
}
next if $job->is_spinner;
# diag " Got ", $job->filename;
push @pipeline, $job;
push @got, $job->filename;
}
is_deeply [ sort @got ], [ sort @$tests ], "$name: got all tests";
}