#!/usr/bin/perl -w
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}
);
}
{
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
);
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
);
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"
;
my
@pipeline
= ();
my
@got
= ();
while
(
defined
(
my
$job
=
$scheduler
->get_job ) ) {
if
(
$job
->is_spinner ||
@pipeline
>=
$jobs
) {
die
"Oops! Spinner!"
unless
@pipeline
;
my
$done
=
shift
@pipeline
;
$done
->finish;
}
next
if
$job
->is_spinner;
push
@pipeline
,
$job
;
push
@got
,
$job
->filename;
}
is_deeply [
sort
@got
], [
sort
@$tests
],
"$name: got all tests"
;
}