Commit 5b12cbc6 authored by Kevin Tew's avatar Kevin Tew

testsuite/testswap cleanup

parent a4edf0a8
THARNESS=perl t/harness
all: usage
$(MAKE) test
usage:
@echo "make"
@echo " test"
@echo " exptest"
@echo " t/SPECIFIC_TEST.t"
test:
$(THARNESS)
critic:
perlcritic .
topo:
$(THARNESS) t/topologies/*.t
# Run a single test
t/*.t t/*/*.t t/*/*/*.t: force
$(THARNESS) $@
force: ;
...@@ -13,7 +13,7 @@ our $XMLRPC_SERVER_TIMEOUT = 60 * 10; #seconds ...@@ -13,7 +13,7 @@ our $XMLRPC_SERVER_TIMEOUT = 60 * 10; #seconds
our $SSL_CLIENT_CERT = glob("~/.ssl/emulab.cert"); our $SSL_CLIENT_CERT = glob("~/.ssl/emulab.cert");
our $SSL_CLIENT_KEY = glob("~/.ssl/decrypted_emulab.key"); our $SSL_CLIENT_KEY = glob("~/.ssl/decrypted_emulab.key");
our $EMULAB_USER = get_emulab_user(); our $EMULAB_USER = get_emulab_user();
our $DEFAULT_PID = $ENV{'TBTS_PROJECT'} || 'tbres'; our $DEFAULT_PID = $ENV{'TBTS_PROJECT'} || 'tbtest';
our $DEFAULT_GID = $ENV{'TBTS_GROUP'} || ''; our $DEFAULT_GID = $ENV{'TBTS_GROUP'} || '';
our $DEBUG_XML_CLIENT = $ENV{'TBTS_DEBUG'} || 0; our $DEBUG_XML_CLIENT = $ENV{'TBTS_DEBUG'} || 0;
our $CMDLINE_OPTIONS = {}; our $CMDLINE_OPTIONS = {};
...@@ -21,6 +21,9 @@ our @EXPERIMENT_OPS_PARAMS = ('noemail' => 1); ...@@ -21,6 +21,9 @@ our @EXPERIMENT_OPS_PARAMS = ('noemail' => 1);
our $concurrent_prerun_jobs = 4; our $concurrent_prerun_jobs = 4;
our $concurrent_node_usage = 20; our $concurrent_node_usage = 20;
our $EMULAB_SUFFIX = "emulab.net"; our $EMULAB_SUFFIX = "emulab.net";
our $cmdline_defines = {};
our $exclude_steps = qw();
our $runonly;
sub get_emulab_user { sub get_emulab_user {
my $cert = slurp($SSL_CLIENT_CERT); my $cert = slurp($SSL_CLIENT_CERT);
......
OldTests OldTests
Massive Run Massive Run
Painpoints Painpoints
================================= =================================
Testlayout - Suites and Tests, buildup, teardown using Test::Class Testlayout - Suites and Tests, buildup, teardown using Test::Class
...@@ -12,17 +11,14 @@ DOCS TODO ...@@ -12,17 +11,14 @@ DOCS TODO
more prose docs more prose docs
TODO TODO
TESTLWP
SSH SCP Cleanup SSH SCP Cleanup
Revisit CartProd
EXPAND CURRENT IMPLEMENTATION
event subsystem
LATER LATER
Client.pm duplicate code elimination - Maybe this would make the code too unreadable test groupings - use - perl modules works for now
test groupings - use Perl modules works now
Large External Tars and Resources for experiements Large External Tars and Resources for experiements
EXPAND CURRENT IMPLEMENTATION
event subsystem
Parallel TODOS Parallel TODOS
clean up FF, Roles, constructors clean up FF, Roles, constructors
CartProd teste - image test example
#!/usr/bin/perl
use Modern::Perl;
use File::Temp;
use Data::Dumper;
use IPC::Run3;
my $fn;
my @todos;
while(my $line = <STDIN>) {
given($line) {
when(/^not ok \d+ - Pod coverage on (\S+)/) {
$fn = $1;
$fn =~ s/::/\//g;
$fn .= '.pm';
my $a = <STDIN> for (1..4);
}
when( /Looks like you failed/) {
next;
}
when( /^#\s+(\S+)/ ) {
push @todos, [$fn, $1];
}
}
}
for (@todos) {
my $temp = File::Temp->new();
my $sfn = $temp->filename;
my $fn = $_->[0];
my $subname = $_->[1];
$temp->print("/$subname\n");
run3("vim lib/$fn -s $sfn");
}
#say Dumper(\@todos);
exec 'reset';
...@@ -34,7 +34,7 @@ sub runtests { ...@@ -34,7 +34,7 @@ sub runtests {
$concurrent_node_count_usage ||= $TBConfig::concurrent_node_usage; $concurrent_node_count_usage ||= $TBConfig::concurrent_node_usage;
if ( $TBConfig::runonly) { if ( $TBConfig::runonly) {
$s->executors([ (grep { my $executor = $_; (grep { $_ eq $executor->e->eid } @{$TBConfig::single}) } @{$s->executors}) ]); $s->executors([ (grep { my $executor = $_; (grep { $_ eq $executor->e->eid } @{$TBConfig::runonly}) } @{$s->executors}) ]);
} }
#prerun step #prerun step
......
...@@ -69,20 +69,21 @@ RETRY: ...@@ -69,20 +69,21 @@ RETRY:
} }
} }
sub mkerrmsg { my $e = shift; return $e->eid . " " . shift;}
sub noemail { @TBConfig::EXPERIMENT_OPS_PARAMS; } sub noemail { @TBConfig::EXPERIMENT_OPS_PARAMS; }
sub echo { shift->augment_output( 'str' => shift ); } sub echo { shift->augment_output( 'str' => shift ); }
sub getlist_brief { shift->augment( 'format' => 'brief'); } sub getlist_brief { shift->augment( 'format' => 'brief'); }
sub getlist_full { shift->augment( 'format' => 'full' ); } sub getlist_full { shift->augment( 'format' => 'full' ); }
sub batchexp_ns { shift->augment_code( 'nsfilestr' => shift, 'noswapin' =>1, noemail, 'extrainfo' => 1, @_ ); } 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 modify_ns { shift->augment_code( 'nsfilestr' => shift, 'noswapin' =>1, noemail, 'extrainfo' => 1, @_ ); }
sub swapin { my $e = shift; my @args = @_; retry_on_TIMEOUT { $e->augment_func_code( 'swapexp', noemail, 'direction' => 'in', 'extrainfo' => 1, @args ) } 'swapin'; } sub swapin { my $e = shift; my @args = @_; retry_on_TIMEOUT { $e->augment_func_code( 'swapexp', noemail, 'direction' => 'in', 'extrainfo' => 1, @args ) } $e->mkerrmsg('swapin'); }
sub swapout { shift->augment_func_code( 'swapexp', noemail, 'direction' => 'out','extrainfo' => 1, @_ ); } sub swapout { shift->augment_func_code( 'swapexp', noemail, 'direction' => 'out','extrainfo' => 1, @_ ); }
sub end { shift->augment_func_code( 'endexp', noemail); } sub end { shift->augment_func_code( 'endexp', noemail); }
sub end_wait { shift->augment_func_code( 'endexp', noemail, 'wait' => 1); } sub end_wait { shift->augment_func_code( 'endexp', noemail, 'wait' => 1); }
sub fqnodenames { parseNodeInfo(shift->nodeinfo); } sub fqnodenames { parseNodeInfo(shift->nodeinfo); }
sub waitforactive { my $e = shift; my @args = @_; retry_on_TIMEOUT { $e->augment_func_code('waitforactive', @args) } 'waitforactive'; } sub waitforactive { my $e = shift; my @args = @_; retry_on_TIMEOUT { $e->augment_func_code('waitforactive', @args) } $e->mkerrmsg('waitforactive'); }
sub waitforswapped { my $e = shift; retry_on_TIMEOUT { $e->augment_func_code( 'statewait', 'state' => 'swapped' ) } 'waitforswapped'; } sub waitforswapped { my $e = shift; retry_on_TIMEOUT { $e->augment_func_code( 'statewait', 'state' => 'swapped' ) } $e->mkerrmsg('waitforswapped'); }
sub waitforended { my $e = shift; retry_on_TIMEOUT { $e->augment_func_code( 'statewait', 'state' => 'ended' ) } 'waitforended'; } sub waitforended { my $e = shift; retry_on_TIMEOUT { $e->augment_func_code( 'statewait', 'state' => 'ended' ) } $e->mkerrmsg('waitforended'); }
sub startexp_ns { batchexp_ns(@_, 'batch' => 0); } sub startexp_ns { batchexp_ns(@_, 'batch' => 0); }
sub startexp_ns_wait { batchexp_ns_wait(@_, 'batch' => 0); } sub startexp_ns_wait { batchexp_ns_wait(@_, 'batch' => 0); }
...@@ -319,6 +320,10 @@ B<INTERNAL>: catches socket timeout exceptions and rexecutes &sub after printing ...@@ -319,6 +320,10 @@ B<INTERNAL>: catches socket timeout exceptions and rexecutes &sub after printing
B<INTERNAL>: catches socket timeout exceptions and returns success B<INTERNAL>: catches socket timeout exceptions and returns success
=item C<< $e->mkerrmsg($messag) >>
B<INTERNAL>: prepends error message with eid
=back =back
=cut =cut
......
...@@ -100,7 +100,7 @@ eval { ...@@ -100,7 +100,7 @@ eval {
if (@ARGV) { if (@ARGV) {
$_ = shift; $_ = shift;
if (/endall/) { end_all_experiments; } if (/endall/) { end_all_experiments; }
elsif (/end/) { e($_)->end for(@ARGV); } elsif (/end/) { for(@ARGV) { e(split(/\./, $_))->end; }; }
elsif (/watchall/) { watchall; } elsif (/watchall/) { watchall; }
elsif (/rn/) { (say Dumper(Tools::Network::node_reboot($_))) for @ARGV; } elsif (/rn/) { (say Dumper(Tools::Network::node_reboot($_))) for @ARGV; }
else { else {
......
#!/usr/bin/perl
use SemiModern::Perl;
use TestBed::XMLRPC::Client::Emulab;
use Test::More tests => 3;
use Time::Local;
use Data::Dumper;
use Tools;
use RPC::XML qw(time2iso8601);
my $emuclient = TestBed::XMLRPC::Client::Emulab->new();
ok($emuclient);
isa_ok($emuclient, 'TestBed::XMLRPC::Client::Emulab');
my $time = timegm(0,0,0,1,0,2008);
my $resp = $emuclient->news('starting' => time2iso8601($time));
ok($resp);
#!/usr/bin/perl
use SemiModern::Perl;
use TestBed::TestSuite::Experiment::Macros tests => 3;
use Test::More;
use Data::Dumper;
my $teststr = "hello there";
like(echo($teststr), qr/$teststr/, "Experiment echo test");
ok(list_brief(), "Experiment getlist brief");
ok(list_full(), "Experiment getlist full");
#!/usr/bin/perl
use TestBed::TestSuite;
use VNodeTest;
my $config = {
'OS' => [qw( AOS BOS COS )],
'HARDWARE' => [qw( AHW BHW CHW )],
'LINKTYPE' => [qw( ALT BLT CLT )],
};
CartProdRunner(\&VNodeTest::VNodeTest, $config);
...@@ -104,7 +104,8 @@ TestBed TestSwap ...@@ -104,7 +104,8 @@ TestBed TestSwap
TESTSUITES: TESTSUITES:
all - all tests all - all framework tests
all - all framework tests
sanity - all framework utility and xmlrpc client modules test sanity - all framework utility and xmlrpc client modules test
lib - all framework utility tests lib - all framework utility tests
xmlrpc - all xmlrpc client modules tests xmlrpc - all xmlrpc client modules tests
...@@ -126,8 +127,9 @@ if (@ARGV) { ...@@ -126,8 +127,9 @@ if (@ARGV) {
my @xmlrpc = qw(t/xmlrpc/*.t); my @xmlrpc = qw(t/xmlrpc/*.t);
my @lib = qw(t/lib/*.t t/lib/*/*.t t/tbts/cmdlineargs.t); my @lib = qw(t/lib/*.t t/lib/*/*.t t/tbts/cmdlineargs.t);
my @sanity = (@lib, @xmlrpc); my @sanity = (@lib, @xmlrpc);
my @all = ( @lib, @xmlrpc, qw( t/livetests/*.t ) ); my @all = sort(array_single_difference([all_ts], [qw(t/coding/pod_coverage.t t/noautorun/tbts_cmdlineargs.t t/eine/elab_in_elab.t)]));
@all = sort(array_single_difference([all_ts], [qw(t/coding/pod_coverage.t t/noautorun/tbts_cmdlineargs.t t/eine/elab_in_elab.t)])); my @massive = (all_tpms);
my $cmd = $ARGV[0]; my $cmd = $ARGV[0];
$_ = $cmd; $_ = $cmd;
chomp $_; chomp $_;
...@@ -135,11 +137,12 @@ if (@ARGV) { ...@@ -135,11 +137,12 @@ if (@ARGV) {
elsif ($_ eq 'podc') { system 'for x in `find lib -iname "*.pm"`; do podchecker $x 2>&1 |grep contain; done; '; } 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') { system 'for x in `find lib -iname "*.pm"`; do podchecker $x 2>&1 |grep ERROR; done;'; }
elsif (/critic/) { exec 'perlcritic lib t'; } elsif (/critic/) { exec 'perlcritic lib t'; }
elsif (/massive/) { runharness( @massive ); }
elsif (/all/) { runharness( @all ); } elsif (/all/) { runharness( @all ); }
elsif (/sanity/) { runharness( @sanity ); } elsif (/sanity/) { runharness( @sanity ); }
elsif (/lib/) { runharness( @lib ); } elsif (/lib/) { runharness( @lib ); }
elsif (/xmlrpc/) { runharness( @xmlrpc ); } elsif (/xmlrpc/) { runharness( @xmlrpc ); }
elsif (/coding/) { runharness( qw(t/coding/pod_coverage.t) ); } elsif (/podcov/) { exec './tbts t/coding/pod_coverage.t 2>&1 | perl devtools/podfailure.pl'; }
} }
else { else {
usage(); usage();
......
...@@ -30,7 +30,7 @@ my $twonodelan5Mbtest = sub { ...@@ -30,7 +30,7 @@ my $twonodelan5Mbtest = sub {
}; };
rege(e('2nodelan5Mb'), $BasicNSs::TwoNodeLan5Mb, $twonodelan5Mbtest, 1, 'two node 5mb 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('1singlenode'), $BasicNSs::SingleNode, sub { ok(shift->pingswapkill); }, 1, 'single node pingswapkill');
rege(e('2nodelan'), $BasicNSs::TwoNodeLan, sub { ok(shift->pingswapkill); }, 1, 'two node lan pingswapkill'); rege(e('2nodelan'), $BasicNSs::TwoNodeLan, sub { ok(shift->pingswapkill); }, 1, 'two node lan pingswapkill');
1; 1;
...@@ -363,6 +363,6 @@ END ...@@ -363,6 +363,6 @@ END
ok( $results[$_] =~ /^3\n4\n$/, "noderes$_") for (3..4); ok( $results[$_] =~ /^3\n4\n$/, "noderes$_") for (3..4);
} }
rege(e('sync'), concretize($Sync, OS => $OS), \&sync_test, 7, 'ImageTest-sync test'); rege(e('itsync'), concretize($Sync, OS => $OS), \&sync_test, 7, 'ImageTest-sync test');
1; 1;
...@@ -7,27 +7,21 @@ use OldTestSuite; ...@@ -7,27 +7,21 @@ use OldTestSuite;
our @requires_db = qw( db1 ); our @requires_db = qw( db1 );
our @too_big = qw( spinglass ); 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_pass = qw( fixed basic cbr complete5 delaylan1 delaylink multilink ixp lan1 nodes singlenode trafgen simplelink simplex setip red ping vtypes mininodes sharkshelf basicrsrv minisetip buddycache trivial minimultilink );
our @should_fail = qw( negprerun toomanylinks toofast dnardshelf ); our @should_fail = qw( negprerun toomanylinks toofast dnardshelf );
our @broken = qw( ); our @broken = qw( spinglass2 minitbcmd tbcmd wideareatypes wideareamapped );
our @unknown = qw( sharkshelf spinglass2 basicrsrv wideareatypes minisetip db1 buddycache trivial minitbcmd wideareamapped minimultilink tbcmd );
=pod =pod
vtypes (may want to parameterize the vtypes) vtypes (may want to parameterize the vtypes)
fixed (you will have to change the ns file depending on which nodes are available) fixed (you will have to change the ns file depending on which nodes are available)
=cut =cut
for (@unknown) { #for (@should_fail) {
#for (@broken) {
for (@should_pass) {
my $eid = $_; my $eid = $_;
my $ns = $OldTestSuite::tests->{$_}->{'nsfile'}; my $ns = $OldTestSuite::tests->{$_}->{'nsfile'};
rege(e($_), $ns, sub { ok(!shift->ping_test, $eid); }, 1, $_) rege(e($_), $ns, sub { ok(!shift->ping_test, $eid); }, 1, $_)
} }
=pod
for (@should_fail) {
my $eid = $_;
my $ns = $OldTestSuite::tests->{$_}->{'nsfile'};
rege(e($_), $ns, sub { ok(!shift->ping_test, $eid); }, 1, $_, )
}
=cut
1; 1;
package ImageTests; package SyncTests;
use SemiModern::Perl; use SemiModern::Perl;
use TestBed::TestSuite; use TestBed::TestSuite;
use Test::More; use Test::More;
......
...@@ -34,4 +34,4 @@ my $test = sub { ...@@ -34,4 +34,4 @@ my $test = sub {
ok($n1ssh->cmdsuccessdump("ping -c 5 10.1.2.3")); ok($n1ssh->cmdsuccessdump("ping -c 5 10.1.2.3"));
}; };
rege(e('linkupdown'), $ns, $test, 5, 'single_node_tests'); rege(e('tplinkupdown'), $ns, $test, 5, 'single_node_tests');
...@@ -18,6 +18,6 @@ NSEND ...@@ -18,6 +18,6 @@ NSEND
rege(e('twonodelinktest'), $ns, rege(e('twonodelinktest'), $ns,
sub { sub {
my ($e) = @_; my ($e) = @_;
my $e = $e->eid; my $eid = $e->eid;
ok($e->linktest, "$eid linktest"); ok($e->linktest, "$eid linktest");
}, 1, 'single_node_tests'); }, 1, 'single_node_tests');
...@@ -11,4 +11,4 @@ set node1 [$ns node] ...@@ -11,4 +11,4 @@ set node1 [$ns node]
$ns run $ns run
NSEND NSEND
rege(e('singlenode'), $ns, sub { ok(shift->single_node_tests); }, 1, 'single_node_tests'); rege(e('tpsinglenode'), $ns, sub { ok(shift->single_node_tests); }, 1, 'single_node_tests');
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