Executor.pm 4.67 KB
Newer Older
1 2 3 4 5 6
#!/usr/bin/perl
package TestBed::ParallelRunner::Executor::Exception;
use Mouse;
  has original => ( is => 'rw');
no Mouse;

Kevin Tew's avatar
Kevin Tew committed
7
package TestBed::ParallelRunner::Executor::PrerunError;
8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40
use Mouse;
  extends('TestBed::ParallelRunner::Executor::Exception');
no Mouse;

package TestBed::ParallelRunner::Executor::SwapinError;
use Mouse;
  extends('TestBed::ParallelRunner::Executor::Exception');
no Mouse;

package TestBed::ParallelRunner::Executor::RunError;
use Mouse;
  extends('TestBed::ParallelRunner::Executor::Exception');
no Mouse;

package TestBed::ParallelRunner::Executor::SwapoutError;
use Mouse;
  extends('TestBed::ParallelRunner::Executor::Exception');
no Mouse;

package TestBed::ParallelRunner::Executor::KillError;
use Mouse;
  extends('TestBed::ParallelRunner::Executor::Exception');
no Mouse;

package TestBed::ParallelRunner::Executor;
use TestBed::ParallelRunner::ErrorStrategy;
use SemiModern::Perl;
use TestBed::TestSuite::Experiment;
use Mouse;
use Data::Dumper;

has 'e'    => ( isa => 'TestBed::TestSuite::Experiment', is => 'rw');
has 'desc' => ( isa => 'Str', is => 'rw');
Kevin Tew's avatar
Kevin Tew committed
41
has 'ns'   => ( is => 'rw');
42 43 44 45 46
has 'proc' => ( isa => 'CodeRef', is => 'rw');
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');

Kevin Tew's avatar
Kevin Tew committed
47 48 49 50 51 52 53 54 55
sub ns_text {
  my $s = shift;
  my $ns = $s->ns;
  if (ref($ns) eq 'CODE') {
    return $ns->();
  }
  return $ns;
}

Kevin Tew's avatar
Kevin Tew committed
56
sub parse_options {
57 58 59 60 61
  my %options = @_;

  if (defined (delete $options{retry})) {
    $options{error_strategy} = TestBed::ParallelRunner::ErrorRetryStrategy->new;
  }
Kevin Tew's avatar
Kevin Tew committed
62 63 64 65 66

  if (defined (my $params = delete $options{backoff})) {
    $options{error_strategy} = TestBed::ParallelRunner::BackoffStrategy->build($params);
    
  }
67 68 69 70
  
  if (defined (my $strategy = delete $options{strategy})) {
    $options{error_strategy} = $strategy;
  }
Kevin Tew's avatar
Kevin Tew committed
71 72 73 74 75
  
  %options;
}

sub buildt { shift; TestBed::ParallelRunner::Executor->new( parse_options(@_)); }
76

Kevin Tew's avatar
Kevin Tew committed
77 78
sub build {
  my ($e, $ns, $sub, $test_count, $desc) = (shift, shift, shift, shift, shift);
79 80 81 82 83 84
  return TestBed::ParallelRunner::Executor->new(
    'e'          => $e,
    'ns'         => $ns,
    'proc'       => $sub,
    'test_count' => $test_count,
    'desc'       => $desc,
Kevin Tew's avatar
Kevin Tew committed
85
    parse_options(@_)
86 87 88 89 90 91 92 93 94 95
  );
}

sub handleResult { 
  my ($s) = @_;
  my $prh = $s->pre_result_handler;
  $prh->(@_) if $prh;
  $s->error_strategy->handleResult( @_); 
}

Kevin Tew's avatar
Kevin Tew committed
96
sub prerun{
Kevin Tew's avatar
Kevin Tew committed
97
  my $s = shift;
Kevin Tew's avatar
Kevin Tew committed
98
  if (checkexclude('create')) {
Kevin Tew's avatar
Kevin Tew committed
99 100 101
    return +{'maximum_nodes' => 0};
  }
  my $r = eval { $s->e->create_and_get_metadata($s->ns_text); };
Kevin Tew's avatar
Kevin Tew committed
102
  die TestBed::ParallelRunner::Executor::PrerunError->new( original => $@ ) if $@;
103 104 105
  return $r;
}

Kevin Tew's avatar
Kevin Tew committed
106
sub checkexclude {
Kevin Tew's avatar
Kevin Tew committed
107
  my $stage = shift;
Kevin Tew's avatar
Kevin Tew committed
108
  return grep { $_ eq $stage } @{ $TBConfig::exclude_steps };
Kevin Tew's avatar
Kevin Tew committed
109 110
}

111
sub execute {
Kevin Tew's avatar
Kevin Tew committed
112 113
  my $s = shift;
  my $e = $s->e;
114

Kevin Tew's avatar
Kevin Tew committed
115 116 117
  my $run_exception;
  my $swapout_exception;

Kevin Tew's avatar
Kevin Tew committed
118
  eval { $e->swapin_wait; } unless checkexclude('swapin');
Kevin Tew's avatar
Kevin Tew committed
119
  my $swapin_exception = $@;
120

Kevin Tew's avatar
Kevin Tew committed
121
  unless ($swapin_exception) {
Kevin Tew's avatar
Kevin Tew committed
122
    eval { $s->proc->($e); } unless checkexclude('run');
Kevin Tew's avatar
Kevin Tew committed
123
    $run_exception = $@;
124

Kevin Tew's avatar
Kevin Tew committed
125
    eval { $e->swapout_wait; } unless checkexclude('swapout');
Kevin Tew's avatar
Kevin Tew committed
126 127
    $swapout_exception = $@;
  }
128

Kevin Tew's avatar
Kevin Tew committed
129
  eval { $e->end_wait; } unless checkexclude('end');
Kevin Tew's avatar
Kevin Tew committed
130 131
  my $end_exception = $@;

Kevin Tew's avatar
Kevin Tew committed
132
  die TestBed::ParallelRunner::Executor::SwapinError->new( original => $@ ) if $swapin_exception;
Kevin Tew's avatar
Kevin Tew committed
133 134 135
  die TestBed::ParallelRunner::Executor::RunError->new( original => $run_exception ) if $run_exception;
  die TestBed::ParallelRunner::Executor::SwapoutError->new( original => $swapout_exception ) if $swapout_exception;
  die TestBed::ParallelRunner::Executor::KillError->new( original => $end_exception ) if $end_exception;
136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151
  
  return 1;
}

=head1 NAME

TestBed::ParallelRunner::Executor

Represents a ParallelRunner Job

=over 4

=item C<< build($e, $ns, $sub, $test_count, $desc) >>

constructs a TestBed::ParallelRunner::Test job

Kevin Tew's avatar
Kevin Tew committed
152 153 154 155 156 157 158 159 160
=item C<< checkexclude($stage_name) >>

checks if $stage_name is in $TBConfig::exclude_steps

=item C<< $prt->ns_text >>

checks if ns_text is a CODE reference, is so execute it otherwise return ns_text

=item C<< $prt->prerun >>
161 162 163 164 165 166 167 168 169 170 171 172

executes the pre_running phase of experiment and determines min and max node counts.

=item C<< $prt->handleResult >>

handles the result using a error strategy

=item C<< $prt->execute >>

swaps in the experiment and runs the specified test
it kills the experiment unconditionaly after the test returns

Kevin Tew's avatar
Kevin Tew committed
173 174 175 176 177 178 179 180 181
=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

182 183 184 185 186
=back

=cut

1;