Commit a2c9d9ad authored by Kevin Tew's avatar Kevin Tew

testsuite/testswap fixes

parent a81925a3
......@@ -62,7 +62,7 @@ sub runtests {
my $result = TestBed::ForkFramework::MaxWorkersScheduler::work($concurrent_pre_runs, sub { shift->prep }, $Executors);
if ($result->has_errors) {
sayd($result->errors);
die 'TestBed::ParallelRunner::runtests died during test prep';
warn 'TestBed::ParallelRunner::runtests died during test prep';
}
#create schedule step
......@@ -91,6 +91,10 @@ sub runtests {
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);
if ($result->has_errors) {
sayd($result->errors);
die 'TestBed::ParallelRunner::runtests died during test execution';
}
return;
}
......
......@@ -88,13 +88,17 @@ sub execute {
die TestBed::ParallelRunner::Executor::SwapinError->new( original => $@ ) if $@;
eval { $self->proc->($e); };
die TestBed::ParallelRunner::Executor::RunError->new( original => $@ ) if $@;
my $run_exception = $@;
eval { $e->swapout_wait; };
die TestBed::ParallelRunner::Executor::SwapoutError->new( original => $@ ) if $@;
my $swapout_exception = $@;
eval { $e->end_wait; };
die TestBed::ParallelRunner::Executor::KillError->new( original => $@ ) if $@;
my $end_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;
}
......
......@@ -47,7 +47,7 @@ returns a list of node names representing each node in the experiment
=cut
sub nodenames {
my ($e) = @_;
my $nodenames = $e->nodeinfo();
my $nodenames = $e->fqnodenames();
return wantarray ? @{$nodenames} : $nodenames;
}
......@@ -57,7 +57,7 @@ returns a list of node hostnames representing each node in the experiment
=cut
sub hostnames {
my ($e) = @_;
my $nodenames = $e->nodeinfo();
my $nodenames = $e->fqnodenames();
my @hostnames = map { $_ =~ /([^\.]*)/; $1 } @$nodenames;
return wantarray ? @hostnames : \@hostnames;
}
......@@ -69,7 +69,7 @@ returns a list of node objects representing each node in the experiment
=cut
sub nodes {
my ($e) = @_;
my @node_instances = map { TestBed::TestSuite::Node->new('experiment' => $e, 'name'=>$_); } @{$e->nodeinfo()};
my @node_instances = map { TestBed::TestSuite::Node->new('experiment' => $e, 'name'=>$_); } @{$e->fqnodenames()};
\@node_instances;
}
......@@ -90,9 +90,8 @@ runs a single_node_tests test across all nodes
=cut
sub single_node_tests {
my ($e) = @_;
for (@{$e->nodes}) {
die $_->name . "failed single_node_tests" unless $_->single_node_tests();
}
for (@{$e->nodes}) {$_->single_node_tests(); }
return 1;
}
=item C<< $e->linktest >>
......
......@@ -2,7 +2,6 @@
package TestBed::TestSuite::Node;
use SemiModern::Perl;
use Mouse;
#use TestBed::XMLRPC::Client::Node;
use Tools::Network;
use Tools::TBSSH;
use Data::Dumper;
......@@ -29,10 +28,10 @@ sub ping_test {
executes hostname, sudo ls, mount via ssh on the remote node
=cut
sub single_node_tests {
my ($self) = @_;
my $ssh = $self->ssh();
my ($s) = @_;
my $ssh = $s->ssh();
$ssh->cmdsuccess("hostname");
$ssh->cmdsuccess("sudo ls");
$ssh->cmdsuccess("sudo id");
$ssh->cmdsuccess("mount");
}
......@@ -54,7 +53,6 @@ sub scp {
return Tools::TBSSH::scp($self->name, @_);
}
=back
=cut
......
......@@ -55,7 +55,7 @@ sub swapin { shift->augment_func_code( 'swapexp', noemail, 'direction' =
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 nodeinfo { parseNodeInfo(shift->augment_func_output('expinfo', 'show' => 'nodeinfo')); }
sub fqnodenames { parseNodeInfo(shift->nodeinfo); }
sub waitforactive { my $e = shift; retry_on_TIMEOUT { $e->augment_func_code('waitforactive', @_) } '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'; }
......@@ -111,7 +111,7 @@ sub inject_sub {
sub gen_expinfo_funcs {
my ($package) = caller();
for my $funcname (qw(mapping linkinfo shaping) ) {
for my $funcname (qw(mapping linkinfo shaping nodeinfo) ) {
my $sub = sub {
shift->augment_func_output('expinfo', 'show' => $funcname );
};
......
......@@ -30,6 +30,10 @@ sub wrapped_ssh {
$ssh = Tools::TBSSH->new('host' => $invocant, 'user' => $user);
}
my @results = $ssh->cmd($cmd);
if ($TBConfig::DEBUG_XML_CLIENT) {
$ssh->saydebug($cmd);
sayd @results;
}
if (defined $checker) {
&$checker(@results) || die "ssh checker of cmd $cmd failed";
......
......@@ -16,7 +16,6 @@ sub cmd {
my $host = $ssh->host;
my $user = $ssh->user;
my $sshcmd = "ssh -x -o BatchMode=yes -o StrictHostKeyChecking=no $user\@$host $cmd";
say $sshcmd if ($TBConfig::DEBUG_XML_CLIENT);
run3($sshcmd, undef, \$out, \$err);
my $rc = $? >> 8;
($out, $err, $rc);
......@@ -29,12 +28,15 @@ sub scp_worker {
my $host = $ssh->host;
my $user = $ssh->user;
my $sshcmd = "scp -o BatchMode=yes -o StrictHostKeyChecking=no @files";
say $sshcmd if ($TBConfig::DEBUG_XML_CLIENT);
run3($sshcmd, undef, \$out, \$err);
my $rc = $? >> 8;
($out, $err, $rc);
}
sub saydebug {
my $s = shift;
say sprintf("ssh %s@%s %s", $s->user, $s->host, "@_");
}
=head1 NAME
......
......@@ -8,15 +8,14 @@ use Data::Dumper;
use Tools;
use TestBed::Wrap::tevc;
#$TBConfig::DEBUG_XML_CLIENT = 1;
$SIG{ __DIE__ } = sub {
use Carp qw(longmess);
say "Caught here " . __FILE__;
sayd(@_);
say "SAYD DONE";
say longmess;
say "LONGMESS DONE";
Carp::confess( "DIED IN SC\n", @_ );
say "CARP DONE";
};
my $ns = <<'NSEND';
......@@ -70,11 +69,20 @@ sub watch {
}
}
sub watchall {
while (1) {
say prettytimestamp;
e->pretty_list;
sleep(5);
}
}
eval {
if (@ARGV) {
$_ = shift;
if (/endall/) { end_all_experiments; }
elsif (/end/) { e($_)->end for(@ARGV); }
elsif (/watchall/) { watchall; }
else {
my $e = e(shift);
if (/--help/) { usage; }
......@@ -86,12 +94,18 @@ if (@ARGV) {
elsif (/tevc/) { $e->tevc(@ARGV); }
elsif (/linktest/) { $e->linktest; }
elsif (/single_node_tests/) { $e->single_node_tests; }
elsif (/fqnn/) { say Dumper($e->fqnodenames) ;}
elsif (/ni/) { say Dumper($e->nodeinfo) ;}
elsif (/li/) { say Dumper($e->linkinfo) ;}
elsif (/im/) { say Dumper($e->info(aspect => 'mapping')) ;}
elsif (/ip/) { say Dumper($e->info(aspect => 'physical')) ;}
elsif (/it/) { say Dumper($e->info(aspect => 'traces')) ;}
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 $@;
sayd($result);
}
else {
......
......@@ -14,4 +14,5 @@ set node1 [$ns node]
$ns run
NSEND
ok(e('sn1')->launchpingswapkill($ns));
ok(e('sn1')->startrunkill($ns, sub { shift->single_node_tests }), 'single_node_tests');
#ok(e('sn1')->single_node_tests, 'single_node_tests');
......@@ -16,7 +16,6 @@ ok($osid, 'osid new works');
isa_ok($osid, 'TestBed::XMLRPC::Client::OSID');
my $resp = $osid->getlist;
sayd(keys %$resp);
ok($resp, 'getlist response');
okcontains($resp, 'RHL-STD', 'RHL90-STD', 'FBSD63-STD');
......
......@@ -19,8 +19,6 @@ sub handleResult {
say "In TooManyLans::handleResult";
$executor->e->modify_ns_wait($newns);
say "Done with TooManyLans->modify_ns_wait";
$executor->e->swapin_wait;
exit;
}
}
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment