Commit 776e15f9 authored by Kevin Tew's avatar Kevin Tew

testsuite/testswap tests cleanup

parent 98e7d1ed
......@@ -5,17 +5,24 @@ REQUIREMENTS
ssh executable in path
INSTALLATION INSTRUCTIONS
perl ./localcpan.pl #this install dependencies in your homdir if you don't have root access to do it yourself
When prompted:
#this configures CPAN and installs CPAN dependencies in your homedir if you don't have root access to do it yourself
perl ./localcpan.pl
#this installs CPAN dependencies into your system as root using CPAN as already configured
sudo ./localcpan.pl --install_deps
When prompted:
UUID state storage [/tmp] (HIT ENTER)
default umask [0007] (HIT ENTER)
Which SSL install path do you want to use? [/usr] (HIT ENTER)
Do you want to run the live tests (y/N) ? [N] (HIT ENTER)
add export PERL5LIB=~/lib/perl5 to your environment
add export PERL5LIB=~/lib/perl5 to your environment if you did a local cpan install to your homedir
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.
Generate a emulab certificate USING THE EMULAB WEB INTERFASE
openssl rsa -in emulab -out decrypted_emulab.key
openssl x509 -in emulab -out emulab.cert
......@@ -24,14 +31,15 @@ TO SEE Tests available to run
TO RUN Tests
./tbts test
./tbts t/old/old.t
./tbts t/topologies/single_node.t
./tbts tests/topologies/single_node.pm
./tbts -D OS= tests/ImageTests.pm
./tbts tests/OldTestSuiteTests.pm
EXAMPLE Tests to look at to GET STARTED:
t/topologies/single_node.t
t/topologies/two_node_lan.t
t/topologies/simple_two_node_linktest.t
t/topologies/link_up_link_down.t
tests/topologies/single_node.pm
tests/topologies/two_node_lan.pm
tests/topologies/simple_two_node_linktest.pm
tests/topologies/link_up_link_down.pm
Documentation can be found in the doc directory
running pod2text on any pm file will produce API docs.
......@@ -48,7 +56,7 @@ pod2text lib/TestBed/TestSuite/Experiment.pm
#Deprecated more modern and perlish form of installation
Module Install is a comprehensive installer.
It will:
......
......@@ -47,7 +47,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) = @_;
......
testswap is a object orient / declarative test framework for the emulab testbed.
testswap is a object oriented / declarative test framework for the emulab testbed.
LIBRARY CODE
./lib/TestBed/TestSuite/
......@@ -23,7 +23,7 @@ xmlrpc tests
testswap framework tests
Exporter is used to export symbols form the defining modules namespace into the module that is using the namespace.
./lib/TestBed/TestSuite.pm is a very small dsl for defining tests. It exports its symbols into namespace of modules that import it.
Mouse is a lightweight version of the Moose object system for Perl.
Moose is the best practice way of doing object orientation in Perl and is modeled after Perl6's OO system.
......
......@@ -27,12 +27,6 @@
./Makefile.PL - Module::Install makefile
./t/harness - perl test harness
./t/topologies/basic.t - basic topology test
./t/topologies/simple.t - simple topology test
./t/old/old.t - old testsuite tests
./t/old/oldtestsuite.pm - old testsuite data
./t/emulab.t - emulab XMLRPC tests
./t/experiment.t - experiment XMLRPC tests
./t/lib - testswap framework tests
......
......@@ -60,6 +60,10 @@ daemonizes the process redirecting stdout and stderr to files
generates a EMail::Stuff object
=item C<attach_text>
attaches a text file to a Email::Stuff object
=item C<email_daemonize_logs($to)>
send logs of daemon activity to $to
......
......@@ -39,7 +39,10 @@ sub runtests {
#prerun step
my $result = TestBed::ForkFramework::ForEach::max_work($concurrent_pre_runs, sub { shift->prerun }, $s->executors);
if ($result->has_errors) {
if ( $result->has_errors ) {
for (@{$result->errors}) {
$s->executor($_->itemid)->handleResult(undef, $_);
}
sayd($result->errors);
warn 'TestBed::ParallelRunner::runtests died during test prep';
}
......
......@@ -17,7 +17,8 @@ sub handleResult {
if ($result->is_error) {
my $error = $result->error;
if ( $error->isa ( 'TestBed::ParallelRunner::Executor::SwapinError')) { return $s->swapin_error ( @_); }
if ( $error->isa ( 'TestBed::ParallelRunner::Executor::PrerunError')) { return $s->prerun_error ( @_); }
elsif ( $error->isa ( 'TestBed::ParallelRunner::Executor::SwapinError')) { return $s->swapin_error ( @_); }
elsif ( $error->isa ( 'TestBed::ParallelRunner::Executor::RunError')) { return $s->run_error ( @_); }
elsif ( $error->isa ( 'TestBed::ParallelRunner::Executor::SwapoutError')) { return $s->swapout_error ( @_); }
elsif ( $error->isa ( 'TestBed::ParallelRunner::Executor::KillError')) { return $s->end_error ( @_); }
......@@ -47,11 +48,24 @@ sub is_retry_cause {
return 0;
}
sub prerun_error { return RETURN_AND_REPORT; }
sub swapin_error { return RETURN_AND_REPORT; }
sub run_error { return RETURN_AND_REPORT; }
sub swapout_error { return RETURN_AND_REPORT; }
sub end_error { return RETURN_AND_REPORT; }
package TestBed::ParallelRunner::PrerunExpectFail;
use SemiModern::Perl;
use Mouse;
use TestBed::ParallelRunner::ErrorConstants;
extends 'TestBed::ParallelRunner::ErrorStrategy';
sub prerun_error {
my ($s, $executor, $scheduler, $result) = @_;
return RETURN_AND_REPORT;
}
package TestBed::ParallelRunner::ErrorRetryStrategy;
use SemiModern::Perl;
use Mouse;
......@@ -142,6 +156,7 @@ handle parallel run errors;
dispatch experiment errors to the right handler
=item C<< $es->prerun_error($error) >>
=item C<< $es->swapin_error($error) >>
=item C<< $es->run_error($error) >>
=item C<< $es->swapout_error($error) >>
......
......@@ -4,6 +4,13 @@ use warnings;
use CPAN;
sub prep_local_cpan {
print "WARNING installing local CPAN to '~/lib/perl5' -- type yes <ENTER> to continue\n";
my $response = <STDIN>;
chomp $response;
if ($response ne "yes") {
die "$response does not match yes";
}
open(FH, "|cpan");
print FH "no\n";
print FH "quit\n";
......@@ -49,6 +56,20 @@ sub install_deps_from_cpan {
CPAN::Shell->install($_) for(@deps);
}
sub install_ext_deps_from_cpan {
my @deps = qw(
Email::Stuff
Email::Sender
Email::Send
IO::All
);
#Test::Class
#Crypt::SSLeay # required for SSL
#Data::UUID requires user input
#Net::Ping #tests fail, default installed version 2.31 is good enough
CPAN::Shell->install($_) for(@deps);
}
sub automate_ssh_install {
my @ssh_math_deps = qw(
bignum
......@@ -74,23 +95,19 @@ sub automate_ssh_install {
}
sub main {
if ((grep {$_ eq '--install_deps' } @ARGV)) { install_deps_from_cpan; exit; }
if ((grep {$_ eq '--install_ext_deps' } @ARGV)) { install_ext_deps_from_cpan; exit;
}
if (!(grep {$_ eq '--override' } @ARGV) and -e glob("~/.cpan")) {
die "NOT installing local CPAN ~/.cpan exists, specify --override to ignore check";
}
print "WARNING installing local CPAN to '~/lib/perl5' -- type yes <ENTER> to continue\n";
my $response = <STDIN>;
chomp $response;
if ($response ne "yes") {
die "$response does not match yes";
}
prep_local_cpan;
$ENV{PERL5LIB} = glob('~/lib/perl5');
if ($ARGV[0] && $ARGV[0] eq 'MI') {
automate_module_install; #too complicated for fluxers on FreeBSD
automate_ssh_install; #too complicated for fluxers on FreeBSD
#automate_ssh_install; #too complicated for fluxers on FreeBSD
}
else {
install_deps_from_cpan;
......
#!/usr/bin/perl
use SemiModern::Perl;
use TestBed::TestSuite;
use Test::More tests => 1;
use Data::Dumper;
use BasicNSs;
ok(e()->startrunkill($BasicNSs::TwoNodeLan, sub {
my $e = shift;
$e->loghole_sync_allnodes;
}));
#! /usr/bin/perl
use TestBed::TestSuite;
use RateLimitParallelExample;
# run all the tests in RateLimitParallelExample
runtests;
#!/usr/bin/perl
use SemiModern::Perl;
use TestBed::TestSuite;
use Test::More tests => 1;
use Data::Dumper;
use BasicNSs;
ok(e()->startrunkill($BasicNSs::SingleNode, sub {
my $e = shift;
$e->parallel_tevc( sub {my $n = $_[0]; return "now $n"; }, [$e->hostnames]));
}));
#!/usr/bin/perl
use SemiModern::Perl;
use TestBed::TestSuite;
use Test::More tests => 1;
use Data::Dumper;
use BasicNSs;
ok(e()->startrunkill($BasicNSs::TwoNodeLan, sub {
my $e = shift;
$e->splat("JUNK", "junk.txt");
}));
#!/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);
......@@ -4,7 +4,7 @@ use TBConfig;
use TestBed::TestSuite;
use Data::Dumper;
use Test::Exception;
use Test::More tests => 9;
use Test::More tests => 36;
my $a = {
'a' => [qw(a1 a2 a3)],
......@@ -46,6 +46,17 @@ is_deeply($expected2, \@result2, 'CartProd($config, filter => $f_and_gen)');
is_deeply($expected2, \@result2, 'CartProd($config, $filter_and_gen)');
#say Dumper($_) for (@result2);
use VNodeTest;
my $config = {
'OS' => [qw( AOS BOS COS )],
'HARDWARE' => [qw( AHW BHW CHW )],
'LINKTYPE' => [qw( ALT BLT CLT )],
};
CartProdRunner(\&VNodeTest::VNodeTest, $config);
is_deeply(( defaults({ 'a' => 'B' }, 'a' => 'A', b => 'B'), { 'a' => 'B', 'b' => 'B' } ), 'defaults1');
is_deeply(( override({ 'a' => 'B' }, 'a' => 'A', b => 'B'), { 'a' => 'A', 'b' => 'B' } ), 'override1');
......
#!/usr/bin/perl
use SemiModern::Perl;
use TestBed::TestSuite;
use Test::More tests => 3;
use Test::More tests => 7;
use Test::Exception;
use Data::Dumper;
use BasicNSs;
......
#!/usr/bin/perl
use SemiModern::Perl;
use TestBed::TestSuite;
use Test::More tests => 5;
use Data::Dumper;
my $ns = <<'NSEND';
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
NSEND
my $eid='linkupdown';
my $e = e($eid);
$e->startrunkill($ns,
sub {
my ($e) = @_;
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"));
}
);
#!/usr/bin/perl
use SemiModern::Perl;
use TestBed::TestSuite;
use Test::More tests => 1;
use Data::Dumper;
my $ns = <<'NSEND';
source tb_compat.tcl
set ns [new Simulator]
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')->single_node_tests, 'single_node_tests');
......@@ -67,14 +67,23 @@ my $daemonize;
if ($daemonize or $emailme) { TestBed::Daemonize::daemonize; }
}
sub usage {
our $ts;
our $tpms;
sub scandir_t { if (-f && /\.t$/) { $ts .= " " . $File::Find::name . "\n"; } }
sub scandir_tests { if (-f && /\.pm$/) { $tpms .= " " . $File::Find::name . "\n"; } }
sub find_rx_in_dir {
my ($rx, $dir) = @_;
my @results;
my $scandir = sub { if (-f && m/$rx/) { push @results, $File::Find::name; } };
use File::Find;
find(\&scandir_t, 't');
find(\&scandir_tests, 'tests');
find($scandir, $dir);
@results;
}
sub all_ts { find_rx_in_dir(qr{\.t$}, 't'); }
sub all_tpms { find_rx_in_dir(qr{\.pm$}, 'tests'); }
sub usage {
my $ts_text;
my $tpms_text;
for (all_ts) { $ts_text .= " " . $_ . "\n"; }
for (all_tpms) { $tpms_text .= " " . $_ . "\n"; }
print <<"USAGE";
TestBed TestSwap
./tbts OPTIONS TESTSUITE|TESTFILE
......@@ -95,7 +104,7 @@ TestBed TestSwap
TESTSUITES:
test - all topology tests
all - all tests
sanity - all framework utility and xmlrpc client modules test
lib - all framework utility tests
xmlrpc - all xmlrpc client modules tests
......@@ -103,12 +112,22 @@ TestBed TestSwap
TESTFILES:
USAGE
print $ts;
print $tpms;
print $ts_text;
print $tpms_text;
}
sub array_single_difference {
my ($src, $minus) = @_;
grep { my $s = $_; !(grep { $s eq $_ } @$minus) } @$src;
}
use TestBed::Harness;
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 $cmd = $ARGV[0];
$_ = $cmd;
chomp $_;
......@@ -116,10 +135,10 @@ 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 (/sanity/) { runharness( qw(t/lib/*.t t/lib/*/*.t t/xmlrpc/*.t) ); }
elsif (/lib/) { runharness( qw(t/lib/*.t t/lib/*/*.t) ); }
elsif (/xmlrpc/) { runharness( qw(t/xmlrpc/*.t) ); }
elsif (/test/) { runharness( qw(t/topologies/*.t) ); }
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) ); }
}
else {
......
......@@ -5,12 +5,9 @@ use Test::More;
use Data::Dumper;
use OldTestSuite;
our @should_pass = qw( basic cbr complete5 delaylan1 delaylink );
our @who_knows_passed = qw( multilink ixp lan1 nodes singlenode trafgen simplelink simplex setip red ping );
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 );
#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
......@@ -19,10 +16,18 @@ vtypes (may want to parameterize the vtypes)
fixed (you will have to change the ns file depending on which nodes are available)
=cut
for (@should_fail) {
=pod
for (@should_pass) {
my $eid = $_;
my $ns = $OldTestSuite::tests->{$_}->{'nsfile'};
rege(e($_), $ns, sub { ok(!shift->ping_test, $eid); }, 1, $_)
}
=cut
for (@should_fail) {
my $eid = $_;
my $ns = $OldTestSuite::tests->{$_}->{'nsfile'};
rege(e($_), $ns, sub { ok(!shift->ping_test, $eid); }, 1, $_, )
}
1;
......@@ -2,7 +2,7 @@
package VNodeTest;
use SemiModern::Perl;
use TestBed::TestSuite;
use Test::More 'no_plan';
use Test::More;
my $nsfile = <<'END';
set ns [new Simulator]
......
#!/usr/bin/perl
use SemiModern::Perl;
use TestBed::TestSuite;
use Test::More;
use BasicNSs;
my $test = sub {
my $e = shift;
ok( $e->splat("JUNK", "junk.txt"), '$e->splat("JUNK", "junk.txt")');
ok( $e->loghole_sync_allnodes, '$e->loghole_sync_allnodes');
# ok( $e->parallel_tevc( sub {my $n = $_[0]; return "now $n"; }, [$e->hostnames]), '$e->parallel_tevc');
};
rege(e('features'), $BasicNSs::TwoNodeLan, $test, 2, 'tbts features');
#!/usr/bin/perl
use SemiModern::Perl;
use TestBed::TestSuite;
use Test::More tests => 5;
use Data::Dumper;
use Test::More;
my $ns = <<'NSEND';
source tb_compat.tcl
......@@ -18,21 +17,21 @@ set link1 [$ns duplex-link $node1 $node2 100Mb 50ms DropTail]
$ns run
NSEND
my $test = sub {
my ($e) = @_;
my $eid = $e->eid;
ok($e->linktest, "$eid linktest");
my $eid='linkupdown';
my $e = e($eid);
$e->startexp_ns_wait($ns);
$e->swapin_wait($ns)
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"));
$e->end;
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(e('linkupdown'), $ns, $test, 5, 'single_node_tests');
#!/usr/bin/perl
use SemiModern::Perl;
use TestBed::TestSuite;
use Test::More tests => 1;
use Data::Dumper;
use Test::More;
my $ns = <<'NSEND';
source tb_compat.tcl
......@@ -16,11 +15,9 @@ set lan1 [$ns make-lan "$node1 $node2" 5Mb 20ms]
$ns run
NSEND
my $eid='simple';
my $e = e($eid);
$e->startrunkill($ns,
rege(e('twonodelinktest'), $ns,
sub {
my ($e) = @_;
my $e = $e->eid;
ok($e->linktest, "$eid linktest");
}
);
}, 1, 'single_node_tests');
......@@ -11,4 +11,4 @@ set node1 [$ns node]
$ns run
NSEND
rege(e('sn'), $ns, sub { ok(shift->single_node_tests); }, 1, 'single_node_tests');
rege(e('singlenode'), $ns, sub { ok(shift->single_node_tests); }, 1, 'single_node_tests');
#!/usr/bin/perl
use SemiModern::Perl;
use TestBed::TestSuite;
use Test::More tests => 1;
use Data::Dumper;
use Test::More;
my $ns = <<'NSEND';
source tb_compat.tcl
......@@ -16,4 +15,4 @@ set lan1 [$ns make-lan "$node1 $node2" 100Mb 0ms]
$ns run
NSEND
ok(e('tewkt')->launchpingswapkill($ns));
rege(e('twonodelan'), $ns, sub { ok(shift->single_node_tests); }, 1, 'two_node_lan 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