Commit 1bd26823 authored by Kevin Tew's avatar Kevin Tew

testsuite/testswap added ensure_swaped_ns, simplifying parallel run

parent 4bce536a
......@@ -10,6 +10,10 @@ TODO
convert more old tests
general result code handling framework
STILL MESSY
XMLRPC/Client/Experiment TestSuite/Experiment return codes, exceptions, composability
Calling parallel tests
EXPAND CURRENT IMPLEMENTATION
event subsystem
parallel support (custom test harness)
......@@ -23,12 +27,13 @@ LATER
create BSD virtual machine for testing
possibly collapse tbts and t/harness
Parallel TODOS
retry
clean up FFF, Roles, constructors
CartProd teste - image test example
DONE
POD function documentation
better general result code handling (ping_test single_node_test)
ForkFramework Constants
Parallel TODOS
retry
clean up FFF, Roles, constructors
CartProd teste - image test example
......@@ -102,6 +102,8 @@ sub workloop {
redo LOOP;
}
}
waitpid( $_, 0 ) for @{ $self->workers };
my @results = (scalar @{$self->errors}, $self->results, $self->errors);
return wantarray ? @results : \@results;
}
......
......@@ -26,18 +26,14 @@ sub _initialize {
}
package TestBed::TestExperiment;
package TestBed::ParallelRunner;
use SemiModern::Perl;
use TestBed::TestExperiment::Test;
use TestBed::ParallelRunner::Test;
use TestBed::ForkFramework;
use Data::Dumper;
my $ExperimentTests = [];
require Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw(teste runtests);
my $teste_desc = <<'END';
Not enough arguments to teste
teste(eid, $ns, $sub, $test_count, $desc);
......@@ -45,13 +41,7 @@ Not enough arguments to teste
teste($pid, $gid, $eid, $ns, $sub, $test_count, $desc);
END
sub teste {
if (@_ == 4) { push @$ExperimentTests, TestBed::TestExperiment::Test::tn('', '', '', @_); }
elsif (@_ == 5) { push @$ExperimentTests, TestBed::TestExperiment::Test::tn('', '', @_); }
elsif (@_ == 6) { push @$ExperimentTests, TestBed::TestExperiment::Test::tn(shift, '', @_); }
elsif (@_ == 7) { push @$ExperimentTests, TestBed::TestExperiment::Test::tn(@_); }
else { die $teste_desc; }
}
sub add_experiment { push @$ExperimentTests, TestBed::ParallelRunner::Test::tn(@_); }
sub runtests {
#prep step
......@@ -62,7 +52,7 @@ sub runtests {
}, $ExperimentTests);
if ($result->[0]) {
sayd($result->[2]);
die 'TestBed::TestExperiment::runtests died during test prep';
die 'TestBed::ParallelRunner::runtests died during test prep';
}
#create schedule step
......@@ -96,6 +86,15 @@ sub reset_test_builder {
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( @_ ) };
......@@ -117,6 +116,7 @@ sub tap_wrapper {
},
sub {
reset_test_builder($te->test_count) if $SUBTESTS;
setup_test_builder_ouputs(*STDOUT, *STDERR);
$te->run_ensure_kill;
});
}
......
#!/usr/bin/perl
package TestBed::TestExperiment::Test;
package TestBed::ParallelRunner::Test;
use SemiModern::Perl;
use TestBed::TestSuite::Experiment;
use Mouse;
......@@ -12,12 +12,8 @@ has 'proc' => ( isa => 'CodeRef', is => 'rw');
has 'test_count' => ( isa => 'Any', is => 'rw');
sub tn {
my ($pid, $gid, $eid, $ns, $sub, $test_count, $desc) = @_;
my $e = TestBed::TestSuite::Experiment->new(
'pid' => $pid,
'gid' => $gid,
'eid' => $eid);
return TestBed::TestExperiment::Test->new(
my ($e, $ns, $sub, $test_count, $desc) = @_;
return TestBed::ParallelRunner::Test->new(
'e' => $e,
'ns' => $ns,
'desc' => $desc,
......@@ -27,7 +23,9 @@ sub tn {
sub prep {
my $self = shift;
$self->e->create_and_get_metadata($self->ns);
my $r = $self->e->create_and_get_metadata($self->ns);
#sayd($r);
$r;
}
sub run {
......
......@@ -2,14 +2,26 @@
package TestBed::TestSuite;
use SemiModern::Perl;
use TestBed::TestSuite::Experiment;
use TestBed::ParallelRunner;
use Data::Dumper;
use Tools;
require Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw(e dpge CartProd CartProdRunner concretize defaults override);
our @EXPORT = qw(e CartProd CartProdRunner concretize defaults override rege runtests);
sub e { TestBed::TestSuite::Experiment->new(_build_e_from_positionals(@_)); }
sub rege {
my $e;
if (@_ == 4) { $e = e(); }
elsif (@_ == 5) { $e = e(shift); }
elsif (@_ == 6) { $e = e(shift, shift); }
elsif (@_ == 7) { $e = e(shift, shift, shift); }
else { die 'Too many args to rege'; }
return TestBed::ParallelRunner::add_experiment($e, @_);
}
sub runtests { TestBed::ParallelRunner::runtests; }
sub _build_e_from_positionals {
if (@_ == 0) { return {}; }
......
......@@ -11,13 +11,7 @@ use TestBed::TestSuite;
use TestBed::TestSuite::Node;
use TestBed::TestSuite::Link;
extends 'Exporter', 'TestBed::XMLRPC::Client::Experiment';
has 'ns' => ( isa => 'Str', is => 'rw');
require Exporter;
our @EXPORT;
push @EXPORT, qw(launchpingkill launchpingswapkill);
extends 'TestBed::XMLRPC::Client::Experiment';
=head1 NAME
......@@ -156,7 +150,7 @@ sub startrun {
=item C<launchpingkill($e, $ns)>
class method that starts an experiment, runs a ping_test, and ends the experiment
method that starts an experiment, runs a ping_test, and ends the experiment
=cut
sub launchpingkill {
my ($e, $ns) = @_;
......@@ -170,7 +164,7 @@ sub launchpingkill {
=item C<launchpingkill($e, $ns)>
class method that starts an experiment, runs a ping_test,
method that starts an experiment, runs a ping_test,
swaps the experiment out and then back in, runs a ping test, and finally
ends the experiment
=cut
......@@ -187,6 +181,24 @@ trytest {
} $e;
}
=item C<pingkill($e)>
method that runs a ping_test,
swaps the experiment out and then back in, runs a ping test, and finally
ends the experiment
=cut
sub pingswapkill {
my ($e) = @_;
my $eid = $e->eid;
trytest {
$e->ping_test && die "connectivity test $eid failed";
$e->swapout_wait && die "swap out $eid failed";
$e->swapin_wait && die "swap in $eid failed";
$e->ping_test && die "connectivity test $eid failed";
$e->end && die "exp end $eid failed";
} $e;
}
=back
=cut
......
......@@ -33,21 +33,14 @@ sub args {
sub echo { shift->augment_output( 'str' => shift ); }
sub getlist_brief { shift->augment( 'format' => 'brief'); }
sub getlist_full { shift->augment( 'format' => 'full' ); }
sub batchexp_ns { shift->augment( 'nsfilestr' => shift, @_ ); }
sub modify_ns { shift->augment( 'nsfilestr' => shift, @_ ); }
sub batchexp_ns { shift->augment_code( 'nsfilestr' => shift, @_ ); }
sub modify_ns { shift->augment_code( 'nsfilestr' => shift, @_ ); }
sub swapin { shift->augment_func_code( 'swapexp', 'direction' => 'in' ); }
sub swapout { shift->augment_func_code( 'swapexp', 'direction' => 'out' ); }
sub end { shift->augment_func_code( 'endexp' ); }
sub nodeinfo { parseNodeInfo(shift->augment_func_output('expinfo', 'show' => 'nodeinfo')); }
sub waitforactive {
my $self = shift;
$self->augment_code(@_) && die sprintf("wait for swapin %s failed", $self->eid);
}
sub waitforswapped {
my $self = shift;
$self->augment_func_code( 'statewait', 'state' => 'swapped' )
&& die sprintf("wait for swapin %s failed", $self->eid);
}
sub waitforactive { shift->augment_code(@_) }
sub waitforswapped { shift->augment_func_code( 'statewait', 'state' => 'swapped' ) }
sub startexp_ns { batchexp_ns(@_, 'batch' => 0); }
sub startexp_ns_wait { batchexp_ns_wait(@_, 'batch' => 0); }
......@@ -60,14 +53,25 @@ sub create_and_get_metadata {
sub batchexp_ns_wait {
my $self = shift;
$self->batchexp_ns(@_);
my $rc = $self->batchexp_ns(@_);
if ($rc) { return $rc }
$self->waitforactive;
}
use constant EXPERIMENT_NAME_ALREADY_TAKEN => 2;
sub ensure_active_ns {
my $self = shift;
my $rc = $self->batchexp_ns(@_);
if ($rc && $rc != EXPERIMENT_NAME_ALREADY_TAKEN) { return $rc }
$self->waitforactive;
}
sub swapin_wait {
my $self = shift;
$self->augment_func_code( 'swapexp', 'direction' => 'in', 'wait' => 1 );
$self->waitforactive;
}
sub swapout_wait {
my $self = shift;
$self->augment_func_code( 'swapexp', 'direction' => 'out', 'wait' => 1 );
......
#! /usr/bin/perl
use TestBed::TestExperiment;
use TestBed::TestSuite;
use RateLimitParallelExample;
# run all the test methods in Example::Test
TestBed::TestExperiment->runtests;
# run all the tests in RateLimitParallelExample
runtests;
#!/usr/bin/perl
use SemiModern::Perl;
use TestBed::TestSuite;
use Test::More tests => 3;
use Data::Dumper;
use BasicNSs;
my $e = e('ensureactive');
=pod
ok(!$e->startexp_ns_wait($BasicNSs::TwoNodeLan), 'first start');
ok($e->startexp_ns_wait($BasicNSs::TwoNodeLan), 'failed second start');
ok(!$e->ensure_active_ns($BasicNSs::TwoNodeLan), 'ensure active_start');
ok(!$e->end);
=cut
sleep(5);
system('./sc');
ok(!$e->ensure_active_ns($BasicNSs::TwoNodeLan), 'ensure active_start');
ok($e->startexp_ns_wait($BasicNSs::TwoNodeLan), 'failed second start');
ok(!$e->end);
......@@ -21,5 +21,5 @@ for (@who_knows) {
my $ns = $Testbed::OldTestSuite::data->{$_}->{'nsfile'};
say "Running " . $_;
say $ns;
ok(launchpingkill(e($_), $ns), $_);
ok(e($_)->launchpingkill($ns), $_);
}
#! /usr/bin/perl
use TestBed::TestSuite;
use BasicTopologies;
# run all the tests in RateLimitParallelExample
runtests;
#!/usr/bin/perl
use SemiModern::Perl;
use TBConfig;
use TestBed::TestSuite;
use Test::More tests => 5;
use Data::Dumper;
......
#!/usr/bin/perl
use SemiModern::Perl;
use TBConfig;
use TestBed::TestSuite;
use Test::More tests => 1;
use Data::Dumper;
......
#!/usr/bin/perl
use SemiModern::Perl;
use TestBed::TestSuite;
use TestBed::TestSuite::Experiment;
use Test::More tests => 1;
use Data::Dumper;
......@@ -15,4 +14,4 @@ set node1 [$ns node]
$ns run
NSEND
ok(launchpingswapkill(e('tewkt'), $ns));
ok(e('tewkt')->launchpingswapkill($ns));
#!/usr/bin/perl
use SemiModern::Perl;
use TestBed::TestSuite;
use TestBed::TestSuite::Experiment;
use Test::More tests => 1;
use Data::Dumper;
......@@ -17,4 +16,4 @@ set lan1 [$ns make-lan "$node1 $node2" 100Mb 0ms]
$ns run
NSEND
ok(launchpingswapkill(e('tewkt'), $ns));
ok(e('tewkt')->launchpingswapkill($ns));
......@@ -10,7 +10,42 @@ set ns [new Simulator]
set node1 [$ns node]
set node2 [$ns node]
set lan1 [$ns make-lan "$node1 $node2" 100Mb 0ms]
$ns run
END
our $TwoNodeLan5Mb = << 'END';
source tb_compat.tcl
set ns [new Simulator]
set node1 [$ns node]
set node2 [$ns node]
set lan1 [$ns make-lan "$node1 $node2" 5Mb 20ms]
$ns run
END
our $SingleNode = << 'END';
source tb_compat.tcl
set ns [new Simulator]
set node1 [$ns node]
$ns run
END
our $TwoNodeLanWithLink = << 'END';
source tb_compat.tcl
set ns [new Simulator]
set node1 [$ns node]
set node2 [$ns node]
set lan1 [$ns make-lan "$node1 $node2" 5Mb 20ms]
set link1 [$ns duplex-link $node1 $node2 100Mb 50ms DropTail]
$ns run
END
......
#!/usr/bin/perl
use SemiModern::Perl;
use TestBed::TestSuite;
use BasicNSs;
use Test::More tests => 4;
use Data::Dumper;
my $linkupdowntest = sub {
my ($e) = @_;
my $eid = $e->eid;
ok($e->linktest, "$eid linktest");
ok($e->link("link1")->down, "link down");
sleep(2);
my $n1ssh = $e->node("node1")->ssh;
ok($n1ssh->cmdfailuredump("ping -c 5 10.1.2.3"));
ok($e->link("link1")->up, "link up");
sleep(2);
ok($n1ssh->cmdsuccessdump("ping -c 5 10.1.2.3"));
};
rege('linkupdown', $BasicNSs::TwoNodeLanWithLink, $linkupdowntest, 5, 'link up and down with ping on link');
my $twonodelan5Mbtest = sub {
my ($e) = @_;
my $eid = $e->eid;
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');
1;
#!/usr/bin/perl
package RateLimitParallelExample;
use TestBed::TestExperiment;
use TestBed::TestSuite;
use BasicNSs;
use Test::More;
......@@ -9,6 +9,6 @@ my $test_body = sub {
ok(!($e->ping_test), 'Ping Test');
};
#$eid, $ns, $test_desc, $ns, $desc)
teste("k$_", $BasicNSs::TwoNodeLan, $test_body, 1, "k$_ desc" ) for (1..2);
rege("k$_", $BasicNSs::TwoNodeLan, $test_body, 1, "k$_ desc" ) for (1..2);
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