Commit 97b7518d authored by Kevin Tew's avatar Kevin Tew

testsuite/testswap Jon Fixes

parent d14d4368
ImageTest
Parameters
OldTests
Cleanup SSH
Painpoints
=================================
Teststeps - don't run certian parts create, swapin, run, swapout, end,
implemented for parallel tests
Testlayout - Suites and Tests
Testoutput -
DOCS TODO
backoff example
......
......@@ -4,8 +4,9 @@ HOWTO write a parallel test.
TestBed::TestStute provides the rege (register experiment for parallel execution) function
rege has the following signature
rege($eid, $ns_file_contents, $test_body_sub, $number_of_tests_in_test_body, $test_description);
rege($e, $ns_file_contents, $test_body_sub, $number_of_tests_in_test_body, $test_description);
$e is the experiment object created with the e($eid) constructor.
when the experiment is swapped in $test_body_sub will get called with a single argument $e, the TestBed::TestSuite::Experiement object.
EXTRA DETAILS:
......@@ -54,8 +55,8 @@ my $twonodelan5Mbtest = sub {
ok($e->linktest, "$eid linktest");
};
rege('2nodelan5Mb', $BasicNSs::TwoNodeLan5Mb, $twonodelan5Mbtest, 1, 'two node 5mb lan pingswapkill');
rege('singlenode', $BasicNSs::SingleNode, sub { ok(shift->pingswapkill); }, 1, 'single node pingswapkill');
rege('2nodelan', $BasicNSs::TwoNodeLan, sub { ok(shift->pingswapkill); }, 1, 'two node lan pingswapkill');
rege(e('2nodelan5Mb'), $BasicNSs::TwoNodeLan5Mb, $twonodelan5Mbtest, 1, 'two node 5mb lan pingswapkill');
rege(e('singlenode'), $BasicNSs::SingleNode, sub { ok(shift->pingswapkill); }, 1, 'single node pingswapkill');
rege(e('2nodelan'), $BasicNSs::TwoNodeLan, sub { ok(shift->pingswapkill); }, 1, 'two node lan pingswapkill');
1;
......@@ -38,12 +38,21 @@ use Data::Dumper;
has 'e' => ( isa => 'TestBed::TestSuite::Experiment', is => 'rw');
has 'desc' => ( isa => 'Str', is => 'rw');
has 'ns' => ( isa => 'Str', is => 'rw');
has 'ns' => ( is => 'rw');
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');
sub ns_text {
my $s = shift;
my $ns = $s->ns;
if (ref($ns) eq 'CODE') {
return $ns->();
}
return $ns;
}
sub parse_options {
my %options = @_;
......@@ -85,26 +94,34 @@ sub handleResult {
}
sub prep {
my $self = shift;
my $r = eval { $self->e->create_and_get_metadata($self->ns); };
my $s = shift;
if (checkno('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 $@;
return $r;
}
sub checkno {
my $stage = shift;
return grep { $_ = $stage } @{ $TBConfig::exclude_steps };
}
sub execute {
my $self = shift;
my $e = $self->e;
my $s = shift;
my $e = $s->e;
eval { $e->swapin_wait; };
eval { $e->swapin_wait; } unless checkno('swapin');
die TestBed::ParallelRunner::Executor::SwapinError->new( original => $@ ) if $@;
eval { $self->proc->($e); };
eval { $s->proc->($e); } unless checkno('run');
my $run_exception = $@;
eval { $e->swapout_wait; };
eval { $e->swapout_wait; } unless checkno('swapout');
my $swapout_exception = $@;
eval { $e->end_wait; };
eval { $e->end_wait; } unless checkno('end');
my $end_exception = $@;
die TestBed::ParallelRunner::Executor::RunError->new( original => $run_exception ) if $run_exception;
......
......@@ -4,6 +4,7 @@ use SemiModern::Perl;
use TestBed::TestSuite::Experiment;
use TestBed::ParallelRunner;
use TestBed::ForkFramework;
use TestBed::XMLRPC::Client::Node;
use Data::Dumper;
use Tools;
......@@ -18,7 +19,7 @@ my $error_sub = sub {
require Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw(e CartProd CartProdRunner concretize defaults override rege runtests prun prunout);
our @EXPORT = qw(e CartProd CartProdRunner concretize defaults override rege runtests prun prunout get_free_node_names);
sub e { TestBed::TestSuite::Experiment->new(_build_e_from_positionals(@_)); }
......@@ -118,6 +119,10 @@ sub prunout {
return $results->sorted_results;
}
sub get_free_node_names {
TestBed::XMLRPC::Client::Node->new()->get_free_node_names(@_);
}
=head1 NAME
TestBed::TestSuite
......
......@@ -8,6 +8,7 @@ use TestBed::Wrap::linktest;
use TestBed::Wrap::loghole;
use Tools;
use Tools::TBSSH;
use Tools::Network;
use Data::Dumper;
use TestBed::TestSuite;
use TestBed::TestSuite::Node;
......@@ -99,6 +100,20 @@ sub ping_test {
}
}
sub wait_for_nodes_to_activate {
my ($e) = shift;
for (@_) {
while ($e->node($_)->ping) { }
}
}
sub traceroute {
my ($e) = shift;
my $src = $e->resolve(shift);
my $dest = $e->resolve(shift);
Tools::Network::traceroute($src, $dest, @_);
}
=item C<< $e->single_node_tests() >>
runs a single_node_tests test across all nodes
......
......@@ -15,13 +15,13 @@ TestBed::TestSuite::Node
=over 4
=item C<< $n->ping_test >>
=item C<< $n->ping >>
=cut
sub ping_test {
sub ping {
my ($self) = @_;
ping($self->name);
Tools::Network::ping($self->name);
}
=item C<< $n->single_node_tests >>
......
......@@ -38,6 +38,8 @@ sub AUTOLOAD {
sub args {
my $self = shift;
die "Odd number of args" . sayd(@_) if ((scalar @_) % 2 !=0);
+{ @_ };
}
......
#!/usr/bin/perl
package TestBed::XMLRPC::Client::Node::InsufficientNodes;
use Mouse;
package TestBed::XMLRPC::Client::Node;
use SemiModern::Perl;
use Mouse;
......@@ -34,6 +37,14 @@ sub get_free_names {
keys %{shift->get_free(@_)};
}
sub get_free_node_names {
my $node = shift;
my $qty = shift;
my @names = $node->get_free_names(@_);
if (scalar @names < $qty ) { die TestBed::XMLRPC::Client::Node::InsufficientNodes->new; }
return @names;
}
=head1 NAME
TestBed::XMLRPC::Client::Node
......@@ -56,9 +67,13 @@ returns a new has containing key,value pairs that $proce returned true for
given a list of nodeshashes return nodehashes for nodes that are free
=item C<get_free_names()>
=item C<get_free_names( param => value, ...)>
returns a list of free node names that meet criteria of params => values
=item C<get_free_names($qrt, )>
given a list of nodeshashes returns a list of node names that are free
returns a list of at least $qty free node names that meet criteria of params => values
=back
......
......@@ -5,7 +5,7 @@ use Net::Ping;
use Tools::TBSSH;
require Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw(ping test_traceroute);
our @EXPORT = qw();
use Data::Dumper;
=head1 NAME
......@@ -28,12 +28,12 @@ sub ping {
!$p->ping($host);
}
=item C<test_traceroute($src, $dest, ['hop1_host', 'hop2_host', ...])>
=item C<traceroute($src, $dest, ['hop1_host', 'hop2_host', ...])>
ssh to host $src and executes a traceroute to $dest ensuring it follows the path specified
returns 0 or 1
=cut
sub test_traceroute ($$@) {
sub traceroute ($$@) {
my ($src,$dest,@path) = @_;
Tools::TBSSH::cmdcheckoutput($src, "traceroute $dest",
sub {
......
......@@ -7,4 +7,4 @@ use Data::Dumper;
use Test::More tests => 2;
ok(Tools::Network::ping($TBConfig::OPS_SERVER), 'ping');
ok(Tools::Network::test_traceroute($TBConfig::OPS_SERVER, 'boss.emulab.net', 'public-router', 'boss'), 'traceroute ops to boss');
ok(Tools::Network::traceroute($TBConfig::OPS_SERVER, 'boss.emulab.net', 'public-router', 'boss'), 'traceroute ops to boss');
......@@ -33,8 +33,11 @@ use Data::Dumper;
my $cmdline_defines;
my $concurrent_prerun_jobs;
my $concurrent_node_usage;
my $exclude_steps;
my $result = GetOptions (
"D=s%" => \$cmdline_defines,
"d" => \$debug,
"debug" => \$debug,
"define=s%" => \$cmdline_defines,
# "jobs=i" => \$pjobs,
"logging=i" => \$logging,
"timing" => \$timing,
......@@ -42,9 +45,9 @@ use Data::Dumper;
"project=s" => \$project,
"xmlrpcurl=s" => \$xmlrpcurl,
"group=s" => \$group,
"debug" => \$debug,
"cprj=i" => \$concurrent_prerun_jobs,
"cnu=i" => \$concurrent_node_usage,
"exsteps=s@" => \$exclude_steps,
);
if ($pjobs > 1) { $ENV { 'HARNESS_OPTIONS' } = "j$pjobs"; }
......@@ -59,8 +62,7 @@ use Data::Dumper;
if ($concurrent_prerun_jobs) { $TBConfig::concurrent_prerun_jobs = $concurrent_prerun_jobs; }
if ($concurrent_node_usage) { $TBConfig::concurrent_node_usage = $concurrent_node_usage; }
if ($cmdline_defines) { $TBConfig::cmdline_defines = $cmdline_defines; }
sayd($TBConfig::cmdline_defines);
if ($exclude_steps) { $TBConfig::exclude_steps = $exclude_steps; }
}
sub usage {
......@@ -106,7 +108,7 @@ if (@ARGV) {
elsif ($_ eq 'podc') { system 'for x in `find lib -iname "*.pm"`; do podchecker $x 2>&1 |grep contain; done; '; }
elsif ($_ eq 'pode') { system 'for x in `find lib -iname "*.pm"`; do podchecker $x 2>&1 |grep ERROR; done;'; }
elsif ($_ eq 'pode') {
eval { use Pod::Coverage; };
eval "use Pod::Coverage;";
unless ($@) {
my $pc = Pod::Coverage->new(package => 'Pod::Coverage');
print "We rock!" if $pc->coverage == 1;
......
#!/usr/bin/perl
use SemiModern::Perl;
use TestBed::TestSuite;
sub build_ns(@){
my $data =<<'EOF';
# Generated by NetlabClient
set ns [new Simulator]
source tb_compat.tcl
# Nodes
set a1 [$ns node]
set a2 [$ns node]
set a3 [$ns node]
set b1 [$ns node]
set b2 [$ns node]
set b3 [$ns node]
tb-fix-node $a1 @physical_host1@
tb-fix-node $a2 @physical_host1@
tb-fix-node $a3 @physical_host1@
tb-fix-node $b1 @physical_host2@
tb-fix-node $b2 @physical_host2@
tb-fix-node $b3 @physical_host2@
tb-set-node-failure-action $a1 "nonfatal"
tb-set-node-failure-action $a2 "nonfatal"
tb-set-node-failure-action $a3 "nonfatal"
tb-set-node-failure-action $b1 "nonfatal"
tb-set-node-failure-action $b2 "nonfatal"
tb-set-node-failure-action $b3 "nonfatal"
tb-set-node-os $a1 FC8-XEN
tb-set-node-os $a2 FC8-XEN
tb-set-node-os $a3 FC8-XEN
tb-set-node-os $b1 FC8-XEN
tb-set-node-os $b2 FC8-XEN
tb-set-node-os $b3 FC8-XEN
tb-set-hardware $a1 pcvm
tb-set-hardware $a2 pcvm
tb-set-hardware $a3 pcvm
tb-set-hardware $b1 pcvm
tb-set-hardware $b2 pcvm
tb-set-hardware $b3 pcvm
tb-set-vlink-emulation "vlan"
# Links
set link0 [$ns duplex-link $a1 $a3 100000.0kb 0.0ms DropTail]
set link1 [$ns duplex-link $a3 $a2 100000.0kb 0.0ms DropTail]
set link2 [$ns duplex-link $b1 $b3 100000.0kb 0.0ms DropTail]
set link3 [$ns duplex-link $b3 $b2 100000.0kb 0.0ms DropTail]
# Lans
set lan0 [$ns make-lan "$a1 $b1" 100000.0kb 0.0ms]
set lan1 [$ns make-lan "$a2 $b2" 100000.0kb 0.0ms]
$ns rtproto Static
$ns run
# NetlabClient generated file ends here.
# Finished at: 6/24/09 2:03 PM
EOF
my ($node1, $node2) = get_free_node_names(2, 'type' => 'pc3000');
return concretize($data, 'physical_host1' => $node1, 'physical_host2' => $node2);
}
sub testbody($){
my ($e) = @_;
$e->wait_for_nodes_to_activate(qw(a1 b1));
ok($e->traceroute('a1', 'b1', qw(a1-lan0)), 'traceroute between a1 and b1');
}
rege(e('xentestingk'), \&build_ns, \&testbody, 1, "testing xen using kevin's stuff");
1;
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