Commit 27b6505a authored by Kevin Tew's avatar Kevin Tew

testsuite/testswap cleanups

parent 0d70b240
ImageTest - Traffic Generation
Bug Report sync
Bug Report TempResourceError
Fix Exector dies
OldTests
Cleanup SSH
Retry Prep
Painpoints
=================================
Teststeps - don't run certian parts create, swapin, run, swapout, end, implemented for parallel tests
Testlayout - Suites and Tests
Testoutput -
......@@ -13,7 +15,6 @@ DOCS TODO
backoff example
TODO
TIMEOUT of XMLRPC Calls
TESTLWP
scp cleanup
VERBOSENESS
......
......@@ -445,7 +445,9 @@ sub return_and_report {
sub handleItemResult {
my ($s, $result) = @_;
my $executor = $s->tasks->[$result->itemid]->item;
$result->name($executor->e->eid);
if ($executor->can('e') and $executor->e) {
$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) }
......
package TAP::Parser::Iterator::StdOutErr;
use strict;
use warnings;
use vars qw($VERSION @ISA);
use TAP::Parser::Iterator::Process ();
use IO::Select;
@ISA = 'TAP::Parser::Iterator::Process';
sub _initialize {
my $self = shift;
$self->{out} = shift || die "Need out";
$self->{err} = shift || die "Need err";
$self->{sel} = IO::Select->new( $self->{out}, $self->{err} );
$self->{pid} = shift || die "Need pid";
$self->{exit} = undef;
$self->{chunk_size} = 65536;
return $self;
}
package TestBed::Harness;
use SemiModern::Perl;
use TAP::Harness;
require Exporter;
our @ISA = qw(Exporter TAP::Harness);
our @EXPORT = qw(runharness);
use TestBed::TestSuite;
use TestBed::ForkFramework;
use TestBed::ParallelRunner;
sub build_TAP_stream {
use TestBed::TestSuite;
my ($in, $out, $err, $pid) = TestBed::ForkFramework::fork_child_redir(sub { TestBed::ParallelRunner::GlobalRunner->runtests; });
return TAP::Parser::Iterator::StdOutErr->new($out, $err, $pid);
}
sub parser_args_callback {
my $args = shift;
......@@ -11,7 +41,7 @@ sub parser_args_callback {
if (ref $ref and $ref->isa('TestBed::ParallelRunner')) {
delete $args->{source};
$args->{'stream'} = $ref->build_TAP_stream;
$args->{'stream'} = build_TAP_stream;
}
$args;
}
......@@ -44,12 +74,17 @@ sub runharness {
$harness->runtests(@$ts);
}
=head1 NAME
TestBed::Harness
=over 4
=item C<< build_TAP_stream >>
given a TestBed::ParallelRunner returns a TAP stream
=item C<< runharness(@test_file_names) >>
ex. runharness( 't/lib/*.t', 't/xmlrpc/*.t' 'test/BasicTopologies.pm' )
......
#!/usr/bin/perl
package TAP::Parser::Iterator::StdOutErr;
use strict;
use warnings;
use vars qw($VERSION @ISA);
use TAP::Parser::Iterator::Process ();
use Config;
use IO::Select;
@ISA = 'TAP::Parser::Iterator::Process';
sub _initialize {
my ( $self, $args ) = @_;
shift;
$self->{out} = shift || die "Need out";
$self->{err} = shift || die "Need err";
$self->{sel} = IO::Select->new( $self->{out}, $self->{err} );
$self->{pid} = shift || die "Need pid";
$self->{exit} = undef;
$self->{chunk_size} = 65536;
return $self;
}
package TestBed::ParallelRunner;
use SemiModern::Perl;
use TestBed::ParallelRunner::Executor;
use TestBed::ForkFramework;
use TestBed::TestBuilderWrapper;
use Data::Dumper;
use Mouse;
use TBConfig;
our $Executors = [];
has executors => ( is => 'rw', default => sub { [] } );
our $GlobalRunner = TestBed::ParallelRunner->new;
sub executor {
my ($s, $itemId) = @_;
$s->executors->[$itemId];
}
my $teste_desc = <<'END';
Not enough arguments to teste
rege(eid, $ns, $sub, $test_count, $desc);
rege($pid, $eid, $ns, $sub, $test_count, $desc);
rege($pid, $gid, $eid, $ns, $sub, $test_count, $desc);
END
sub add_executor {
my $executor = shift;
push @$Executors, $executor;
my ($s, $executor) = @_;
push @{$s->executors}, $executor;
$executor;
}
sub build_executor {
my $executor = TestBed::ParallelRunner::Executor::build(@_);
add_executor($executor);
my $s = shift;
$s->add_executor(TestBed::ParallelRunner::Executor::build(@_));
}
sub runtests {
my ($concurrent_pre_runs, $concurrent_node_count_usage ) = @_;
my ($s, $concurrent_pre_runs, $concurrent_node_count_usage) = @_;
$concurrent_pre_runs ||= $TBConfig::concurrent_prerun_jobs;
$concurrent_node_count_usage ||= $TBConfig::concurrent_node_usage;
if ( $TBConfig::single ) {
$Executors = [ (grep { $_->e->eid eq $TBConfig::single } @$Executors) ];
$s->Executors = [ (grep { $_->e->eid eq $TBConfig::single } @{$s->executors}) ];
}
#prerun step
my $result = TestBed::ForkFramework::ForEach::max_work($concurrent_pre_runs, sub { shift->prep }, $Executors);
my $result = TestBed::ForkFramework::ForEach::max_work($concurrent_pre_runs, sub { shift->prerun }, $s->executors);
if ($result->has_errors) {
sayd($result->errors);
warn 'TestBed::ParallelRunner::runtests died during test prep';
}
my $workscheduler = TestBed::ForkFramework::WeightedScheduler->new(
items => $Executors,
items => $s->executors,
proc => \&tap_wrapper,
maxnodes => $concurrent_node_count_usage,
);
......@@ -79,8 +53,7 @@ sub runtests {
#add taskss to scheduler step
my $total_test_count = 0;
for (@{$result->successes}) {
my $itemId = $_->itemid;
my $executor = $Executors->[$itemId];
my $executor = $s->executor($_->itemId);
my $maximum_nodes = $_->result->{'maximum_nodes'};
my $eid = $executor->e->eid;
......@@ -94,7 +67,7 @@ sub runtests {
}
USE_TESTBULDER_PREAMBLE: {
reset_test_builder($total_test_count, no_numbers => 1);
TestBed::TestBuilderWrapper::reset_test_builder($total_test_count, no_numbers => 1);
}
#run tests
......@@ -103,11 +76,10 @@ sub runtests {
USE_TESTBULDER_POSTAMBLE: {
$total_test_count = 0;
for (@{$result->successes}) {
my $item_id = $_->itemid;
my $executor = $Executors->[$item_id];
my $executor = $s->executor($_->itemId);
$total_test_count += $executor->test_count;
}
set_test_builder_to_end_state($total_test_count);
TestBed::TestBuilderWrapper::set_test_builder_to_end_state($total_test_count);
}
if ($result->has_errors) {
......@@ -117,35 +89,6 @@ sub runtests {
return;
}
sub set_test_builder_to_end_state {
my ($test_count, %options) = @_;
use Test::Builder;
my $b = Test::Builder->new;
$b->current_test($test_count);
}
sub reset_test_builder {
my ($test_count, %options) = @_;
use Test::Builder;
my $b = Test::Builder->new;
$b->reset;
$b->use_numbers(0) if $options{no_numbers};
if ($test_count) { $b->expected_tests($test_count); }
else { $b->no_plan; }
}
sub setup_test_builder_ouputs {
my ($out, $err) = @_;
use Test::Builder;
my $b = Test::Builder->new;
$b->output($out);
$b->fail_output($out);
$b->todo_output($out);
}
#use Carp;
#$SIG{ __DIE__ } = sub { Carp::confess( @_ ) };
our $ENABLE_SUBTESTS_FEATURE = 0;
sub tap_wrapper {
......@@ -163,8 +106,8 @@ sub tap_wrapper {
ok(1, $te->desc) if $ENABLE_SUBTESTS_FEATURE && $tapp;
},
sub {
reset_test_builder($te->test_count) if $ENABLE_SUBTESTS_FEATURE;
setup_test_builder_ouputs(*STDOUT, *STDERR);
TestBed::TestBuilderWrapper::reset_test_builder($te->test_count) if $ENABLE_SUBTESTS_FEATURE;
TestBed::TestBuilderWrapper::setup_test_builder_ouputs(*STDOUT, *STDERR);
$te->execute;
});
}
......@@ -174,30 +117,31 @@ sub tap_wrapper {
return 0;
}
sub build_TAP_stream {
use TestBed::TestSuite;
my ($in, $out, $err, $pid) = TestBed::ForkFramework::fork_child_redir(sub { runtests; });
return TAP::Parser::Iterator::StdOutErr->new($out, $err, $pid);
}
=head1 NAME
TestBed::ParallelRunner
=over 4
=item C<< build_executor >>
=item C<< $pr->executor($itemid) >>
return the $itemid th executor
=item C<< $pr->build_executor >>
helper function called by rege.
creates a TestBed::ParallelRunner::Executor job
=item C<< add_executor($executor) >>
=item C<< $pr->add_executor($executor) >>
pushes $executor onto $s->executors list
pushes $executor onto @$Executors
=item C<< $pr->runtests($concurrent_pre_runs, $concurrent_node_count_usage) >>
=item C<< runtests >>
allows a maximum of $concurrent_pre_runs during parallel execution
allows a maximum of $concurrent_nodes during parallel execution
kicks off execution of parallel tests.
start the execution of parallel tests
=item C<< set_test_builder_to_end_state >>
=item C<< reset_test_builder >>
......@@ -209,10 +153,6 @@ B<INTERNAL> functions to get Test::Builder to behave correctly with parallel tes
wraps two different ways of executing parallel tests and wrapping their TAP output stream
=item C<< build_TAP_stream >>
given a TestBed::ParallelRunner returns a TAP stream
=back
=cut
......
......@@ -181,6 +181,8 @@ incrementes attempted retries
schedules task for exectution after backoff time
=back
=cut
1;
......@@ -4,7 +4,7 @@ use Mouse;
has original => ( is => 'rw');
no Mouse;
package TestBed::ParallelRunner::Executor::PrepError;
package TestBed::ParallelRunner::Executor::PrerunError;
use Mouse;
extends('TestBed::ParallelRunner::Executor::Exception');
no Mouse;
......@@ -93,17 +93,17 @@ sub handleResult {
$s->error_strategy->handleResult( @_);
}
sub prep {
sub prerun{
my $s = shift;
if (checkno('create')) {
if (checkexclude('create')) {
return +{'maximum_nodes' => 0};
}
my $r = eval { $s->e->create_and_get_metadata($s->ns_text); };
die TestBed::ParallelRunner::Executor::PrepError->new( original => $@ ) if $@;
die TestBed::ParallelRunner::Executor::PrerunError->new( original => $@ ) if $@;
return $r;
}
sub checkno {
sub checkexclude {
my $stage = shift;
return grep { $_ eq $stage } @{ $TBConfig::exclude_steps };
}
......@@ -115,18 +115,18 @@ sub execute {
my $run_exception;
my $swapout_exception;
eval { $e->swapin_wait; } unless checkno('swapin');
eval { $e->swapin_wait; } unless checkexclude('swapin');
my $swapin_exception = $@;
unless ($swapin_exception) {
eval { $s->proc->($e); } unless checkno('run');
eval { $s->proc->($e); } unless checkexclude('run');
$run_exception = $@;
eval { $e->swapout_wait; } unless checkno('swapout');
eval { $e->swapout_wait; } unless checkexclude('swapout');
$swapout_exception = $@;
}
eval { $e->end_wait; } unless checkno('end');
eval { $e->end_wait; } unless checkexclude('end');
my $end_exception = $@;
die TestBed::ParallelRunner::Executor::SwapinError->new( original => $@ ) if $swapin_exception;
......@@ -149,7 +149,15 @@ Represents a ParallelRunner Job
constructs a TestBed::ParallelRunner::Test job
=item C<< $prt->prep >>
=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 >>
executes the pre_running phase of experiment and determines min and max node counts.
......
package TestBed::TestBuilderWrapper;
use Test::Builder;
sub set_test_builder_to_end_state {
my ($test_count, %options) = @_;
my $b = Test::Builder->new;
$b->current_test($test_count);
}
sub reset_test_builder {
my ($test_count, %options) = @_;
my $b = Test::Builder->new;
$b->reset;
$b->use_numbers(0) if $options{no_numbers};
if ($test_count) { $b->expected_tests($test_count); }
else { $b->no_plan; }
}
sub setup_test_builder_ouputs {
my ($out, $err) = @_;
my $b = Test::Builder->new;
$b->output($out);
$b->fail_output($out);
$b->todo_output($out);
}
1;
......@@ -19,23 +19,11 @@ my $error_sub = sub {
require Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw(e CartProd CartProdRunner concretize defaults override rege runtests prun prunout get_free_node_names);
our @EXPORT = qw(e CartProd CartProdRunner concretize defaults override rege prun prunout get_free_node_names);
sub e { TestBed::TestSuite::Experiment->new(_build_e_from_positionals(@_)); }
sub e { TestBed::TestSuite::Experiment::build_e(@_); }
sub rege {
return TestBed::ParallelRunner::build_executor(@_);
}
sub runtests { TestBed::ParallelRunner::runtests(@_); }
sub _build_e_from_positionals {
if (@_ == 0) { return {}; }
if (@_ == 1) { return { 'eid' => shift }; }
if (@_ == 2) { return { 'pid' => shift, 'eid' => shift }; }
if (@_ == 3) { return { 'pid' => shift, 'gid' => shift, 'eid' => shift }; }
if (@_ > 3) { die 'Too many args to e'; }
}
sub rege { TestBed::ParallelRunner::GlobalRunner->build_executor(@_); }
sub CartProd {
my $config = shift;
......@@ -148,13 +136,6 @@ creates a new experiment with pid, gid, and eid
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
allows a maximum of $concurrent_nodes during parallel execution
start the execution of parallel tests, not needed
=item C<CartProd($hashref)> Cartesian Product Runner
=item C<CartProd($hashref, &filter_gen_func)> Cartesian Product Runner
......@@ -184,6 +165,10 @@ my $config = {
CartProdRunner(\&VNodeTest::VNodeTest, $config);
=item C< concretize($templated_text, %substitution_values) >
substitutes values as well as TBConfig::defines values into $templated_text
=item C<defaults($hashref, %defaults)> provides default hash entries for a params hash ref
returns a modified hash ref
......@@ -200,6 +185,10 @@ 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) >
reexports TestBed::XMLRPC::Client::Node->new()->get_free_node_names(@_);
=back
=cut
......
......@@ -2,6 +2,7 @@
package TestBed::TestSuite::Experiment;
use SemiModern::Perl;
use Mouse;
use TBConfig;
use TestBed::XMLRPC::Client::Experiment;
use TestBed::Wrap::tevc;
use TestBed::Wrap::linktest;
......@@ -24,6 +25,24 @@ framwork class for starting and testing experiments
=over 4
=item C<< build_e(...) >>
builds a TestBed::TestSuite::Experiment given either
()
($eid)
($pid, $eid)
($pid, $gid, $eid)
=cut
sub build_e {
my $args;
if (@_ == 0) { $args = {}; }
if (@_ == 1) { $args = { 'eid' => shift }; }
if (@_ == 2) { $args = { 'pid' => shift, 'eid' => shift }; }
if (@_ == 3) { $args = { 'pid' => shift, 'gid' => shift, 'eid' => shift }; }
if (@_ > 3) { die 'Too many args to e'; }
TestBed::TestSuite::Experiment->new(%$args);
}
=item C<< $e->resolve($nodename) >>
resolves node name into a fully qualified node name
......@@ -100,6 +119,10 @@ sub ping_test {
}
}
=item C<< $e->wait_for_nodes_to_activate($timeout, @nodes) >>
waits until $timeout for @nodes to respond to ping
=cut
sub wait_for_nodes_to_activate {
my ($e, $timeout) = (shift, shift);
my $start = time;
......@@ -111,12 +134,31 @@ sub wait_for_nodes_to_activate {
}
}
=item C<< $e->traceroute >>
run Tools::Network::traceroute
=cut
sub traceroute {
my ($e) = shift;
my $src = $e->resolve(shift);
Tools::Network::traceroute($src, @_);
}
=item C<< $e->traceroute_ok >>
run Tools::Network::traceroute_ok
=cut
sub traceroute_ok {
my ($e) = shift;
my $src = $e->resolve(shift);
Tools::Network::traceroute_ok($src, @_);
}
=item C<< $e->cartesian_ping() >>
runs a nxn ping test across all nodes
=cut
sub cartesian_ping{
my ($e) = shift;
my @nodes = $e->nodenames();
......@@ -124,11 +166,11 @@ sub cartesian_ping{
my @work;
for (@nodes){
my $node1 = $_;
my $src_node = $_;
for (@hosts){
my $node2 = $_;
if ($node1 ne $node2){
push @work, sub{$e->ping_from_to($node1, $node2)};
my $dest_node = $_;
if ($src_node ne $dest_node){
push @work, sub{$e->ping_from_to($src_node, $dest_node)};
}
}
}
......@@ -136,19 +178,13 @@ sub cartesian_ping{
TestBed::TestSuite::prun(@work);
}
sub ping_from_to($$$){
my ($e, $from, $to) = @_;
Tools::TBSSH::cmdcheckoutput($from, "'sh -c \"PATH=/bin:/usr/sbin:/usr/sbin:/sbin ping -c 5 $to\"'",
sub {
return 1;
});
}
=item C<< $e->ping_from_to($src, $dest) >>
sub traceroute_ok {
my ($e) = shift;
my $src = $e->resolve(shift);
Tools::Network::traceroute_ok($src, @_);
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");
}
=item C<< $e->single_node_tests() >>
......@@ -196,15 +232,7 @@ sub tevc_at_host {
runs tevc on ops for each cmdline produced by calling $proc on each $item.
=cut
sub parallel_tevc {
my ($e, $proc, $items) = @_;
my $result = TestBed::ForkFramework::ForEach::work(sub {
my @tevc_cmd = $proc->(@_);
TestBed::Wrap::tevc::tevc($e, @tevc_cmd);
}, $items);
if ($result->[0]) {
sayd($result->[2]);
die 'TestBed::ParallelRunner::runtests died during parallel_tevc';
}
parallel_tevc_at_host(shift, $TBConfig::OPS_SERVER, @_);
}
=item C<< $e->parallel_tevc_at_host($host, $proc, $items) >>
......@@ -219,7 +247,7 @@ sub parallel_tevc_at_host {
}, $items);
if ($result->[0]) {
sayd($result->[2]);
die 'TestBed::ParallelRunner::runtests died during parallel_tevc';
die 'TestBed::ForkFramework::ForEach::work died during parallel_tevc';
}
}
......
......@@ -54,12 +54,12 @@ sub getlist_brief { shift->augment( 'format' => 'brief'); }
sub getlist_full { shift->augment( 'format' => 'full' ); }
sub batchexp_ns { shift->augment_code( 'nsfilestr' => shift, 'noswapin' =>1, noemail, 'extrainfo' => 1, @_ ); }
sub modify_ns { shift->augment_code( 'nsfilestr' => shift, 'noswapin' =>1, noemail, 'extrainfo' => 1, @_ ); }
sub swapin { my $e = shift; retry_on_TIMEOUT { $e->augment_func_code( 'swapexp', noemail, 'direction' => 'in', 'extrainfo' => 1, @_ ) } 'swapin'; }
sub swapin { my $e = shift; my @args = @_; retry_on_TIMEOUT { $e->augment_func_code( 'swapexp', noemail, 'direction' => 'in', 'extrainfo' => 1, @args ) } 'swapin'; }
sub swapout { shift->augment_func_code( 'swapexp', noemail, 'direction' => 'out','extrainfo' => 1, @_ ); }
sub end { shift->augment_func_code( 'endexp', noemail); }
sub end_wait { shift->augment_func_code( 'endexp', noemail, 'wait' => 1); }
sub fqnodenames { parseNodeInfo(shift->nodeinfo); }
sub waitforactive { my $e = shift; retry_on_TIMEOUT { $e->augment_func_code('waitforactive', @_) } 'waitforactive'; }
sub waitforactive { my $e = shift; my @args = @_; retry_on_TIMEOUT { $e->augment_func_code('waitforactive', @args) } 'waitforactive'; }
sub waitforswapped { my $e = shift; retry_on_TIMEOUT { $e->augment_func_code( 'statewait', 'state' => 'swapped' ) } 'waitforswapped'; }
sub waitforended { my $e = shift; retry_on_TIMEOUT { $e->augment_func_code( 'statewait', 'state' => 'ended' ) } 'waitforended'; }
sub startexp_ns { batchexp_ns(@_, 'batch' => 0); }
......
......@@ -73,7 +73,7 @@ given a list of nodeshashes return nodehashes for nodes that are free
returns a list of free node names that meet criteria of params => values
=item C<get_free_names($qrt, )>
=item C<get_free_node_names($qrt, )>
returns a list of at least $qty free node names that meet criteria of params => values
......
......@@ -236,6 +236,14 @@ sub daemonize {
open(STDERR, "+>", "stderr.$$");
}
=item C<ForkOrDie>
dies if fork fails
=item C<daemonize>
daemonizes the process redirecting stdout and stderr to files
=back
=cut
......
......@@ -56,6 +56,10 @@ sub traceroute_ok {
ok(traceroute(@_), "traceroute $src to $dest");
}
=item C<traceroute_ok($src, $dest, ['hop1_host', 'hop2_host', ...])>
calls traceroute and ok if successfull
=back
=cut
......
......@@ -4,7 +4,7 @@ use TBConfig;
use TestBed::TestSuite;
use Data::Dumper;
use Test::Exception;
use Test::More tests => 13;
use Test::More tests => 9;
my $a = {
'a' => [qw(a1 a2 a3)],
......@@ -49,10 +49,6 @@ is_deeply($expected2, \@result2, 'CartProd($config, $filter_and_gen)');
is_deeply(( defaults({ 'a' => 'B' }, 'a' => 'A', b => 'B'), { 'a' => 'B', 'b' => 'B' } ), 'defaults1');
is_deeply(( override({ 'a' => 'B' }, 'a' => 'A', b => 'B'), { 'a' => 'A', 'b' => 'B' } ), 'override1');
is_deeply(TestBed::TestSuite::_build_e_from_positionals(), {}, 'e()');
is_deeply(TestBed::TestSuite::_build_e_from_positionals('e1'), { 'eid' => 'e1' }, 'e($eid)');
is_deeply(TestBed::TestSuite::_build_e_from_positionals('p1', 'e1'), { 'pid' => 'p1', 'eid' => 'e1' }, 'e($pid, $eid)');
is_deeply(TestBed::TestSuite::_build_e_from_positionals('p1', 'g1', 'e1'), { 'pid' => 'p1', 'gid' => 'g1', 'eid' => 'e1' }, 'e($pid, $gid, $eid)');
dies_ok( sub { TestBed::TestSuite::_build_e_from_positionals(1, 2, 3, 4) }, 'e(1,2,3,4) dies');
is(e()->eid, "