Commit b640f8dd authored by Kevin Tew's avatar Kevin Tew

testsuite/testswap cpan helper update, bug fixes

parent 224f68c6
......@@ -15,17 +15,14 @@ TODO
TESTLWP
SSH SCP Cleanup
STILL MESSY
XMLRPC/Client/Experiment TestSuite/Experiment dsl
EXPAND CURRENT IMPLEMENTATION
event subsystem
LATER
Client.pm duplicate code elimination - Maybe this would make the code too unreadable
test groupings
test groupings - use Perl modules works now
Large External Tars and Resources for experiements
Parallel TODOS
clean up FFF, Roles, constructors
clean up FF, Roles, constructors
CartProd teste - image test example
......@@ -41,7 +41,9 @@ sub runtests {
my $result = TestBed::ForkFramework::ForEach::max_work($concurrent_pre_runs, sub { shift->prerun }, $s->executors);
if ( $result->has_errors ) {
for (@{$result->errors}) {
$s->executor($_->itemid)->handleResult(undef, $_);
my $executor = $s->executor($_->itemid);
$_->name($executor->e->eid);
$executor->handleResult(undef, $_);
}
sayd($result->errors);
warn 'TestBed::ParallelRunner::runtests died during test prep';
......@@ -62,6 +64,7 @@ sub runtests {
if ($maximum_nodes > $concurrent_node_count_usage) {
warn "$eid requires upto $maximum_nodes nodes, only $concurrent_node_count_usage concurrent nodes permitted\n$eid will not be run";
$executor->e->end_wait;
}
else {
$workscheduler->add_task($executor, $maximum_nodes);
......
......@@ -129,7 +129,7 @@ sub execute {
eval { $e->end_wait; } unless checkexclude('end');
my $end_exception = $@;
die TestBed::ParallelRunner::Executor::SwapinError->new( original => $@ ) if $swapin_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;
......
package OldTestSuite;
our $tests = {
'frontend' => {},
'cbr' => {
'info' => 'Test UDP and a TCP agent/CBR. Also throw in some events to start/stop
the trafgen.
......@@ -119,7 +118,7 @@ tb_run("tbswap out",0);
tb_run("tbend",0);
'
},
'mini_nodes' => {
'mininodes' => {
'info' => 'Six nodes:
node2 - node0 - node1
......@@ -129,7 +128,8 @@ tb_run("tbend",0);
node0 to node3 is delayed.
',
'nsfile' => 'set ns [new Simulator]
'nsfile' => 'source tb_compat.tcl
set ns [new Simulator]
set node0 [$ns node]
set node1 [$ns node]
......@@ -137,10 +137,10 @@ set node2 [$ns node]
set node3 [$ns node]
set node4 [$ns node]
$ns duplex-link $node0 $node1 100Mb .1ms DropTail
$ns duplex-link $node0 $node1 100Mb 0ms DropTail
$ns duplex-link $node0 $node3 10Mb 100ms DropTail
$ns duplex-link $node2 $node4 100Mb .1ms DropTail
$ns duplex-link $node3 $node1 100Mb .1ms DropTail
$ns duplex-link $node2 $node4 100Mb 0ms DropTail
$ns duplex-link $node3 $node1 100Mb 0ms DropTail
$ns run
......@@ -498,7 +498,6 @@ tb_run("tbswap out",0);
tb_run("tbend",0);
'
},
'full' => {},
'simplex' => {
'info' => 'Basic with the simplex tb commands.
',
......@@ -897,7 +896,7 @@ tb_run("tbswap out",0);
tb_run("tbend",0);
'
},
'basic_rsrv' => {
'basicrsrv' => {
'info' => 'Just a basic initial test.
Topology:
......@@ -960,7 +959,7 @@ tb_run("tbend",0);
(\'pc10\',\'testbed\',\'unavailable\',0,\'pc10\',\'node\');
'
},
'widearea_types' => {
'wideareatypes' => {
'info' => 'Tests widearea nodes, using general types, such as Internet, Internet2, etc.
',
'nsfile' => 'set ns [new Simulator]
......@@ -1051,8 +1050,7 @@ tb_run("tbswap out",0);
tb_run("tbend",0);
'
},
'delaycheck' => {},
'mini_set-ip' => {
'minisetip' => {
'info' => 'Sets up a basic topology and then tries out all the tb-set-ip commands.
',
......@@ -1183,7 +1181,6 @@ tb_run("tbswap out",0);
tb_run("tbend",0);
'
},
'10mbit' => {},
'buddycache' => {
'info' => 'This is the buddycache experiment from Brandeis University. It\'s a LAN of
7 nodes, one of which, or, has a delay.
......@@ -1206,7 +1203,7 @@ set fe5 [$ns node]
set proxy [$ns node]
set or [$ns node]
set lan0 [$ns make-lan "$fe1 $fe2 $fe3 $fe4 $fe5 $proxy $or" 100Mb .1ms]
set lan0 [$ns make-lan "$fe1 $fe2 $fe3 $fe4 $fe5 $proxy $or" 100Mb 2ms]
tb-set-node-lan-delay $or $lan0 20ms
$ns run
......@@ -1223,7 +1220,9 @@ tb_run("tbend",0);
'info' => 'Trivial test. Creates a simulator and runs it. No nodes, no lans,
nothing.
',
'nsfile' => 'set ns [new Simulator]
'nsfile' => '
source tb_compat.tcl
set ns [new Simulator]
$ns run
',
......@@ -1235,7 +1234,7 @@ tb_run("tbswap out",0);
tb_run("tbend",0);
'
},
'widearea_mapped' => {
'wideareamapped' => {
'info' => 'A widearea test that asks for specific links between nodes, which must be
mapped with the WAN solver.
',
......@@ -1265,7 +1264,7 @@ tb_run("tbswap out",0);
tb_run("tbend",0);
'
},
'mini_tbcmd' => {
'minitbcmd' => {
'info' => 'NOT A FULL TEST!
This is a test of all the tb-* commands. It also checks does checks on
......@@ -1395,7 +1394,7 @@ tb_run("tbswap in",255);
tb_run("tbend",0);
'
},
'mini_multilink' => {
'minimultilink' => {
'info' => 'Two nodes connceted by undelayed links.
',
......
......@@ -5,29 +5,29 @@ use Test::More;
use Data::Dumper;
use OldTestSuite;
our @should_pass = qw( basic cbr complete5 delaylan1 delaylink multilink ixp lan1 nodes singlenode trafgen simplelink simplex setip red ping );
our @should_fail = qw( negprerun toomanylinks toofast );
#unclassified
#frontend dnardshelf mini_nodes spinglass sharkshelf full vtypes spinglass2 fixed set-ip basic_rsrv widearea_types delaycheck mini_set-ip db1 10mbit buddycache trivial mini_tbcmd widearea_mapped mini_multilink tbcmd
our @requires_db = qw( db1 );
our @too_big = qw( spinglass );
our @should_pass = qw( fixed basic cbr complete5 delaylan1 delaylink multilink ixp lan1 nodes singlenode trafgen simplelink simplex setip red ping vtypes mininodes );
our @should_fail = qw( negprerun toomanylinks toofast dnardshelf );
our @broken = qw( );
our @unknown = qw( sharkshelf spinglass2 basicrsrv wideareatypes minisetip db1 buddycache trivial minitbcmd wideareamapped minimultilink tbcmd );
=pod
vtypes (may want to parameterize the vtypes)
fixed (you will have to change the ns file depending on which nodes are available)
=cut
=pod
for (@should_pass) {
for (@unknown) {
my $eid = $_;
my $ns = $OldTestSuite::tests->{$_}->{'nsfile'};
rege(e($_), $ns, sub { ok(!shift->ping_test, $eid); }, 1, $_)
}
=cut
=pod
for (@should_fail) {
my $eid = $_;
my $ns = $OldTestSuite::tests->{$_}->{'nsfile'};
rege(e($_), $ns, sub { ok(!shift->ping_test, $eid); }, 1, $_, )
}
=cut
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