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
our $SSL_CLIENT_CERT = glob("~/.ssl/emulab.cert");
our $SSL_CLIENT_KEY = glob("~/.ssl/decrypted_emulab.key");
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 $DEBUG_XML_CLIENT = $ENV{'TBTS_DEBUG'} || 0;
our $CMDLINE_OPTIONS = {};
......@@ -21,6 +21,9 @@ our @EXPERIMENT_OPS_PARAMS = ('noemail' => 1);
our $concurrent_prerun_jobs = 4;
our $concurrent_node_usage = 20;
our $EMULAB_SUFFIX = "emulab.net";
our $cmdline_defines = {};
our $exclude_steps = qw();
our $runonly;
sub get_emulab_user {
my $cert = slurp($SSL_CLIENT_CERT);
......
OldTests
Massive Run
Painpoints
=================================
Testlayout - Suites and Tests, buildup, teardown using Test::Class
......@@ -12,17 +11,14 @@ DOCS TODO
more prose docs
TODO
TESTLWP
SSH SCP Cleanup
EXPAND CURRENT IMPLEMENTATION
event subsystem
Revisit CartProd
LATER
Client.pm duplicate code elimination - Maybe this would make the code too unreadable
test groupings - use Perl modules works now
test groupings - use - perl modules works for now
Large External Tars and Resources for experiements
EXPAND CURRENT IMPLEMENTATION
event subsystem
Parallel TODOS
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 {
$concurrent_node_count_usage ||= $TBConfig::concurrent_node_usage;
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
......
......@@ -69,20 +69,21 @@ RETRY:
}
}
sub mkerrmsg { my $e = shift; return $e->eid . " " . shift;}
sub noemail { @TBConfig::EXPERIMENT_OPS_PARAMS; }
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_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 end { shift->augment_func_code( 'endexp', noemail); }
sub end_wait { shift->augment_func_code( 'endexp', noemail, 'wait' => 1); }
sub fqnodenames { parseNodeInfo(shift->nodeinfo); }
sub waitforactive { my $e = shift; my @args = @_; retry_on_TIMEOUT { $e->augment_func_code('waitforactive', @args) } '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'; }
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' ) } $e->mkerrmsg('waitforswapped'); }
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_wait { batchexp_ns_wait(@_, 'batch' => 0); }
......@@ -319,6 +320,10 @@ B<INTERNAL>: catches socket timeout exceptions and rexecutes &sub after printing
B<INTERNAL>: catches socket timeout exceptions and returns success
=item C<< $e->mkerrmsg($messag) >>
B<INTERNAL>: prepends error message with eid
=back
=cut
......
......@@ -100,7 +100,7 @@ eval {
if (@ARGV) {
$_ = shift;
if (/endall/) { end_all_experiments; }
elsif (/end/) { e($_)->end for(@ARGV); }
elsif (/end/) { for(@ARGV) { e(split(/\./, $_))->end; }; }
elsif (/watchall/) { watchall; }
elsif (/rn/) { (say Dumper(Tools::Network::node_reboot($_))) for @ARGV; }
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
TESTSUITES:
all - all tests
all - all framework tests
all - all framework tests
sanity - all framework utility and xmlrpc client modules test
lib - all framework utility tests
xmlrpc - all xmlrpc client modules tests
......@@ -126,8 +127,9 @@ if (@ARGV) {
my @xmlrpc = qw(t/xmlrpc/*.t);
my @lib = qw(t/lib/*.t t/lib/*/*.t t/tbts/cmdlineargs.t);
my @sanity = (@lib, @xmlrpc);
my @all = ( @lib, @xmlrpc, qw( t/livetests/*.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 @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];
$_ = $cmd;
chomp $_;
......@@ -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 'pode') { system 'for x in `find lib -iname "*.pm"`; do podchecker $x 2>&1 |grep ERROR; done;'; }
elsif (/critic/) { exec 'perlcritic lib t'; }
elsif (/massive/) { runharness( @massive ); }
elsif (/all/) { runharness( @all ); }
elsif (/sanity/) { runharness( @sanity ); }
elsif (/lib/) { runharness( @lib ); }
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 {
usage();
......
......@@ -30,7 +30,7 @@ my $twonodelan5Mbtest = sub {
};
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');
1;
......@@ -363,6 +363,6 @@ END
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;
......@@ -7,27 +7,21 @@ use OldTestSuite;
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_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 @broken = qw( );
our @unknown = qw( sharkshelf spinglass2 basicrsrv wideareatypes minisetip db1 buddycache trivial minitbcmd wideareamapped minimultilink tbcmd );
our @broken = qw( spinglass2 minitbcmd tbcmd wideareatypes wideareamapped );
=pod
vtypes (may want to parameterize the vtypes)
fixed (you will have to change the ns file depending on which nodes are available)
=cut
for (@unknown) {
#for (@should_fail) {
#for (@broken) {
for (@should_pass) {
my $eid = $_;
my $ns = $OldTestSuite::tests->{$_}->{'nsfile'};
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;
package ImageTests;
package SyncTests;
use SemiModern::Perl;
use TestBed::TestSuite;
use Test::More;
......
......@@ -34,4 +34,4 @@ my $test = sub {
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
rege(e('twonodelinktest'), $ns,
sub {
my ($e) = @_;
my $e = $e->eid;
my $eid = $e->eid;
ok($e->linktest, "$eid linktest");
}, 1, 'single_node_tests');
......@@ -11,4 +11,4 @@ set node1 [$ns node]
$ns run
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