Commit 49f37966 authored by Kevin Tew's avatar Kevin Tew

testsuite/testswap refactored rege, added docs, enabled -D defines

parent 4aeaa0c5
......@@ -16,7 +16,7 @@ INSTALLATION INSTRUCTIONS
copy TBConfig.pm.in to TBConfig.pm and edit it to point to your emulab SSL client certificate and corresponding decrypted private key.
HOWTO create a cert file and a decrypted private key file from your emulab(cert+key) file.
openssl rsa -in emulab -out decrypted_emulab.pem
openssl rsa -in emulab -out decrypted_emulab.key
openssl x509 -in emulab -out emulab.cert
TO SEE Tests available to run
......@@ -25,7 +25,7 @@ TO SEE Tests available to run
TO RUN Tests
./tbts test
./tbts t/old/old.t
./tbts t/topologies/basic.t
./tbts t/topologies/single_node.t
EXAMPLE Tests to look at to GET STARTED:
t/topologies/single_node.t
......
......@@ -5,7 +5,7 @@ use TestBed::TestSuite::Experiment;
use TestBed::ParallelRunner;
use TestBed::ForkFramework;
use Data::Dumper;
use Tools qw(concretize);
use Tools;
my $error_sub = sub {
use Carp qw(longmess);
......@@ -18,21 +18,11 @@ my $error_sub = sub {
require Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw(e CartProd CartProdRunner concretize defaults override rege runtests pr_e prun prunout);
our @EXPORT = qw(e CartProd CartProdRunner concretize defaults override rege runtests prun prunout);
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::build_executor($e, @_);
}
sub pr_e {
return TestBed::ParallelRunner::build_executor(@_);
}
......@@ -103,6 +93,10 @@ sub CartProdRunner {
for (CartProd(@_)) { $proc->($_); }
}
sub concretize {
Tools::concretize(shift, %{ override( { @_ }, %{ $TBConfig::cmdline_defines } ) } );
}
sub defaults {
my ($params, %defaults) = @_;
return { %defaults, %{($params || {})} };
......@@ -145,14 +139,7 @@ creates a new experiment with pid and eid and uses the default gid in TBConfig
creates a new experiment with pid, gid, and eid
=item C<rege($ns_contents, &test_sub, $test_count, $desc)>
=item C<rege($eid, $ns_contents, &test_sub, $test_count, $desc)>
=item C<rege($pid, $eid, $ns_contents, &test_sub, $test_count, $desc)>
=item C<rege($pid, $gid, $eid, $ns_contents, &test_sub, $test_count, $desc)>
registers experiement with parallel test running engine
=item C<pr_e($e, $ns_contents, &test_sub, $test_count, $desc, %options)>
=item C<rege($e, $ns_contents, &test_sub, $test_count, $desc, %options)>
registers experiement with parallel test running engine
......@@ -200,6 +187,14 @@ returns a modified hash ref
returns a modified hash ref
=item C<prun(@anonymous_funcs)>
executes anonymous funcs in parallel dying if any fail
=item C<prunout(@anonymous_funcs)>
executes anonymous funcs in parallel returning the output results
=back
=cut
......
......@@ -56,6 +56,10 @@ sub scp {
return Tools::TBSSH::scp($self->name, @_);
}
=item C<< $n->build_remote_name($filename) >>
builds "$user\@$host:$fn"
=cut
sub build_remote_name {
my ($s, $fn) = @_;
my $user = $TBConfig::EMULAB_USER;
......@@ -63,6 +67,10 @@ sub build_remote_name {
return "$user\@$host:$fn";
}
=item C<< $n->splat($data, $filename) >>
cats $data to $filename on the node
=cut
sub splat {
my ($s, $data, $fn) = @_;
my $temp = Tools::splat_to_temp($data);
......@@ -72,12 +80,20 @@ sub splat {
return 1;
}
=item C<< $n->splatex($data, $filename) >>
cats $data to $filename on the node and make it executable
=cut
sub splatex {
my ($s, $data, $fn) = @_;
$s->splat($data, $fn);
$s->ssh->cmdsuccess("chmod +x $fn");
}
=item C<< $n->slurp($filename) >>
pulls $filename content from node
=cut
sub slurp {
my ($s, $fn) = @_;
use File::Temp;
......
......@@ -123,6 +123,10 @@ executes $cmd as $TBConfig::EMULAB_USER on $host and calls checker with ($out, $
returns the ssh result code of executing $cmd as $TBConfig::EMULAB_USER
=item C<cmdoutput($host, $cmd, $diemessage)>>
returns the ssh stdout of executing $cmd as $TBConfig::EMULAB_USER
=item C<cmdsuccessdump($host, $cmd)>
returns the ssh result code of executing $cmd as $TBConfig::EMULAB_USER and dumps the ssh stdout, stderr, resultcode
......
#!/usr/bin/perl
use SemiModern::Perl;
use TBConfig;
use TestBed::TestSuite;
use Data::Dumper;
use Test::Exception;
use Test::More tests => 11;
use Test::More tests => 13;
my $a = {
'a' => [qw(a1 a2 a3)],
......@@ -54,3 +55,8 @@ is_deeply(TestBed::TestSuite::_build_e_from_positionals('p1', 'e1'), { 'pid' =>
is_deeply(TestBed::TestSuite::_build_e_from_positionals('p1', 'g1', 'e1'), { 'pid' => 'p1', 'gid' => 'g1', 'eid' => 'e1' }, 'e($pid, $gid, $eid)');
dies_ok( sub { TestBed::TestSuite::_build_e_from_positionals(1, 2, 3, 4) }, 'e(1,2,3,4) dies');
is(e()->eid, "RANDEID1", 'random eid');
is_deeply(concretize('@OS@', OS=>'FOOBAR'), "FOOBAR", 'OS=>FOOBAR');
$TBConfig::cmdline_defines = { OS=>'GOODBYE' };
is_deeply(concretize('@OS@', OS=>'FOOBAR'), "GOODBYE", 'OS=>FOOBAR -D OS=GOODBY');
......@@ -14,6 +14,6 @@ set node1 [$ns node]
$ns run
NSEND
#ok(e('sn1')->startrunkill($ns, sub { shift->single_node_tests }), 'single_node_tests');
ok(e('sn1')->startrun($ns, sub { shift->single_node_tests }), 'single_node_tests');
ok(e('sn1')->startrunkill($ns, sub { shift->single_node_tests }), 'single_node_tests');
#ok(e('sn1')->startrun($ns, sub { shift->single_node_tests }), 'single_node_tests');
#ok(e('sn1')->single_node_tests, 'single_node_tests');
......@@ -3,6 +3,7 @@
use lib qw(lib tests);
use SemiModern::Perl;
#add localcpan path to library search path
if (-f glob("~/lib/perl5/Test/Harness.pm")) {
my $localcpan_path = glob('~/lib/perl5');
......@@ -20,18 +21,20 @@ use Data::Dumper;
{
use Getopt::Long;
my $pjobs = 1;
my $logging = 0;
my $timing;
my $verbose;
my $logging = 0;
my $debug;
my $project;
my $group;
my $defines;
my $xmlrpcurl;
my $cmdline_defines;
my $concurrent_prerun_jobs;
my $concurrent_node_usage;
my $result = GetOptions (
# "D=s%" => \$defines,
"D=s%" => \$cmdline_defines,
# "jobs=i" => \$pjobs,
"logging=i" => \$logging,
"timing" => \$timing,
......@@ -44,13 +47,20 @@ use Data::Dumper;
"cnu=i" => \$concurrent_node_usage,
);
if ($debug) { $ENV { 'TBTS_DEBUG' } = 1; }
if ($group) { $ENV { 'TBTS_GROUP' } = $group; }
if ($pjobs > 1) { $ENV { 'HARNESS_OPTIONS' } = "j$pjobs"; }
if ($project) { $ENV { 'TBTS_PROJECT' } = $project; }
if ($timing) { $ENV { 'HARNESS_TIMER' } = 1; }
if ($verbose) { $ENV { 'HARNESS_VERBOSE' } = 1; $ENV { 'HARNESS_COLOR' } = 1; }
if ($debug) { $ENV { 'TBTS_DEBUG' } = 1; }
if ($group) { $ENV { 'TBTS_GROUP' } = $group; }
if ($project) { $ENV { 'TBTS_PROJECT' } = $project; }
if ($xmlrpcurl) { $ENV { 'TBTS_XMLRPC_URL' } = $xmlrpcurl; }
use TBConfig;
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);
}
sub usage {
......
......@@ -21,7 +21,7 @@ my $linkupdowntest = sub {
ok($n1ssh->cmdsuccessdump("ping -c 5 10.1.2.3"));
};
rege('linkupdown', $BasicNSs::TwoNodeLanWithLink, $linkupdowntest, 5, 'link up and down with ping on link');
rege(e('linkupdown'), $BasicNSs::TwoNodeLanWithLink, $linkupdowntest, 5, 'link up and down with ping on link');
my $twonodelan5Mbtest = sub {
my ($e) = @_;
......@@ -29,8 +29,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;
......@@ -236,16 +236,6 @@ tb-set-sync-server $node0
$ns run
END
my $image_tests = [
['threenodelan', $ThreeNodeLan, 'Simple three node experment connected via a lan'], #lan
['twonodelink', $TwoNodeLink, 'Two node experiment with a single link between them'], #pair
['linkdelay', $LinkDelay, 'Per-Link Traffic Shaping' ],
['linktestnse', $LinkTestNSE, 'Test linktest on a topo with NSE hanging around sucking CPU.'],
['linktesthilat', $LinkTestHilat,'Test linktest on a topo with long delays.'],
['linktestlobw', $LinkTestLoBW, 'Test linktest on a topo with low bandwidth.'],
['router', $Router, '5 node routing experiement'],
['routermanual', $RouterManual, 'Tests manual routing and tb-set-ip/netmask.'],
];
=pod
sub router_test {
......@@ -272,10 +262,21 @@ test_traceroute 'nodeA', 'node3', qw(node3-link);
test_traceroute 'node1', 'node3', qw(node3-lan);
test_traceroute 'node3', 'node1', qw(node1-lan);
}
#['router', $Router, '5 node routing experiement'],
#['routermanual', $RouterManual, 'Tests manual routing and tb-set-ip/netmask.'],
=cut
my $OS ="RHL90-STD";
my $image_basic_tests = [
['threenodelan', $ThreeNodeLan, 'Simple three node experment connected via a lan'], #lan
['twonodelink', $TwoNodeLink, 'Two node experiment with a single link between them'], #pair
['linkdelay', $LinkDelay, 'Per-Link Traffic Shaping' ],
['linktestnse', $LinkTestNSE, 'Test linktest on a topo with NSE hanging around sucking CPU.'],
['linktesthilat', $LinkTestHilat,'Test linktest on a topo with long delays.'],
['linktestlobw', $LinkTestLoBW, 'Test linktest on a topo with low bandwidth.'],
];
sub basic_test {
my $e = shift;
my $eid = $e->eid;
......@@ -283,11 +284,11 @@ my $e = shift;
ok($e->linktest, "$eid linktest");
}
for (@$image_tests[0..1]) {
for (@$image_basic_tests) {
my ($eid, $orig_ns, $desc) = @$_;
my $ns = concretize($orig_ns, OS => 'RHL90-STD');
#say "$eid\n$ns\n$desc";
pr_e(e($eid), $ns, \&basic_test, 2, $desc);
my $ns = concretize($orig_ns, OS => $OS);
say "$eid\n$ns\n$desc";
rege(e($eid), $ns, \&basic_test, 2, $desc);
}
sub sync_test {
......@@ -332,14 +333,15 @@ cat node3up node4up > node4res
END
);
my $e = shift;
my $eid = $e->eid;
my @ids = (0..4);
ok( prun( map { my $n = $_; sub { $e->node('node'.$n)->splatex($cmds{$n}, 'startcmd'.$n.'.sh'); } } @ids ) );
ok( prun( map { my $n = $_; sub { $e->node('node'.$n)->ssh->cmdoutput('./startcmd'.$n.'.sh'); } } @ids ) );
ok( prun( map { my $n = $_; sub { $e->node('node'.$n)->splatex($cmds{$n}, 'startcmd'.$n.'.sh'); } } @ids ), "$eid prun splat" );
ok( prun( map { my $n = $_; sub { $e->node('node'.$n)->ssh->cmdoutput('./startcmd'.$n.'.sh'); } } @ids ), "$eid prun sh" );
my @results = prunout( map { my $n = $_; sub { $e->node('node'.$n)->slurp('node'.$n.'res'); } } @ids );
ok( /^0\n1\n2\n$/ ) for (@results[0..2]);
ok( /^3\n4\n$/ ) for (@results[3..4]);
ok( /^0\n1\n2\n$/, "noderes") for (@results[0..2]);
ok( /^3\n4\n$/, "noderes") for (@results[3..4]);
}
pr_e(e('sync'), concretize($Sync, OS => 'RHL90-STD'), \&sync_test, 7, 'ImageTest-sync test');
rege(e('sync'), concretize($Sync, OS => $OS), \&sync_test, 7, 'ImageTest-sync test');
1;
......@@ -26,7 +26,7 @@ fixed (you will have to change the ns file depending on which nodes are availabl
for (@who_knows) {
my $eid = $_;
my $ns = $OldTestSuite::tests->{$_}->{'nsfile'};
rege($_, $ns, sub { ok(!shift->ping_test, $eid); }, 1, $_)
rege(e($_), $ns, sub { ok(!shift->ping_test, $eid); }, 1, $_)
}
1;
......@@ -11,6 +11,6 @@ my $test_body = sub {
sleep(5);
};
rege("ksks$_", $BasicNSs::SingleNode, $test_body, 1, "k$_ desc" ) for (1..5);
rege(e("ksks$_"), $BasicNSs::SingleNode, $test_body, 1, "k$_ desc" ) for (1..5);
1;
......@@ -22,5 +22,5 @@ sub handleResult {
}
}
pr_e(e('toomanylans'), $BasicNSs::TooManyLans, $test_body, 1, "too many lans", retry => 1, pre_result_handler => \&handleResult);
rege(e('toomanylans'), $BasicNSs::TooManyLans, $test_body, 1, "too many lans", retry => 1, pre_result_handler => \&handleResult);
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