From 8a7e6259875b531164c4a022bf2f836dad113200 Mon Sep 17 00:00:00 2001
From: Kevin Tew <tewk@flux.utah.edu>
Date: Mon, 29 Jun 2009 21:39:02 +0000
Subject: [PATCH] Backoff and function documentation

---
 testsuite/testswap/TODO                       |   9 +-
 .../testswap/lib/TestBed/ForkFramework.pm     | 257 +++++++++++-------
 .../testswap/lib/TestBed/ParallelRunner.pm    |  53 ++--
 .../TestBed/ParallelRunner/ErrorConstants.pm  |  14 +
 .../TestBed/ParallelRunner/ErrorStrategy.pm   | 120 +++++++-
 .../lib/TestBed/ParallelRunner/Executor.pm    |  27 +-
 testsuite/testswap/lib/TestBed/TestSuite.pm   |   4 +
 .../lib/TestBed/TestSuite/Experiment.pm       |   3 +
 .../testswap/lib/TestBed/TestSuite/Node.pm    |   8 +-
 .../lib/TestBed/XMLRPC/Client/Experiment.pm   |   8 +
 testsuite/testswap/lib/Tools/TBSSH.pm         |  13 +-
 testsuite/testswap/lib/Tools/WrappedSSH.pm    |   6 +-
 .../testswap/t/lib/testbed/forkframework.t    |  34 ++-
 testsuite/testswap/t/topologies/single_node.t |   3 +-
 14 files changed, 401 insertions(+), 158 deletions(-)

diff --git a/testsuite/testswap/TODO b/testsuite/testswap/TODO
index 25e34e2ac..9e2d09638 100644
--- a/testsuite/testswap/TODO
+++ b/testsuite/testswap/TODO
@@ -1,5 +1,9 @@
+ImageTest
+Parameters
+OldTests
+
 DOCS TODO
-  retry example
+  backoff example
 
 TODO
   TIMEOUT of XMLRPC Calls
@@ -18,11 +22,10 @@ STILL MESSY
 
 EXPAND CURRENT IMPLEMENTATION
   event subsystem
-  parallel support (custom test harness)
+  Test::Builder support
 
 LATER
   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
   Large External Tars and Resources for experiements
   buildup, teardown using Test::Class
diff --git a/testsuite/testswap/lib/TestBed/ForkFramework.pm b/testsuite/testswap/lib/TestBed/ForkFramework.pm
index 7b8f16462..98a7088ec 100644
--- a/testsuite/testswap/lib/TestBed/ForkFramework.pm
+++ b/testsuite/testswap/lib/TestBed/ForkFramework.pm
@@ -73,9 +73,6 @@ has 'itemid' => ( is => 'rw');
 
 sub is_error { shift->error; }
 
-use SemiModern::Perl;
-use Mouse;
-
 package TestBed::ForkFramework;
 sub forkit {
   my ($parent_worker, $worker) = @_;
@@ -95,11 +92,6 @@ sub forkit {
   }
 }
 
-sub fork_child_redir {
-  my ($worker) = @_;
-  fork_redir( sub { return @_; }, $worker);
-}
-
 sub fork_redir {
   my ($parent_worker, $worker) = @_;
   my $redir = TestBed::ForkFramework::Redir->new;
@@ -116,6 +108,11 @@ sub fork_redir {
   );
 }
 
+sub fork_child_redir {
+  my ($worker) = @_;
+  fork_redir( sub { return @_; }, $worker);
+}
+
 package TestBed::ForkFramework::Scheduler;
 use SemiModern::Perl;
 use Mouse;
@@ -123,24 +120,12 @@ use IO::Select;
 use Carp;
 use Data::Dumper;
 
-has 'workers'    => ( is => 'rw', default => sub { [] });
-has 'results'    => ( is => 'rw', default => sub { TestBed::ForkFramework::Results->new; });
-has 'selector'   => ( is => 'rw', default => sub { IO::Select->new; });
-has 'items'      => ( is => 'rw', isa => 'ArrayRef', required => 1 );
-has 'proc'       => ( is => 'rw', isa => 'CodeRef' , required => 1 );
-
+has 'workers'       => ( is => 'rw', default => sub { [] });
+has 'results'       => ( is => 'rw', default => sub { TestBed::ForkFramework::Results->new; });
+has 'selector'      => ( is => 'rw', default => sub { IO::Select->new; });
+has 'selecttimeout' => ( is => 'rw', default => 10 ); #seconds
+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 {
   my ($self) = @_;
@@ -154,10 +139,10 @@ sub workloop {
       say "spawnWorker $jobid" if $FFDEBUG;
       $self->fffork($jobid);
     }
-    say "CALL SELECT" if $FFDEBUG;
-    if ($self->selectloop) {
-      redo LOOP;
-    }
+    my $selectrc = $self->process_select; say "CALL SELECT" if $FFDEBUG;
+    my $schedulerc = $self->schedule;
+
+    if ($selectrc || $schedulerc) { redo LOOP; }
   }
   $self->wait_for_all_children_to_exit;
 
