Commit 4b058d69 authored by Kevin Tew's avatar Kevin Tew

testsuite/testswap clean ups

parent 94bf2be6
......@@ -6,10 +6,10 @@ REQUIREMENTS
INSTALLATION INSTRUCTIONS
#this configures CPAN and installs CPAN dependencies in your homedir if you don't have root access to do it yourself
perl ./localcpan.pl
./install_deps_from_cpan
#this installs CPAN dependencies into your system as root using CPAN as already configured
sudo ./localcpan.pl --install_deps
sudo ./install_deps_from_cpan --install_deps
When prompted:
UUID state storage [/tmp] (HIT ENTER)
......@@ -32,7 +32,7 @@ TO SEE Tests available to run
TO RUN Tests
./tbts test
./tbts tests/topologies/single_node.pm
./tbts -D OS= tests/ImageTests.pm
./tbts -D OS=RHL90-STD tests/ImageTests.pm
./tbts tests/OldTestSuiteTests.pm
EXAMPLE Tests to look at to GET STARTED:
......@@ -43,11 +43,13 @@ EXAMPLE Tests to look at to GET STARTED:
Documentation can be found in the doc directory
running pod2text on any pm file will produce API docs.
Almost all test script functionality is provided by the following three files
pod2text lib/TestBed/XMLRPC/Client/Experiment.pm
pod2text lib/TestBed/TestSuite/Experiment.pm
pod2text lib/TestBed/TestSuite.pm
pod2text lib/Tools/TBSSH.pm provides lots of nice additions to ssh
......
OldTests
Massive Run
Docs
Prefix
Painpoints
Pain points
=================================
Testlayout - Suites and Tests, buildup, teardown using Test::Class
Testoutput - TestBuilderWrapper
......
......@@ -3,21 +3,23 @@ use Modern::Perl;
use File::Temp;
use Data::Dumper;
use IPC::Run3;
my $fn;
my $fn = "BOZO";
my @todos;
while(my $line = <STDIN>) {
given($line) {
when(/^not ok \d+ - Pod coverage on (\S+)/) {
when(/# Failed test/) {}
when(/# at /) {}
when(/^# Coverage for (\S+)/) {
$fn = $1;
$fn =~ s/::/\//g;
$fn .= '.pm';
my $a = <STDIN> for (1..4);
}
when( /Looks like you failed/) {
next;
}
when( /^#\s+(\S+)/ ) {
say "pushed $fn $1";
push @todos, [$fn, $1];
}
}
......@@ -29,7 +31,8 @@ for (@todos) {
my $fn = $_->[0];
my $subname = $_->[1];
$temp->print("/$subname\n");
run3("vim lib/$fn -s $sfn");
my $cmd = "vim lib/$fn -s $sfn";
run3($cmd);
}
#say Dumper(\@todos);
......
Error strategies allow for catching the following experiment errors
TestBed::ParallelRunner::Executor::PrerunError
TestBed::ParallelRunner::Executor::SwapinError
TestBed::ParallelRunner::Executor::RunError
TestBed::ParallelRunner::Executor::SwapoutError
TestBed::ParallelRunner::Executor::KillError
Extend TestBed::ParallelRunner::ErrorStrategy
TestBed::ParallelRunner::BackoffStrategy is an example of how to do this.
BackoffStrategy->build takes a string of four arguments concatenated with ':'
"waittime:maxretires:exponent:maxtime"
waittime is the time in seconds to wait between retries
maxretries is the maximum number of retries to attempt before failing
exponent is the exponent to raise the waittime to i.e. (waittime * (2 ** exponent))
maxtime is the maximum total time to be spent attempting to retry
if maxtime elapses or maxretries attempts is reached the experiment is terminated.
......@@ -19,7 +19,18 @@ HOWTO write a parallel test.
use Test::More tests => 1; # DO NOT DO THIS, parallel tests in tests/ may be ran with othere testsuites.
specify the number of test in the rege call.
3. run the set of parallel tests
rege can also take optional arguments at the end of the signature list such as
strategy => TestBed::ParallelRunner::CustomStrategy->new # allows you to specify a custom error strategy
retry => 2 # number of retry attempts to execute the experiment
backoff => "60:5:0" # "waittime:maxretires:exponent:maxtime"
waittime is the time in seconds to wait between retries
maxretries is the maximum number of retries to attempt before failing
exponent is the exponent to raise the waittime to i.e. (waittime * (2 ** exponent))
maxtime is the maximum total time to be spent attempting to retry
2. run the set of parallel tests
./tbts test/BasicTopologies.pm
......
......@@ -44,7 +44,7 @@ sub email_daemonize_logs {
}
=pod
=head TestBed::Daemonize
=head1 TestBed::Daemonize
=over 4
......
......@@ -484,8 +484,6 @@ sub nextJob {
}
sub doItem { my ($s, $taskid) = @_; $s->proc->($s->tasks->[$taskid]->item); }
use TestBed::ParallelRunner::ErrorConstants;
sub return_and_report {
my ($s, $result) = @_;
$s->recordItemResult($result);
......@@ -499,8 +497,7 @@ sub handleItemResult {
$result->name($executor->e->eid);
}
if ($executor->can('handleResult')) {
my $rc = $executor->handleResult($s, $result);
if ($rc == RETURN_AND_REPORT) { $s->return_and_report($result) }
$executor->handleResult($s, $result);
}
else {
$s->return_and_report($result);
......
#!/usr/bin/perl
package TestBed::ParallelRunner::ErrorConstants;
use SemiModern::Perl;
require Exporter;
our @ISA = qw(Exporter);
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;
......@@ -2,7 +2,6 @@
package TestBed::ParallelRunner::ErrorStrategy;
use SemiModern::Perl;
use Mouse;
use TestBed::ParallelRunner::ErrorConstants;
has 'executor' => (is => 'rw');
has 'scheduler' => (is => 'rw');
......@@ -23,9 +22,9 @@ sub handleResult {
elsif ( $error->isa ( 'TestBed::ParallelRunner::Executor::SwapoutError')) { return $s->swapout_error ( @_); }
elsif ( $error->isa ( 'TestBed::ParallelRunner::Executor::KillError')) { return $s->end_error ( @_); }
elsif ( $error->isa ( 'TestBed::ParallelRunner::Executor::Exception')) { return $s->run_error ( @_); }
else { return RETURN_AND_REPORT; }
else { $s->ensure_end_and_report; }
}
else { return RETURN_AND_REPORT; }
else { $s->report_to_scheduler; }
}
sub xmlrpc_error_cause {
......@@ -48,28 +47,38 @@ sub is_retry_cause {
return 0;
}
sub prerun_error { return RETURN_AND_REPORT; }
sub swapin_error { return RETURN_AND_REPORT; }
sub run_error { return RETURN_AND_REPORT; }
sub swapout_error { return RETURN_AND_REPORT; }
sub end_error { return RETURN_AND_REPORT; }
sub ensure_end_and_report {
my $s = shift;
#say("ensure_end_and_report " . $s->executor->e->eid);
eval { $s->executor->ensure_end; };
$s->report_to_scheduler
}
sub report_to_scheduler {
my $s = shift;
$s->scheduler->return_and_report($s->result);
}
sub prerun_error { shift->ensure_end_and_report; }
sub swapin_error { shift->ensure_end_and_report; }
sub run_error { shift->ensure_end_and_report; }
sub swapout_error { shift->ensure_end_and_report; }
sub end_error { shift->ensure_end_and_report; }
package TestBed::ParallelRunner::PrerunExpectFail;
use SemiModern::Perl;
use Mouse;
use TestBed::ParallelRunner::ErrorConstants;
extends 'TestBed::ParallelRunner::ErrorStrategy';
sub prerun_error {
my ($s, $executor, $scheduler, $result) = @_;
return RETURN_AND_REPORT;
$s->ensure_end_and_report;
}
package TestBed::ParallelRunner::ErrorRetryStrategy;
use SemiModern::Perl;
use Mouse;
use TestBed::ParallelRunner::ErrorConstants;
extends 'TestBed::ParallelRunner::ErrorStrategy';
......@@ -79,13 +88,12 @@ sub swapin_error {
warn "Retrying";# . $executor->e->eid;
return $s->scheduler->retry($result);
}
else { return RETURN_AND_REPORT; }
else { $s->ensure_end_and_report; }
}
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 );
......@@ -121,12 +129,12 @@ sub backoff {
my $maxretries = $s->maxretries;
if ($s->retries >= $maxretries) {
warn "Max retries $maxretries reached, terminating experiment";
return RETURN_AND_REPORT;
return $s->ensure_end_and_report;
}
my $timeout = $s->starttime + $s->maxtime;
if (time >= $timeout) {
warn "Max timeout $timeout reached, terminating experiment";
return RETURN_AND_REPORT;
return $s->ensure_end_and_report;
}
$s->incr_retries;
......@@ -141,7 +149,7 @@ sub swapin_error {
if ($s->is_retry_cause) {
return $s->backoff($result);
}
else { return RETURN_AND_REPORT; }
else { return $s->ensure_end_and_report; }
}
=head1 NAME
......@@ -170,6 +178,15 @@ parses the xmlrpc error cause out of the original embedded xmlrpc error
return true if the error is retriable
=item C<< es->ensure_end_and_report >>
ensures the executor experiment end method has been called and
reports result to scheduler
=item C<< es->report_to_scheduler >>
reports a result back to the scheduler
=back
=head1 NAME
......
......@@ -108,40 +108,46 @@ sub checkexclude {
return grep { $_ eq $stage } @{ $TBConfig::exclude_steps };
}
sub failReason {
my $s = shift;
sprintf("FAILURE %s: %s", $s->e->eid, shift->error_type);
}
sub execute {
my $s = shift;
my $e = $s->e;
my $eid = $e->eid;
my $run_exception;
my $swapout_exception;
eval { $e->swapin_wait; } unless checkexclude('swapin');
my $swapin_exception = $@;
die TestBed::ParallelRunner::Executor::SwapinError->new( original => $swapin_exception ) if $swapin_exception;
unless ($swapin_exception) {
eval { $s->proc->($e); } unless checkexclude('run');
$run_exception = $@;
eval { $s->proc->($e); } unless checkexclude('run');
$run_exception = $@;
die TestBed::ParallelRunner::Executor::RunError->new( original => $run_exception ) if $run_exception;
eval { $e->swapout_wait; } unless checkexclude('swapout');
$swapout_exception = $@;
}
eval { $e->swapout_wait; } unless checkexclude('swapout');
$swapout_exception = $@;
die TestBed::ParallelRunner::Executor::SwapoutError->new( original => $swapout_exception ) if $swapout_exception;
eval { $e->end_wait; } unless checkexclude('end');
my $end_exception = $@;
die TestBed::ParallelRunner::Executor::SwapinError->new( original => $swapin_exception ) if $swapin_exception;
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;
return 1;
}
sub ensure_end {
my $s = shift;
my $e = $s->e;
my $eid = $e->eid;
eval {
$e->ensure_end;
} unless checkexclude('end');
my $end_exception = $@;
die TestBed::ParallelRunner::Executor::KillError->new( original => $end_exception ) if $end_exception;
}
=head1 NAME
TestBed::ParallelRunner::Executor
......@@ -175,6 +181,10 @@ 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->ensure_end >>
calls end on an experiment allowing for experiment doesn't exist and in transition exceptions
=item C<< $prt->parse_options >>
parses retry =>1, backoff => "\d+:\d+:\d+:\d+", strategy => '....' options
......
......@@ -8,14 +8,17 @@ use TestBed::XMLRPC::Client::Node;
use Data::Dumper;
use Tools;
my $error_sub = sub {
use Carp qw(longmess);
say "Caught here " . __FILE__;
say(@_);
say longmess;
die @_;
our $error_trace = sub {
use Carp qw(confess longmess);
say "DEBUG: ERROR CAUGHT HERE " . __FILE__;
sayd(\@_);
Carp::cluck( "DIED\n", @_ );
say "DEBUG: DONE ERROR CAUGHT HERE " . __FILE__;
};
#$SIG{ __DIE__ } = $error_sub;
#$SIG{ __DIE__ } = $error_trace;
require Exporter;
our @ISA = qw(Exporter);
......@@ -135,6 +138,7 @@ creates a new experiment with pid, gid, and eid
=item C<rege($e, $ns_contents, &test_sub, $test_count, $desc, %options)>
registers experiement with parallel test running engine
see doc/HOW_TO_WRITE_A_PARALLEL_TEST.txt for details on $options
=item C<CartProd($hashref)> Cartesian Product Runner
......@@ -165,7 +169,7 @@ my $config = {
CartProdRunner(\&VNodeTest::VNodeTest, $config);
=item C< concretize($templated_text, %substitution_values) >
=item C<concretize($templated_text, %substitution_values)>
substitutes values as well as TBConfig::defines values into $templated_text
......@@ -185,7 +189,7 @@ executes anonymous funcs in parallel dying if any fail
executes anonymous funcs in parallel returning the output results
=item C< get_free_node_names(%query_options) >
=item C<get_free_node_names(%query_options)>
reexports TestBed::XMLRPC::Client::Node->new()->get_free_node_names(@_);
......
......@@ -114,9 +114,8 @@ runs a ping test across all nodes
=cut
sub ping_test {
my ($e) = @_;
for (@{$e->nodes}) {
die $_->name . "failed ping" unless $_->ping();
}
for (@{$e->nodes}) { die $_->name . "failed ping" unless $_->ping(); }
1;
}
=item C<< $e->wait_for_nodes_to_activate($timeout, @nodes) >>
......@@ -160,6 +159,10 @@ sub traceroute_ok {
Tools::Network::traceroute_ok($src, @_);
}
=item C<<gen_try($func, $times)>>
generate a new function that tries $func $times before giving up
=cut
sub gen_try($$){
my ($func, $times) = @_;
my $work = sub{
......@@ -178,32 +181,71 @@ sub gen_try($$){
runs a nxn ping test across all nodes
=cut
sub cartesian_ping{
sub cartesian_ping {
my ($e) = shift;
my @nodes = $e->nodenames();
my @hosts = $e->hostnames();
my @work;
for (@nodes) {
my $src_node = $_;
my $for_node = sub {
for (@hosts) {
my $dest_node = $_;
if ($src_node ne $dest_node){
gen_try(sub{$e->ping_from_to($src_node, $dest_node)}, 5)->();
}
}
};
push @work, $for_node;
}
TestBed::TestSuite::prun(@work);
}
=item C<< $e->cartesian_connectivity() >>
runs a nxn socket connect test to port 22 across all nodes
=cut
sub cartesian_connectivity {
my ($e) = shift;
my @nodes = $e->nodenames();
my @hosts = $e->hostnames();
my $hosts = "[" . join(', ', map("'$_'", @hosts)) . "]";
my $cmd = <<EOF;
import sys, socket
def ok(to):
s = socket.socket(socket.AF_INET, socket.SOCK_STREAM)
s.connect((to, 22))
print "Connected to %s:22" % to
for host in $hosts:
ok(host)
sys.exit(0)
EOF
my @work;
for (@nodes){
for (@nodes) {
my $src_node = $_;
for (@hosts){
my $dest_node = $_;
if ($src_node ne $dest_node){
push @work, gen_try(sub{$e->ping_from_to($src_node, $dest_node)}, 5);
}
}
my $for_node = sub {
my $from = $src_node;
Tools::TBSSH::cmdsuccess_stdin($from, "\"sh -c 'PATH=/bin:/usr/sbin:/usr/sbin:/sbin:/usr/bin python -'\"", $cmd, "pinged $from");
};
push @work, $for_node;
}
TestBed::TestSuite::prun(@work);
}
=item C<< $e->ping_from_to($src, $dest) >>
ssh to $src and ping $dest
=cut
sub ping_from_to {
my ($e, $from, $to) = @_;
Tools::TBSSH::cmdsuccess($from, "'sh -c \"PATH=/bin:/usr/sbin:/usr/sbin:/sbin ping -c 5 $to\"'", "ping from $from to $to");
Tools::TBSSH::cmdsuccess($from, "'sh -c \"PATH=/bin:/usr/sbin:/usr/sbin:/sbin ping -i 0.2 -c 2 $to\"'", "ping from $from to $to");
}
=item C<< $e->single_node_tests() >>
......
......@@ -4,14 +4,21 @@ use SemiModern::Perl;
use Mouse;
use Data::Dumper;
use TestBed::XMLRPC::Client::NodeInfo;
use TBConfig;
extends 'TestBed::XMLRPC::Client';
has 'pid' => ( isa => 'Str', is => 'rw', default => sub { $TBConfig::DEFAULT_PID; } );
has 'gid' => ( isa => 'Str', is => 'rw', default => sub { $TBConfig::DEFAULT_GID || $TBConfig::DEFAULT_PID; } );
has 'eid' => ( isa => 'Str', is => 'rw', default => \&gen_random_eid);
has 'eid' => ( isa => 'Str', is => 'rw', default => \&gen_random_eid );
#autoloaded/autogenerated/method_missings/etc batchexp swapexp endexp waitforactive getlist expinfo metadata modify
sub BUILD {
my $s = shift;
if ($TBConfig::prefix) { $s->eid($TBConfig::prefix . $s->eid); }
}
#autoloaded/autogenerated/method_missings/etc batchexp swapexp endexp waitforactive getlist expinfo metadata modify state
my $EID_INCR = 0;
sub gen_random_eid {
......@@ -97,6 +104,7 @@ sub modify_ns_wait { shift->modify_ns(@_,'wait' => 1); }
sub batchexp_ns_wait { shift->batchexp_ns(@_,'wait' => 1); }
use constant EXPERIMENT_NAME_ALREADY_TAKEN => 2;
use constant EXPERIMENT_ALREADY_SWAPPED_IN => 2;
sub ensure_active_ns {
my $self = shift;
eval { $self->startexp_ns_wait(@_); };
......@@ -109,13 +117,29 @@ sub ensure_active_ns {
my $rc = eval { $self->swapin_wait; };
$exception = $@;
if ($exception) {
unless ($exception->isa('RPC::XML::struct') and $exception->value->{ 'code' } == 2) {
unless ($exception->isa('RPC::XML::struct') and $exception->value->{ 'code' } == EXPERIMENT_ALREADY_SWAPPED_IN) {
die $exception;
}
}
$rc;
}
sub ensure_end {
my $s = shift;
eval { $s->end_wait(@_); };
my $exception = $@;
if ($exception) {
if( $exception->isa('RPC::XML::struct')) {
if ($exception->value->{ 'output' } =~ /No such experiment/ ) { return; }
elsif ($exception->value->{ 'output' } =~ /Experiment .* went into transition/ ) { return; }
}
say "Error in ensure_end";
sayd($exception);
die $exception;
}
}
sub swapin_wait {
my $self = shift;
$self->swapin('wait' => 1);
......@@ -224,6 +248,14 @@ ends the experiment
ends the experiment, waits for it to reach the ended state
=item C<< $e->ensure_end >>
ends the experiment, allowing for experiment doesn't exist and in transition exceptions
=item C<< $e->state >>
returns the experiment state as a string
=item C<< $e->nodeinfo >>
returns a list of node names in the experiment
......@@ -324,6 +356,11 @@ B<INTERNAL>: catches socket timeout exceptions and returns success
B<INTERNAL>: prepends error message with eid
=item C<< $e->BUILD >>
B<INTERNAL>: a Mouse method to allow modification during construction time
=back
=cut
......
......@@ -28,14 +28,14 @@ sub ping {
#$rc;
#Net::Ping returns 0 on success
my $p = Net::Ping->new('tcp', 2);
!$p->ping($host);
my $rc = $p->ping($host);
!$rc;
}
=item C<node_reboot(@ARGS)>
node_reboot('pc137');
node_reboot('-f', 'pc137');
=cut
sub node_reboot {
Tools::TBSSH::cmdoutput($TBConfig::OPS_SERVER, "'sh -c \"PATH=$OPS_PATH node_reboot @_\"'", "node_reboot @_ failed");
......@@ -66,12 +66,13 @@ sub traceroute {
});
}
=item C<ping_from_to($from, $to)>
ssh to $from and ping $to
=cut
sub ping_from_to($$){
my ($from, $to) = @_;
Tools::TBSSH::cmdcheckoutput($from, "'sh -c \"PATH=/bin:/usr/sbin:/usr/sbin:/sbin ping -c 5 $to\"'",
sub {
return 1;
});
Tools::TBSSH::cmdsuccess($from, "'sh -c \"PATH=/bin:/usr/sbin:/usr/sbin:/sbin ping -c 5 $to\"'", );
}
sub traceroute_ok {
......
......@@ -86,8 +86,8 @@ sub cmdsuccessdump {
}
sub cmdfailure {
my ($host, $cmd) = @_;
return wrapped_ssh($host, $TBConfig::EMULAB_USER, $cmd, sub { $_[2] != 0; } );
my ($host, $cmd, $diemessage) = @_;
return wrapped_ssh($host, $TBConfig::EMULAB_USER, $cmd, sub { $_[2] != 0; }, $diemessage );
}
sub cmdfailuredump {
......@@ -128,6 +128,10 @@ executes $cmd as $TBConfig::EMULAB_USER on $host and calls checker with ($out, $
returns the ssh result code of executing $cmd as $TBConfig::EMULAB_USER
=item C<cmdsuccess_stdin($host, $cmd, $stdin, $diemessage)>
returns the ssh result code of executing $cmd with $stdin as $TBConfig::EMULAB_USER
=item C<cmdoutput($host, $cmd, $diemessage)>>
returns the ssh stdout of executing $cmd as $TBConfig::EMULAB_USER
......
......@@ -18,16 +18,7 @@ use TestBed::Wrap::tevc;
#$TBConfig::DEBUG_XML_CLIENT = 1;
my $error_trace = sub {
use Carp qw(longmess);
say "Caught here " . __FILE__;
sayd(@_);
say "SAYD DONE";
Carp::confess( "DIED IN SC\n", @_ );
};
#$SIG{ __DIE__ } = $error_trace;
#$SIG{ __DIE__ } = $TestBed::TestSuite::error_trace;
my $ns = <<'NSEND';
source tb_compat.tcl
......@@ -75,8 +66,8 @@ sub end_all_experiments {
say "";
if (Tools::yn_prompt("Are you sure you want to terminate all experiments?")) {
my @experiment_names = experiments_hash_to_list(e->getlist_full);
e(@{$_->[0]})->end for(@experiment_names);
e(@{$_->[0]})->waitforended for(@experiment_names);
for(@experiment_names) { eval { say "Ending " . $_->[0]; e(@{$_->[0]})->end; }; }
for(@experiment_names) { eval { e(@{$_->[0]})->ensure_end; }; }
}
}
......@@ -131,15 +122,19 @@ if (@ARGV) {
elsif (/il/) { say Dumper($e->info(aspect => 'links')) ;}
elsif (/watch/) { watch($e); }
elsif ($_ eq'ex') {
say $ARGV[0];
my $result = eval $ARGV[0];
say $@ if $@;
my $code = $ARGV[0];
my $cmdstring = "sayd($code);";