Commit 8a7e6259 authored by Kevin Tew's avatar Kevin Tew

Backoff and function documentation

parent debd552d
ImageTest
Parameters
OldTests
DOCS TODO DOCS TODO
retry example backoff example
TODO TODO
TIMEOUT of XMLRPC Calls TIMEOUT of XMLRPC Calls
...@@ -18,11 +22,10 @@ STILL MESSY ...@@ -18,11 +22,10 @@ STILL MESSY
EXPAND CURRENT IMPLEMENTATION EXPAND CURRENT IMPLEMENTATION
event subsystem event subsystem
parallel support (custom test harness) Test::Builder support
LATER LATER
Client.pm duplicate code elimination - Maybe this would make the code too unreadable Client.pm duplicate code elimination - Maybe this would make the code too unreadable
TestSuite::Experiment::Macros should be a monadic language like JQuery
test groupings test groupings
Large External Tars and Resources for experiements Large External Tars and Resources for experiements
buildup, teardown using Test::Class buildup, teardown using Test::Class
......
...@@ -73,9 +73,6 @@ has 'itemid' => ( is => 'rw'); ...@@ -73,9 +73,6 @@ has 'itemid' => ( is => 'rw');
sub is_error { shift->error; } sub is_error { shift->error; }
use SemiModern::Perl;
use Mouse;
package TestBed::ForkFramework; package TestBed::ForkFramework;
sub forkit { sub forkit {
my ($parent_worker, $worker) = @_; my ($parent_worker, $worker) = @_;
...@@ -95,11 +92,6 @@ sub forkit { ...@@ -95,11 +92,6 @@ sub forkit {
} }
} }
sub fork_child_redir {
my ($worker) = @_;
fork_redir( sub { return @_; }, $worker);
}
sub fork_redir { sub fork_redir {
my ($parent_worker, $worker) = @_; my ($parent_worker, $worker) = @_;
my $redir = TestBed::ForkFramework::Redir->new; my $redir = TestBed::ForkFramework::Redir->new;
...@@ -116,6 +108,11 @@ sub fork_redir { ...@@ -116,6 +108,11 @@ sub fork_redir {
); );
} }
sub fork_child_redir {
my ($worker) = @_;
fork_redir( sub { return @_; }, $worker);
}
package TestBed::ForkFramework::Scheduler; package TestBed::ForkFramework::Scheduler;
use SemiModern::Perl; use SemiModern::Perl;
use Mouse; use Mouse;
...@@ -123,24 +120,12 @@ use IO::Select; ...@@ -123,24 +120,12 @@ use IO::Select;
use Carp; use Carp;
use Data::Dumper; use Data::Dumper;
has 'workers' => ( is => 'rw', default => sub { [] }); has 'workers' => ( is => 'rw', default => sub { [] });
has 'results' => ( is => 'rw', default => sub { TestBed::ForkFramework::Results->new; }); has 'results' => ( is => 'rw', default => sub { TestBed::ForkFramework::Results->new; });
has 'selector' => ( is => 'rw', default => sub { IO::Select->new; }); has 'selector' => ( is => 'rw', default => sub { IO::Select->new; });
has 'items' => ( is => 'rw', isa => 'ArrayRef', required => 1 ); has 'selecttimeout' => ( is => 'rw', default => 10 ); #seconds
has 'proc' => ( is => 'rw', isa => 'CodeRef' , required => 1 ); has 'proc' => ( is => 'rw', isa => 'CodeRef' , required => 1 );
sub _gen_iterator {
my $items = shift;
my @ar = @$items;
my $pos = 0;
return sub {
return if $pos >= @ar;
my @r = ( $pos, $ar[$pos] );
$pos++;
return @r;
}
}
sub wait_for_all_children_to_exit { sub wait_for_all_children_to_exit {
my ($self) = @_; my ($self) = @_;
...@@ -154,10 +139,10 @@ sub workloop { ...@@ -154,10 +139,10 @@ sub workloop {
say "spawnWorker $jobid" if $FFDEBUG; say "spawnWorker $jobid" if $FFDEBUG;
$self->fffork($jobid); $self->fffork($jobid);
} }
say "CALL SELECT" if $FFDEBUG; my $selectrc = $self->process_select; say "CALL SELECT" if $FFDEBUG;
if ($self->selectloop) { my $schedulerc = $self->schedule;
redo LOOP;
} if ($selectrc || $schedulerc) { redo LOOP; }
} }
$self->wait_for_all_children_to_exit; $self->wait_for_all_children_to_exit;
...@@ -167,12 +152,12 @@ sub workloop { ...@@ -167,12 +152,12 @@ sub workloop {
use constant SELECT_HAS_HANDLES => 1; use constant SELECT_HAS_HANDLES => 1;
use constant SELECT_NO_HANDLES => 0; use constant SELECT_NO_HANDLES => 0;
sub selectloop { sub process_select {
my ($self) = @_; my ($self) = @_;
my $selector = $self->selector; my $selector = $self->selector;
if ($selector->count) { if ($selector->count) {
eval { eval {
for my $r ($selector->can_read) { for my $r ($selector->can_read($self->selecttimeout)) {
my ($rh, $wh, $eof, $ch) = @$r; my ($rh, $wh, $eof, $ch) = @$r;
if (defined (my $result = $ch->receive)) { if (defined (my $result = $ch->receive)) {
$self->handleResult($result); $self->handleResult($result);
...@@ -238,19 +223,29 @@ sub fffork { ...@@ -238,19 +223,29 @@ sub fffork {
} }
} }
sub doItem { my ($s, $itemid) = @_; $s->proc->($s->items->[$itemid]); } sub doItem { die "HAVE TO IMPLEMENT doItem"; }
sub handleResult { recordResult(@_); } sub handleResult { recordResult(@_); }
sub recordResult { shift->results->handle_result(shift); } sub recordResult { shift->results->handle_result(shift); }
sub schedule { 0; }
package TestBed::ForkFramework::ForEach; package TestBed::ForkFramework::ForEach;
use SemiModern::Perl; use SemiModern::Perl;
use Mouse; use Mouse;
has 'iter' => ( isa => 'CodeRef' , is => 'rw', required => 1); has 'maxworkers' => ( is => 'rw', isa => 'Int' , default => 4);
has 'currworkers' => ( is => 'rw', isa => 'Int' , default => 0);
has 'iter' => ( is => 'rw', isa => 'CodeRef' , required => 1);
has 'items' => ( is => 'rw', isa => 'ArrayRef', required => 1 );
extends 'TestBed::ForkFramework::Scheduler'; extends 'TestBed::ForkFramework::Scheduler';
sub spawnWorker { shift->nextJob; } sub spawnWorker {
my $s = shift;
return if ($s->currworkers >= $s->maxworkers);
$s->{'currworkers'}++;
$s->nextJob;
}
sub nextJob { sub nextJob {
my @res = shift->iter->(); my @res = shift->iter->();
$res[0]; $res[0];
...@@ -258,50 +253,55 @@ sub nextJob { ...@@ -258,50 +253,55 @@ sub nextJob {
sub work { sub work {
my ($proc, $items) = @_; my ($proc, $items) = @_;
my $s = TestBed::ForkFramework::ForEach->new( return max_work(scalar @$items, $proc, $items);
'items' => $items,
'proc' => $proc,
'iter' => TestBed::ForkFramework::Scheduler::_gen_iterator($items),
);
$s->workloop;
} }
package TestBed::ForkFramework::MaxWorkersScheduler; sub _gen_iterator {
use SemiModern::Perl; my $items = shift;
use Mouse; my @ar = @$items;
my $pos = 0;
has 'maxworkers' => ( isa => 'Int' , is => 'rw', default => 4); return sub {
has 'pos' => ( isa => 'Int' , is => 'rw', default => 0); return if $pos >= @ar;
has 'currworkers' => ( isa => 'Int' , is => 'rw', default => 0); my @r = ( $pos, $ar[$pos] );
$pos++;
return @r;
}
}
extends 'TestBed::ForkFramework::Scheduler'; sub max_work {
sub work {
my ($max_workers, $proc, $items) = @_; my ($max_workers, $proc, $items) = @_;
my $s = TestBed::ForkFramework::MaxWorkersScheduler->new( my $s = TestBed::ForkFramework::ForEach->new(
'maxworkers' => $max_workers, 'maxworkers' => $max_workers,
'items' => $items, 'items' => $items,
'proc' => $proc, 'proc' => $proc,
'iter' => _gen_iterator($items),
); );
$s->workloop; $s->workloop;
} }
sub spawnWorker { sub doItem { my ($s, $itemid) = @_; $s->proc->($s->items->[$itemid]); }
my $s = shift;
return if ($s->currworkers >= $s->maxworkers);
$s->{'currworkers'}++;
$s->nextJob;
}
sub nextJob { package TestBed::ForkFramework::WeightedScheduler::Task;
my $s = shift; use SemiModern::Perl;
my $pos = $s->pos; use Mouse;
return if ($pos >= scalar @{ $s->items });
$s->{'pos'}++; has 'id' => (is => 'rw');
$pos; has 'item' => (is => 'rw');
has 'runtime' => (is => 'rw', default => 0);
has 'weight' => (is => 'rw', default => 0);
sub build {
shift;
return TestBed::ForkFramework::WeightedScheduler::Task->new(
id => shift,
item => shift,
weight => shift
);
} }
package TestBed::ForkFramework::RateScheduler; sub ready { return time >= shift->runtime; }
package TestBed::ForkFramework::WeightedScheduler;
use SemiModern::Perl; use SemiModern::Perl;
use Data::Dumper; use Data::Dumper;
use Tools; use Tools;
...@@ -309,13 +309,31 @@ use Mouse; ...@@ -309,13 +309,31 @@ use Mouse;
extends 'TestBed::ForkFramework::Scheduler'; extends 'TestBed::ForkFramework::Scheduler';
has 'ids' => ( isa => 'Int' , is => 'rw', default => 0);
has 'maxnodes' => ( isa => 'Int' , is => 'rw', default => 20); has 'maxnodes' => ( isa => 'Int' , is => 'rw', default => 20);
has 'currnodes' => ( isa => 'Int' , is => 'rw', default => 0); has 'currnodes' => ( isa => 'Int' , is => 'rw', default => 0);
has 'schedule' => ( isa => 'ArrayRef' , is => 'rw', required => 1); has 'runqueue' => ( isa => 'ArrayRef' , is => 'rw', default => sub { [] } );
has 'weight' => ( isa => 'ArrayRef' , is => 'rw', required => 1); has 'tasks' => ( isa => 'ArrayRef' , is => 'rw', default => sub { [] } );
has 'retryItems'=> ( isa => 'ArrayRef' , is => 'rw', default => sub { [] } ); has 'retryTasks'=> ( isa => 'ArrayRef' , is => 'rw', default => sub { [] } );
has 'waitTasks' => ( isa => 'ArrayRef' , is => 'rw', default => sub { [] } );
has 'inRetry' => ( isa => 'Int' , is => 'rw', default => 0); has 'inRetry' => ( isa => 'Int' , is => 'rw', default => 0);
sub nextID {
my ($s) = @_;
my $id = $s->ids;
$s->ids($id + 1);
$id;
}
sub task { shift->tasks->[shift]; }
sub add_task {
my ($s, $item, $weight) = @_;
my $id = $s->nextID;
my $task = TestBed::ForkFramework::WeightedScheduler::Task->build($id, $item, $weight);
push @{$s->runqueue}, $task;
$s->tasks->[$id] = $task;
}
sub incr_currnodes { sub incr_currnodes {
my ($s, $quantity) = @_; my ($s, $quantity) = @_;
...@@ -323,47 +341,55 @@ sub incr_currnodes { ...@@ -323,47 +341,55 @@ sub incr_currnodes {
} }
sub return_node_resources { sub return_node_resources {
my ($s, $itemid) = @_; my ($s, $task) = @_;
$s->{'currnodes'} -= $s->weight->[$itemid]; $s->{'currnodes'} -= $task->weight;
}
sub sort_runqueue {
my ($s) = @_;
$s->runqueue( [ sort { $a->weight <=> $b->weight } @{$s->runqueue} ] );
} }
sub work { sub work {
my ($max_nodes, $proc, $schedule, $items) = @_; my ($maxnodes, $proc, $items_weights) = @_;
my $s = TestBed::ForkFramework::RateScheduler->new( my $s = TestBed::ForkFramework::WeightedScheduler->new(
'maxnodes' => $max_nodes, maxnodes => $maxnodes,
'items' => $items, proc => $proc,
'proc' => $proc, );
'schedule' => $schedule, $s->add_task($_->[0], $_->[1]) for (@$items_weights);
'weight' => [ map { $_->[0] } (sort { $a->[1] <=> $b->[1] } @$schedule) ], $s->run;
); }
say toperl("SCHEDULE", $s->schedule) if $FFDEBUG;
say toperl("WEIGHTS", $s->weight) if $FFDEBUG; sub run {
my ($s) = @_;
$s->sort_runqueue;
$s->workloop; $s->workloop;
say("RETRYING") if $FFDEBUG; say("RETRYING") if $FFDEBUG;
$s->inRetry(1); $s->inRetry(1);
$s->schedule( [ map { [$s->weight->[$_], $_] } @{$s->retryItems} ] ); $s->runqueue( [ @{$s->retryTasks} ] );
$s->retryItems([]); $s->retryTasks([]);
say toperl("SCHEDULE", $s->schedule) if $FFDEBUG;
say toperl("WEIGHTS", $s->weight) if $FFDEBUG; $s->sort_runqueue;
$s->workloop; $s->workloop;
} }
sub find_largest_item { sub find_largest_item {
my ($s, $max_size) = @_; my ($s, $max_weight) = @_;
my $found = undef; my $found = undef;
#find largest item that is small enough #find largest task that is small enough
for (@{ $s->schedule }) { for (@{ $s->runqueue }) {
my $itemsize = $_->[0]; my $item_weight = $_->weight;
last if $itemsize > $max_size; last if $item_weight > $max_weight;
next if ($found and $found->[0] >= $itemsize); next if ($found and $found->weight >= $item_weight);
$found = $_ if $itemsize <= $max_size; $found = $_ if $item_weight <= $max_weight;
} }
#remove found from schedule #remove found from runqueue
if (defined $found) { if (defined $found) {
$s->schedule( [ grep { !($_->[1] == $found->[1]) } @{ $s->schedule} ]); $s->runqueue( [ grep { !($_->id == $found->id) } @{ $s->runqueue} ]);
} }
return $found; return $found;
...@@ -373,28 +399,28 @@ sub spawnWorker { shift->nextJob; } ...@@ -373,28 +399,28 @@ sub spawnWorker { shift->nextJob; }
sub nextJob { sub nextJob {
my $s = shift; my $s = shift;
my $max_size = $s->maxnodes - $s->currnodes; my $max_size = $s->maxnodes - $s->currnodes;
my $tuple = $s->find_largest_item($max_size); my $task = $s->find_largest_item($max_size);
if ($tuple) { if ($task) {
my ($e_node_size, $eindex) = @$tuple; say(sprintf("found %s size %s max_size $max_size currnodes %s maxnodes %s newcurrnodes %s", $task->id, $task->weight, $s->currnodes, $s->maxnodes, $s->currnodes + $task->weight)) if $FFDEBUG;
say(sprintf("found %s size %s max_size $max_size currnodes %s maxnodes %s newcurrnodes %s", $eindex, $e_node_size, $s->currnodes, $s->maxnodes, $s->currnodes +$e_node_size)) if $FFDEBUG; $s->{'currnodes'} += $task->weight;
$s->{'currnodes'} += $e_node_size; return $task->id;
return $eindex;
} }
else { return; } else { return; }
} }
sub doItem { my ($s, $taskid) = @_; $s->proc->($s->tasks->[$taskid]->item); }
use TestBed::ParallelRunner::ErrorConstants; use TestBed::ParallelRunner::ErrorConstants;
sub return_and_report { sub return_and_report {
my ($s, $result) = @_; my ($s, $result) = @_;
$s->recordResult($result); $s->recordResult($result);
$s->return_node_resources($result->itemid); $s->return_node_resources($s->task($result->itemid));
} }
sub handleResult { sub handleResult {
my ($s, $result) = @_; my ($s, $result) = @_;
my $executor = $s->items->[$result->itemid]; my $executor = $s->tasks->[$result->itemid]->item;
if ($executor->can('handleResult')) { if ($executor->can('handleResult')) {
my $rc = $executor->handleResult($s, $result); my $rc = $executor->handleResult($s, $result);
if ($rc == RETURN_AND_REPORT) { $s->return_and_report($result) } if ($rc == RETURN_AND_REPORT) { $s->return_and_report($result) }
...@@ -404,17 +430,40 @@ sub handleResult { ...@@ -404,17 +430,40 @@ sub handleResult {
} }
} }
sub schedule_at {
my ($s, $result, $runtime) = @_;
my $task = $s->task($result->itemid);
$task->runtime($runtime);
$s->return_node_resources($task);
push @{ $s->waitTasks }, $task;
}
sub schedule {
my ($s) = @_;
my $new_wait_list = [];
#iterate through waiting tasks adding ready tasks to runqueue
for (@{$s->waitTasks}) {
my $id = $_->id;
if ($_->ready) { push @{$s->runqueue}, $_; }
else { push @$new_wait_list, $_; }
}
$s->sort_runqueue;
$s->waitTasks($new_wait_list);
return (scalar @$new_wait_list) || scalar (@{$s->runqueue});
}
sub retry { sub retry {
my ($s, $result) = @_; my ($s, $result) = @_;
my $itemid = $result->itemid; my $itemid = $result->itemid;
if (!$s->inRetry) { if (!$s->inRetry) {
push @{ $s->retryItems }, $itemid; push @{ $s->retryTasks }, $s->task($itemid);
$s->return_node_resources($itemid); $s->return_node_resources($s->task($itemid));
say "RETRYING item# $itemid"; # say "RETRYING task# $itemid";
return 1; return 1;
} }
else { else {
say "DONE RETRYING"; # say "DONE RETRYING";
$s->return_and_report($result); $s->return_and_report($result);
} }
} }
......
...@@ -59,38 +59,53 @@ sub runtests { ...@@ -59,38 +59,53 @@ sub runtests {
$concurrent_node_count_usage ||= $TBConfig::concurrent_node_usage; $concurrent_node_count_usage ||= $TBConfig::concurrent_node_usage;
#prerun step #prerun step
my $result = TestBed::ForkFramework::MaxWorkersScheduler::work($concurrent_pre_runs, sub { shift->prep }, $Executors); my $result = TestBed::ForkFramework::ForEach::max_work($concurrent_pre_runs, sub { shift->prep }, $Executors);
if ($result->has_errors) { if ($result->has_errors) {
sayd($result->errors); sayd($result->errors);
warn 'TestBed::ParallelRunner::runtests died during test prep'; warn 'TestBed::ParallelRunner::runtests died during test prep';
} }
#create schedule step
my @schedule; my $workscheduler = TestBed::ForkFramework::WeightedScheduler->new(
items => $Executors,
proc => &tap_wrapper,
maxnodes => $concurrent_node_count_usage,
);
#add taskss to scheduler step
my $total_test_count = 0;
for (@{$result->successes}) { for (@{$result->successes}) {
my $item_id = $_->itemid; my $itemId = $_->itemid;
my $executor = $Executors->[$itemId];
my $maximum_nodes = $_->result->{'maximum_nodes'}; my $maximum_nodes = $_->result->{'maximum_nodes'};
my $eid = $Executors->[$item_id]->e->eid; my $eid = $executor->e->eid;
#say "$eid $item_id $maximum_nodes";
if ($maximum_nodes > $concurrent_node_count_usage) { if ($maximum_nodes > $concurrent_node_count_usage) {
warn "$eid requires upto $maximum_nodes nodes, only $concurrent_node_count_usage concurrent nodes permitted\n$eid will not be run"; warn "$eid requires upto $maximum_nodes nodes, only $concurrent_node_count_usage concurrent nodes permitted\n$eid will not be run";
} }
else { else {
push @schedule, [ +$maximum_nodes, +$item_id ]; $workscheduler->add_task($itemId, $maximum_nodes);
$total_test_count += $executor->test_count;
} }
} }
@schedule = sort { $a->[0] <=> $b->[0] } @schedule; USE_TESTBULDER_PREAMBLE: {
reset_test_builder($total_test_count, no_numbers => 1);
#count tests step }
my $test_count = 0;
map { $test_count += $Executors->[$_->[1]]->test_count } @schedule;