@@ -167,12 +152,12 @@ sub workloop {
 use constant SELECT_HAS_HANDLES => 1;
 use constant SELECT_NO_HANDLES  => 0;
 
-sub selectloop {
+sub process_select {
   my ($self) = @_;
   my $selector = $self->selector;
   if ($selector->count) {
     eval {
-      for my $r ($selector->can_read) {
+      for my $r ($selector->can_read($self->selecttimeout)) {
         my ($rh, $wh, $eof, $ch) = @$r;
         if (defined (my $result = $ch->receive)) {
           $self->handleResult($result);
@@ -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 recordResult { shift->results->handle_result(shift); }
+sub schedule { 0; }
 
 package TestBed::ForkFramework::ForEach;
 use SemiModern::Perl;
 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';
 
-sub spawnWorker { shift->nextJob; }
+sub spawnWorker { 
+  my $s = shift; 
+  return if ($s->currworkers >= $s->maxworkers);
+  $s->{'currworkers'}++;
+  $s->nextJob; 
+}
+
 sub nextJob { 
   my @res = shift->iter->();
   $res[0];
@@ -258,50 +253,55 @@ sub nextJob {
 
 sub work {
   my ($proc, $items) = @_;
-  my $s = TestBed::ForkFramework::ForEach->new(
-    'items' => $items,
-    'proc' => $proc,
-    'iter' => TestBed::ForkFramework::Scheduler::_gen_iterator($items),
-  );
-  $s->workloop;
+  return max_work(scalar @$items, $proc, $items);
 }
 
-package TestBed::ForkFramework::MaxWorkersScheduler;
-use SemiModern::Perl;
-use Mouse;
-
-has 'maxworkers'  => ( isa => 'Int' , is => 'rw', default => 4);
-has 'pos'         => ( isa => 'Int' , is => 'rw', default => 0);
-has 'currworkers' => ( isa => 'Int' , is => 'rw', default => 0);
+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;
+  }
+}
 
-extends 'TestBed::ForkFramework::Scheduler';
-      
-sub work {
+sub max_work {
   my ($max_workers, $proc, $items) = @_;
-  my $s = TestBed::ForkFramework::MaxWorkersScheduler->new(
+  my $s = TestBed::ForkFramework::ForEach->new(
     'maxworkers' => $max_workers, 
     'items' => $items,
     'proc' => $proc,
+    'iter' => _gen_iterator($items),
   );
   $s->workloop;
 }
 
-sub spawnWorker { 
-  my $s = shift; 
-  return if ($s->currworkers >= $s->maxworkers);
-  $s->{'currworkers'}++;
-  $s->nextJob; 
-}
+sub doItem { my ($s, $itemid) = @_; $s->proc->($s->items->[$itemid]); }
 
-sub nextJob { 
-  my $s = shift; 
-  my $pos = $s->pos;
-  return if ($pos >= scalar @{ $s->items });
-  $s->{'pos'}++; 
-  $pos;
+package TestBed::ForkFramework::WeightedScheduler::Task;
+use SemiModern::Perl;
+use Mouse;
+
+has 'id'      => (is => 'rw');
+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 Data::Dumper;
 use Tools;
@@ -309,13 +309,31 @@ use Mouse;
 
 extends 'TestBed::ForkFramework::Scheduler';
 
+has 'ids'  =>      ( isa => 'Int'      , is => 'rw', default => 0);
 has 'maxnodes'  => ( isa => 'Int'      , is => 'rw', default => 20);
 has 'currnodes' => ( isa => 'Int'      , is => 'rw', default => 0);
-has 'schedule'  => ( isa => 'ArrayRef' , is => 'rw', required => 1);
-has 'weight'    => ( isa => 'ArrayRef' , is => 'rw', required => 1);
-has 'retryItems'=> ( isa => 'ArrayRef' , is => 'rw', default => sub { [] } );
+has 'runqueue'  => ( isa => 'ArrayRef' , is => 'rw', default => sub { [] } );
+has 'tasks'     => ( 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);
 
+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 {
   my ($s, $quantity) = @_;
@@ -323,47 +341,55 @@ sub incr_currnodes {
 }
 
 sub return_node_resources {
-  my ($s, $itemid) = @_;
-  $s->{'currnodes'} -= $s->weight->[$itemid];
+  my ($s, $task) = @_;
+  $s->{'currnodes'} -= $task->weight;
+}
+
+sub sort_runqueue {
+  my ($s) = @_;
+  $s->runqueue( [ sort { $a->weight <=> $b->weight } @{$s->runqueue} ] );
 }
 
 sub work {
-  my ($max_nodes, $proc, $schedule, $items) = @_;
-  my $s = TestBed::ForkFramework::RateScheduler->new(
-    'maxnodes' => $max_nodes, 
-    'items' => $items,
-    'proc' => $proc,
-    'schedule' => $schedule,
-    'weight' => [ map { $_->[0] } (sort { $a->[1] <=> $b->[1] } @$schedule) ],
-  ); 
-  say toperl("SCHEDULE", $s->schedule) if $FFDEBUG;
-  say toperl("WEIGHTS", $s->weight) if $FFDEBUG;
+  my ($maxnodes, $proc, $items_weights) = @_;
+  my $s = TestBed::ForkFramework::WeightedScheduler->new(
+    maxnodes => $maxnodes,
+    proc => $proc,
+  );
+  $s->add_task($_->[0], $_->[1]) for (@$items_weights);
+  $s->run;
+}
+
+sub run {
+  my ($s) = @_;
+  $s->sort_runqueue;
   $s->workloop;
+
   say("RETRYING") if $FFDEBUG;
   $s->inRetry(1);
-  $s->schedule( [ map { [$s->weight->[$_], $_] } @{$s->retryItems} ] );
-  $s->retryItems([]);
-  say toperl("SCHEDULE", $s->schedule) if $FFDEBUG;
-  say toperl("WEIGHTS", $s->weight) if $FFDEBUG;
+  $s->runqueue( [ @{$s->retryTasks} ] );
+  $s->retryTasks([]);
+
+  $s->sort_runqueue;
   $s->workloop;
 }
 
 sub find_largest_item {
-  my ($s, $max_size) = @_;
+  my ($s, $max_weight) = @_;
   my $found = undef;
 
-  #find largest item that is small enough
-  for (@{ $s->schedule }) {
-    my $itemsize = $_->[0];
+  #find largest task that is small enough
+  for (@{ $s->runqueue }) {
+    my $item_weight = $_->weight;
 
-    last if $itemsize > $max_size;
-    next if ($found and $found->[0] >= $itemsize);
-    $found = $_ if $itemsize <= $max_size;
+    last if $item_weight > $max_weight;
+    next if ($found and $found->weight >= $item_weight);
+    $found = $_ if $item_weight <= $max_weight;
   }
 
-  #remove found from schedule
+  #remove found from runqueue
   if (defined $found) {
-    $s->schedule( [ grep { !($_->[1] == $found->[1]) } @{ $s->schedule} ]);
+    $s->runqueue( [ grep { !($_->id == $found->id) } @{ $s->runqueue} ]);
   }
 
   return $found;
@@ -373,28 +399,28 @@ sub spawnWorker { shift->nextJob; }
 sub nextJob { 
   my $s = shift;
   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) {
-    my ($e_node_size, $eindex) = @$tuple;
-    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'} += $e_node_size;
-    return $eindex;
+  if ($task) {
+    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;
+    $s->{'currnodes'} += $task->weight;
+    return $task->id;
   }
   else { return; }
 }
+sub doItem { my ($s, $taskid) = @_; $s->proc->($s->tasks->[$taskid]->item); }
 
 use TestBed::ParallelRunner::ErrorConstants;
 
 sub return_and_report {
   my ($s, $result) = @_;
   $s->recordResult($result);
-  $s->return_node_resources($result->itemid);
+  $s->return_node_resources($s->task($result->itemid));
 }
 
 sub handleResult { 
   my ($s, $result) = @_;
-  my $executor = $s->items->[$result->itemid];
+  my $executor = $s->tasks->[$result->itemid]->item;
   if ($executor->can('handleResult')) {
     my $rc = $executor->handleResult($s, $result);
     if ($rc == RETURN_AND_REPORT) { $s->return_and_report($result) }
@@ -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 {
   my ($s, $result) = @_;
   my $itemid = $result->itemid;
   if (!$s->inRetry) {
-    push @{ $s->retryItems }, $itemid;
-    $s->return_node_resources($itemid);
-    say "RETRYING item# $itemid";
+    push @{ $s->retryTasks }, $s->task($itemid);
+    $s->return_node_resources($s->task($itemid));
+#    say "RETRYING task# $itemid";
     return 1;
   }
   else { 
-    say "DONE RETRYING";
+#    say "DONE RETRYING";
     $s->return_and_report($result); 
   }
 }
diff --git a/testsuite/testswap/lib/TestBed/ParallelRunner.pm b/testsuite/testswap/lib/TestBed/ParallelRunner.pm
index e28921139..ebc8c6169 100644
--- a/testsuite/testswap/lib/TestBed/ParallelRunner.pm
+++ b/testsuite/testswap/lib/TestBed/ParallelRunner.pm
@@ -59,38 +59,53 @@ sub runtests {
   $concurrent_node_count_usage ||= $TBConfig::concurrent_node_usage;
 
   #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) {
     sayd($result->errors);
     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}) {
-    my $item_id = $_->itemid;
+    my $itemId = $_->itemid;
+    my $executor = $Executors->[$itemId];
     my $maximum_nodes = $_->result->{'maximum_nodes'};
-    my $eid = $Executors->[$item_id]->e->eid;
-    #say "$eid $item_id $maximum_nodes";
+    my $eid = $executor->e->eid;
 
     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";
     }
     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;
-
-  #count tests step
-  my $test_count = 0;
-  map { $test_count += $Executors->[$_->[1]]->test_count } @schedule;
+  USE_TESTBULDER_PREAMBLE: {
+    reset_test_builder($total_test_count, no_numbers => 1);
+  }
 
   #run tests
-  reset_test_builder($test_count, no_numbers => 1);
-  $result = TestBed::ForkFramework::RateScheduler::work($concurrent_node_count_usage, \&tap_wrapper, \@schedule, $Executors);
-  set_test_builder_to_end_state($test_count);
+  $result = $workscheduler->run;
+
+  USE_TESTBULDER_POSTAMBLE: {
+    $total_test_count = 0;
+    for (@{$result->successes}) {
+      my $item_id = $_->itemid;
+      my $executor = $Executors->[$item_id];
+      $total_test_count += $executor->test_count;
+    }
+    set_test_builder_to_end_state($total_test_count);
+  }
+
   if ($result->has_errors) {
     sayd($result->errors);
     die 'TestBed::ParallelRunner::runtests died during test execution';
@@ -167,10 +182,14 @@ TestBed::ParallelRunner
 
 =over 4
 
-=item C<< add_executor >>
+=item C<< build_executor >>
 
 helper function called by rege.
-creates a TestBed::ParallelRunner::Execu:or job and pushes it onto @$Executors
+creates a TestBed::ParallelRunner::Executor job
+
+=item C<< add_executor($executor) >>
+
+pushes $executor onto @$Executors
 
 =item C<< runtests >>
 
diff --git a/testsuite/testswap/lib/TestBed/ParallelRunner/ErrorConstants.pm b/testsuite/testswap/lib/TestBed/ParallelRunner/ErrorConstants.pm
index b32766078..79d095edb 100644
--- a/testsuite/testswap/lib/TestBed/ParallelRunner/ErrorConstants.pm
+++ b/testsuite/testswap/lib/TestBed/ParallelRunner/ErrorConstants.pm
@@ -9,3 +9,17 @@ our @EXPORT = qw(RETURN_AND_REPORT);
 use constant RETURN_AND_REPORT => 4096;
 
 1;
+
+=head1 NAME
+
+TestBed::ParallelRunner::ErrorConstants
+
+contains RETURN_AND_REPORT error constant;
+
+=over 4
+
+=back
+
+=cut
+
+1;
diff --git a/testsuite/testswap/lib/TestBed/ParallelRunner/ErrorStrategy.pm b/testsuite/testswap/lib/TestBed/ParallelRunner/ErrorStrategy.pm
index 7f4f89618..d41c91472 100644
--- a/testsuite/testswap/lib/TestBed/ParallelRunner/ErrorStrategy.pm
+++ b/testsuite/testswap/lib/TestBed/ParallelRunner/ErrorStrategy.pm
@@ -14,6 +14,7 @@ sub handleResult {
   $s->executor($executor);
   $s->scheduler($scheduler);
   $s->result($result);
+
   if ($result->is_error) {
     my $error = $result->error;
     if    ( $error->isa ( 'TestBed::ParallelRunner::Executor::SwapinError'))  { return $s->swapin_error  ( @_); }
@@ -38,6 +39,14 @@ sub xmlrpc_error_cause {
   return;
 }
 
+sub is_retry_cause {
+  my $s = shift;
+  my $cause = $s->xmlrpc_error_cause;
+  my @retry_causes = qw(temp internal software hardware canceled unknown);
+  if ( grep { /$$cause/ } @retry_causes) { return 1; }
+  return 0;
+}
+
 sub swapin_error  { return RETURN_AND_REPORT; }
 sub run_error     { return RETURN_AND_REPORT; }
 sub swapout_error { return RETURN_AND_REPORT; }
@@ -52,16 +61,73 @@ extends 'TestBed::ParallelRunner::ErrorStrategy';
 
 sub swapin_error {
   my ($s, $executor, $scheduler, $result) = @_;
-  if ($s->is_retry_cause) { return $scheduler->retry($result); }
+  if ($s->is_retry_cause) {
+    warn "Retrying";# . $executor->e->eid;
+    return $s->scheduler->retry($result); 
+  }
   else { return RETURN_AND_REPORT; }
 }
 
-sub is_retry_cause {
-  my $s = shift;
-  my $cause = $s->xmlrpc_error_cause;
-  my @retry_causes = qw(temp internal software hardware canceled unknown);
-  if ( grep { /$$cause/ } @retry_causes) { return 1; }
-  return 0;
+package TestBed::ParallelRunner::BackoffStrategy;
+use SemiModern::Perl;
+use Mouse;
+use TestBed::ParallelRunner::ErrorConstants;
+
+has 'starttime'  => (is => 'rw', default => sub { time; } );
+has 'retries'    => (is => 'rw', default => 0 );
+has 'maxtime'    => (is => 'rw', default => 5 * 60 * 60 );
+has 'maxretries' => (is => 'rw', default => 3 );
+has 'waittime'   => (is => 'rw', default => 10 * 60 );
+has 'exponent'   => (is => 'rw', default => 0.0 );
+
+extends 'TestBed::ParallelRunner::ErrorStrategy';
+
+sub build {
+  shift;
+  my $s = TestBed::ParallelRunner::BackoffStrategy->new; 
+  $s->parse(shift);
+  $s;
+} 
+
+sub parse {
+  my ($s, $args) = @_;
+  my @args = split(/:/, $args);
+  my $val;
+  $val = shift @args; $s->waittime($val) if $val;
+  $val = shift @args; $s->maxretries($val) if $val;
+  $val = shift @args; $s->exponent($val) if $val;
+  $val = shift @args; $s->maxtime($val) if $val;
+}
+
+sub incr_retries { shift->{retries}++; }
+
+sub backoff {
+  my ($s, $result) = @_;
+  
+  my $maxretries = $s->maxretries;
+  if ($s->retries >= $maxretries) {
+    warn "Max retries $maxretries reached, terminating experiment";
+    return RETURN_AND_REPORT;
+  }
+  my $timeout = $s->starttime + $s->maxtime;
+  if (time >= $timeout) {
+    warn "Max timeout $timeout reached, terminating experiment";
+    return RETURN_AND_REPORT;
+  }
+  
+  $s->incr_retries;
+  $s->waittime($s->waittime * (2 ** $s->exponent));
+  my $next_time = time + $s->waittime;
+  warn "Backing off " . ($next_time - time) . " seconds.";
+  return $s->scheduler->schedule_at($result, $next_time);
+}
+
+sub swapin_error {
+  my ($s, $executor, $scheduler, $result) = @_;
+  if ($s->is_retry_cause) {
+    return $s->backoff($result); 
+  }
+  else { return RETURN_AND_REPORT; }
 }
 
 =head1 NAME
@@ -76,13 +142,45 @@ handle parallel run errors;
 
   dispatch experiment errors to the right handler
 
-=item C<< swapin_error($error) >>
-=item C<< run_error($error) >>
-=item C<< swapout_error($error) >>
-=item C<< end_error($error) >>
+=item C<< $es->swapin_error($error) >>
+=item C<< $es->run_error($error) >>
+=item C<< $es->swapout_error($error) >>
+=item C<< $es->end_error($error) >>
+
+=item C<< $es->xmlrpc_error_cause($error) >>
+
+parses the xmlrpc error cause out of the original embedded xmlrpc error
+
+=item C<< es->is_retry_cause >>
+
+return true if the error is retriable 
 
 =back
 
+=head1 NAME
+
+TestBed::ParallelRunner::BackoffStrategy
+
+implement parallel backoff
+
+=over 4
+
+=item C<< $bs->build( "waittime:maxretires:exponent:maxtime" ) >>
+
+builds backoff strategy from arg string
+
+=item C<< $bs->parse( "waittime:maxretires:exponent:maxtime" ) >>
+
+parses arg string and sets object members
+
+=item C<< $bs->incr_retries >>
+
+incrementes attempted retries
+
+=item C<< $bs->incr_retries >>
+
+schedules task for exectution after backoff time
+
 =cut
 
 1;
diff --git a/testsuite/testswap/lib/TestBed/ParallelRunner/Executor.pm b/testsuite/testswap/lib/TestBed/ParallelRunner/Executor.pm
index 5fba3a6e6..bceeeb80f 100644
--- a/testsuite/testswap/lib/TestBed/ParallelRunner/Executor.pm
+++ b/testsuite/testswap/lib/TestBed/ParallelRunner/Executor.pm
@@ -44,25 +44,37 @@ has 'test_count' => ( isa => 'Any', is => 'rw');
 has 'error_strategy' => ( is => 'rw', lazy => 1, default => sub { TestBed::ParallelRunner::ErrorStrategy->new; } );
 has 'pre_result_handler' => ( isa => 'CodeRef', is => 'rw');
 
-sub build {
-  my ($e, $ns, $sub, $test_count, $desc) = (shift, shift, shift, shift, shift);
+sub parse_options {
   my %options = @_;
 
   if (defined (delete $options{retry})) {
     $options{error_strategy} = TestBed::ParallelRunner::ErrorRetryStrategy->new;
   }
+
+  if (defined (my $params = delete $options{backoff})) {
+    $options{error_strategy} = TestBed::ParallelRunner::BackoffStrategy->build($params);
+    
+  }
   
   if (defined (my $strategy = delete $options{strategy})) {
     $options{error_strategy} = $strategy;
   }
+  
+  %options;
+}
+
+sub buildt { shift; TestBed::ParallelRunner::Executor->new( parse_options(@_)); }
 
+sub build {
+  shift;
+  my ($e, $ns, $sub, $test_count, $desc) = (shift, shift, shift, shift, shift);
   return TestBed::ParallelRunner::Executor->new(
     'e'          => $e,
     'ns'         => $ns,
     'proc'       => $sub,
     'test_count' => $test_count,
     'desc'       => $desc,
-    %options
+    parse_options(@_)
   );
 }
 
@@ -128,6 +140,15 @@ handles the result using a error strategy
 swaps in the experiment and runs the specified test
 it kills the experiment unconditionaly after the test returns
 
+=item C<< $prt->parse_options >>
+
+parses retry =>1, backoff => "\d+:\d+:\d+:\d+", strategy => '....' options
+and build the appropriate error_strategy object
+
+=item C<< $prt->buildt >>
+
+builds a naked TestBed::ParallelRunner::Executor for testing purposes
+
 =back
 
 =cut
diff --git a/testsuite/testswap/lib/TestBed/TestSuite.pm b/testsuite/testswap/lib/TestBed/TestSuite.pm
index c6ca49ecf..6aeb18272 100644
--- a/testsuite/testswap/lib/TestBed/TestSuite.pm
+++ b/testsuite/testswap/lib/TestBed/TestSuite.pm
@@ -140,6 +140,10 @@ creates a new experiment with pid, gid, and eid
 
 registers experiement with parallel test running engine
 
+=item C<pr_e($e, $ns_contents, &test_sub, $test_count, $desc, %options)>
+
+registers experiement with parallel test running engine
+
 =item C<runtests($concurrent_pre_runs, $concurrent_node_count_usage) >
 
 allows a maximum of $concurrent_pre_runs during parallel execution
diff --git a/testsuite/testswap/lib/TestBed/TestSuite/Experiment.pm b/testsuite/testswap/lib/TestBed/TestSuite/Experiment.pm
index 7b22805e2..ead0d5202 100644
--- a/testsuite/testswap/lib/TestBed/TestSuite/Experiment.pm
+++ b/testsuite/testswap/lib/TestBed/TestSuite/Experiment.pm
@@ -212,7 +212,10 @@ sub linkdown {
   TestBed::Wrap::tevc::tevc($e->pid, $e->eid, "now $link down");
 }
 
+=item C<< $e->pretty_list() >>
 
+prints a list of all experiments and there status
+=cut
 sub pretty_list {
   use TestBed::XMLRPC::Client::Pretty;
   pretty_listexp(shift->getlist_full);
diff --git a/testsuite/testswap/lib/TestBed/TestSuite/Node.pm b/testsuite/testswap/lib/TestBed/TestSuite/Node.pm
index 601432895..557fa5b99 100644
--- a/testsuite/testswap/lib/TestBed/TestSuite/Node.pm
+++ b/testsuite/testswap/lib/TestBed/TestSuite/Node.pm
@@ -30,9 +30,11 @@ executes hostname, sudo ls, mount via ssh on the remote node
 sub single_node_tests {
   my ($s) = @_;
   my $ssh = $s->ssh();
-  $ssh->cmdsuccess("hostname");
-  $ssh->cmdsuccess("sudo id");
-  $ssh->cmdsuccess("mount");
+  my $eid = $s->experiment->eid;
+  my $name = $s->name;
+  $ssh->cmdmatch("hostname", qr/$name/, "$eid $name hostname died");
+  $ssh->cmdmatch("sudo id", qr/uid=0\(root\)/, "$eid $name sudo died");
+  $ssh->cmdmatch("mount", qr{/proj/}, "$eid $name mountdied");
 }
 
 =item C<< $n->ssh >>
diff --git a/testsuite/testswap/lib/TestBed/XMLRPC/Client/Experiment.pm b/testsuite/testswap/lib/TestBed/XMLRPC/Client/Experiment.pm
index 10af204ee..fe2405ed9 100644
--- a/testsuite/testswap/lib/TestBed/XMLRPC/Client/Experiment.pm
+++ b/testsuite/testswap/lib/TestBed/XMLRPC/Client/Experiment.pm
@@ -271,6 +271,14 @@ hook for generating a random $eid if desired
 
 modifies the current experiment with the give $ns file
 
+=item C<< $e->modify_ns_wait($ns) >>
+
+modifies the current experiment with the give $ns file and waits for the modifications to complete
+
+=item C<< $e->fqnodenames >>
+
+returns a list of fully qualified node names in the experiement
+
 =item C<< $e->noemail >>
 
 B<INTERNAL>: generates the noemail attribute for xmlrpc calls if so configured in TBConfig
diff --git a/testsuite/testswap/lib/Tools/TBSSH.pm b/testsuite/testswap/lib/Tools/TBSSH.pm
index e96502069..30fb5a82b 100644
--- a/testsuite/testswap/lib/Tools/TBSSH.pm
+++ b/testsuite/testswap/lib/Tools/TBSSH.pm
@@ -23,7 +23,7 @@ sub instance {
 }
 
 sub wrapped_ssh {
-  my ($invocant, $user, $cmd, $checker) = @_;
+  my ($invocant, $user, $cmd, $checker, $diemessage) = @_;
   my $ssh;
   if (ref $invocant) { $ssh = $invocant }
   else {
@@ -36,7 +36,7 @@ sub wrapped_ssh {
   }
 
   if (defined $checker) {
-    &$checker(@results) || die "ssh checker of cmd $cmd failed";
+    &$checker(@results) || die ($diemessage || "ssh checker of cmd $cmd failed");
   }
   ($results[2], @results);
 }
@@ -64,6 +64,11 @@ sub cmdsuccess {
   return wrapped_ssh($host, $TBConfig::EMULAB_USER, $cmd, sub { $_[2] == 0; } );
 }
 
+sub cmdmatch {
+  my ($host, $cmd, $regex, $diemessage) = @_;
+  return wrapped_ssh($host, $TBConfig::EMULAB_USER, $cmd, sub { $_[0] =~ $regex; }, $diemessage );
+}
+
 sub cmdsuccessdump {
   my ($host, $cmd) = @_;
   return wrapped_ssh($host, $TBConfig::EMULAB_USER, $cmd, sub { print Dumper(\@_); $_[2] == 0; } );
@@ -124,6 +129,10 @@ returns the ssh result code of executing $cmd as $TBConfig::EMULAB_USER
 
 returns the ssh result code of executing $cmd as $TBConfig::EMULAB_USER and dumps the ssh stdout, stderr, resultcode
 
+=item C<cmdmatch($host, $cmd, $regex, $diemessage)>
+
+executes $cmd as $TBConfig::EMULAB_USER and dies with diemessage if stdout doesn't match $regex
+
 =back
 
 =cut
diff --git a/testsuite/testswap/lib/Tools/WrappedSSH.pm b/testsuite/testswap/lib/Tools/WrappedSSH.pm
index 45e2781b6..6c2948f38 100644
--- a/testsuite/testswap/lib/Tools/WrappedSSH.pm
+++ b/testsuite/testswap/lib/Tools/WrappedSSH.pm
@@ -48,10 +48,14 @@ Tools::TBSSH
 
 B<LOWLEVEL SUB> execute $cmd on $host as $user by wrapping cmdline ssh
 
-=item C<< $ssh->scp_worker(@files)  >>
+=item C<< $ssh->scp_worker(@files) >>
 
 B<LOWLEVEL SUB> execute $scp with $files as arguments
 
+=item C<< $ssh->saydebug() >>
+
+B<LOWLEVEL SUB> prints out ssh command line 
+
 =back
 
 =cut
diff --git a/testsuite/testswap/t/lib/testbed/forkframework.t b/testsuite/testswap/t/lib/testbed/forkframework.t
index 3f7e85165..f721f03a6 100644
--- a/testsuite/testswap/t/lib/testbed/forkframework.t
+++ b/testsuite/testswap/t/lib/testbed/forkframework.t
@@ -5,26 +5,34 @@ use TestBed::ParallelRunner::Executor;
 use RPC::XML;
 use Data::Dumper;
 use Test::Exception;
-use Test::More tests => 3;
+use Test::More tests => 4;
 
-my $results = TestBed::ForkFramework::MaxWorkersScheduler::work(2, sub { my $d = `date`; chomp($d); $_[0] . " $d "  . $$; }, ['K1', 'K2', 'K3', 'K4'] );
-ok($results->has_errors == 0 && @{ $results->successes } == 4, 'ForkFramework::MaxWorkersScheduler::work');
+my $date_id_sub = sub { my $d = `date`; chomp($d); $_[0] . " $d "  . $$; };
+
+my $results = TestBed::ForkFramework::ForEach::max_work(2, $date_id_sub, ['K1', 'K2', 'K3', 'K4'] );
+ok($results->has_errors == 0 && @{ $results->successes } == 4, 'ForkFramework::ForEach::max_work');
 #say Dumper($results);
 
-$results = TestBed::ForkFramework::RateScheduler::work(4, sub { my $d = `date`; chomp($d); $_[0] . " $d "  . $$; },
-[[1, 1], [1, 0], [2, 2], [3, 3]],
-['K1', 'K2', 'K3', 'K4'] );
-ok($results->has_errors == 0 && @{ $results->successes } == 4, 'ForkFramework::RateScheduler::work');
+$results = TestBed::ForkFramework::WeightedScheduler::work(4, $date_id_sub, [['K1', 1], ['K2', 1], ['K3', 2], ['K4', 3] ] );
+ok($results->has_errors == 0 && @{ $results->successes } == 4, 'ForkFramework::WeightedScheduler::work');
 #say Dumper($results);
 
-use TestBed::ParallelRunner::ErrorStrategy;
-$results = TestBed::ForkFramework::RateScheduler::work(4, 
+$results = TestBed::ForkFramework::WeightedScheduler::work(1, 
   sub { die TestBed::ParallelRunner::Executor::SwapinError->new( 
     original => RPC::XML::struct->new( { value => { cause => 'temp' } })); },
-  [[1, 0]],
-  [ TestBed::ParallelRunner::Executor->new(test_count => 1,
-    error_strategy => TestBed::ParallelRunner::ErrorRetryStrategy->new) ]
+  [[ TestBed::ParallelRunner::Executor->buildt(test_count => 1, retry => 1), 1]]
+);
+
+ok($results->has_errors == 1 && @{ $results->errors } == 1, 'ForkFramework::WeightedScheduler::work, retry');
+#say Dumper($results);
+
+my $launchtime = time;
+$results = TestBed::ForkFramework::WeightedScheduler::work(4, 
+  sub { 
+    die TestBed::ParallelRunner::Executor::SwapinError->new( 
+    original => RPC::XML::struct->new( { value => { cause => 'temp' } })) if (time - $launchtime < 6); 1;},
+  [[ TestBed::ParallelRunner::Executor->buildt(test_count => 1, backoff => "2:10:0"), 1]]
 );
 
-ok($results->has_errors == 1 && @{ $results->errors} == 1, 'ForkFramework::RateScheduler::work, retry');
+ok($results->has_errors == 0 && @{ $results->successes } == 1, 'ForkFramework::WeightedScheduler::work, backoff');
 #say Dumper($results);
diff --git a/testsuite/testswap/t/topologies/single_node.t b/testsuite/testswap/t/topologies/single_node.t
index 11836eb1c..bdbd0cc06 100644
--- a/testsuite/testswap/t/topologies/single_node.t
+++ b/testsuite/testswap/t/topologies/single_node.t
@@ -14,5 +14,6 @@ set node1 [$ns node]
 $ns run
 NSEND
 
-ok(e('sn1')->startrunkill($ns, sub { shift->single_node_tests }), 'single_node_tests');
+#ok(e('sn1')->startrunkill($ns, sub { shift->single_node_tests }), 'single_node_tests');
+ok(e('sn1')->startrun($ns, sub { shift->single_node_tests }), 'single_node_tests');
 #ok(e('sn1')->single_node_tests, 'single_node_tests');
-- 
GitLab