Commit c7504236 authored by Kevin Tew's avatar Kevin Tew

testsuite/testswap Cleanups

parent 0e8023e8
......@@ -4,7 +4,7 @@ use inc::Module::Install;
# Define metadata
name 'tbts';
perl_version '5.008';
author 'Kevin Tew <tewk@flux.utah.edu>';
author 'Testbed Developers <testbed-dev@flux.utah.edu>';
version '0.01';
requires 'Mouse' => '0.22';
......@@ -23,7 +23,7 @@ requires 'Test::Exception' => '';
requires 'Term::ReadKey' => '';
=pod
#too much effort to install for now
#too much effort for BSD users to install for now
#required for fast SSH and Crypt::DH
requires 'bignum' => '0.22';
requires 'Math::BigRat' => '0.22';
......
......@@ -18,8 +18,11 @@ TO RUN Tests
./tbts t/old/old.t
./tbts t/topologies/basic.t
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
......
......@@ -6,7 +6,7 @@ use Tools qw(slurp);
use Data::Dumper;
use MIME::Base64;
our $XMLRPC_SERVER = "https://boss.emulab.net:3069/usr/testbed";
our $XMLRPC_SERVER = $ENV{'TBTS_XMLRPC_URL'} || "https://boss.emulab.net:3069/usr/testbed";
our $OPS_SERVER = "users.emulab.net";
our $XMLRPC_VERSION = "0.1";
our $SSL_CLIENT_CERT = glob("~/.ssl/emulab.cert");
......
DOCS TODO
Overview / howto write a test
TODO
cmdline params (-D)
VERBOSENESS
buildup, teardown using Test::Class
create BSD virtual machine for testing
Add basic image-test parameterization examples
EXAMPLES
traffic generation`
EXAMPLES, Get some tests
traffic generation
convert more old tests
general result code handling framework
possibly collapse TestBed/XMLRPC/Client/* and TestBed/TestSuite
possibly collapse tbts and t/harness
EXPAND CURRENT IMPLEMENTATION
event subsystem
better parallel support (custom test harness) - functionality like image-test
parallel support (custom test harness)
LATER
Client.pm duplicate code elimination - Maybe this would make the code too unreadable
TestSuite::Experiment::Macros should be a monadic language like JQuery
test groupings
Large External Tars and Resources for experiements
buildup, teardown using Test::Class
create BSD virtual machine for testing
possibly collapse tbts and t/harness
DONE
POD function documentation
better general result code handling (ping_test single_node_test)
ForkFramework Constants
Parallel TODOS
retry
clean up FFF, Roles, constructors
CartProd teste - image test example
e('PROJECT_ID', 'EXPERIMENT_ID'); #new experiment
ep(); #new plain experiment for calling "class methods" on
dpe('EXPERIMENT_ID') #default project new experiment
e('EXPERIMENT_ID'); # new experiment in default project
e('PROJECT_ID', 'EXPERIMENT_ID'); # new experiment in default group
e('PROJECT_ID', 'GROUP_ID', 'EXPERIMENT_ID'); # new experiment
e(); # new plain experiment for calling "class methods" on
......@@ -106,6 +106,9 @@ sub workloop {
return wantarray ? @results : \@results;
}
use constant SELECT_HAS_HANDLES => 1;
use constant SELECT_NO_HANDLES => 0;
sub selectloop {
my ($self) = @_;
my $selector = $self->selector;
......@@ -139,9 +142,9 @@ sub selectloop {
waitpid( $_, 0 ) for @{ $self->workers };
die $error;
}
return 1;
return SELECT_HAS_HANDLES;
}
return 0;
return SELECT_NO_HANDLES;
}
sub fffork {
......
......@@ -7,6 +7,7 @@ use TestBed::Wrap::tevc;
use TestBed::Wrap::linktest;
use Tools::TBSSH;
use Data::Dumper;
use TestBed::TestSuite;
use TestBed::TestSuite::Node;
use TestBed::TestSuite::Link;
......@@ -153,13 +154,13 @@ sub startrun {
$worker->($e) || die "worker function failed";
}
=item C<launchpingkill($pid, $eid, $ns)>
=item C<launchpingkill($e, $ns)>
class method that starts an experiment, runs a ping_test, and ends the experiment
=cut
sub launchpingkill {
my ($pid, $eid, $ns) = @_;
my $e = e($pid, $eid);
my ($e, $ns) = @_;
my $eid = $e->eid;
trytest {
$e->startexp_ns_wait($ns) && die "batchexp $eid failed";
$e->ping_test && die "connectivity test $eid failed";
......@@ -167,15 +168,15 @@ sub launchpingkill {
} $e;
}
=item C<launchpingkill($pid, $eid, $ns)>
=item C<launchpingkill($e, $ns)>
class method that starts an experiment, runs a ping_test,
swaps the experiment out and then back in, runs a ping test, and finally
ends the experiment
=cut
sub launchpingswapkill {
my ($pid, $eid, $ns) = @_;
my $e = e($pid, $eid);
my ($e, $ns) = @_;
my $eid = $e->eid;
trytest {
$e->startexp_ns_wait($ns) && die "batchexp $eid failed";
$e->ping_test && die "connectivity test $eid failed";
......
......@@ -75,6 +75,7 @@ sub single_request {
$resp;
}
sub xmlrpc_req { single_request(@_)->value; }
sub xmlrpc_req_value { single_request(@_)->value-> {'value'}; }
sub xmlrpc_req_output { single_request(@_)->value-> {'output'}; }
sub xmlrpc_req_code { single_request(@_)->value-> {'code'}; }
......@@ -90,6 +91,14 @@ sub augment_code {
my $self = shift;
$self->xmlrpc_req_code($self->pkgfunc(), $self->args(@_));
}
sub augment_code0 {
my $self = shift;
my $result = $self->xmlrpc_req($self->pkgfunc(), $self->args(@_));
if ( $result->{'code'} ) {
print $result->{'output'};
}
$result->{'code'};
}
sub augment_func {
my $self = shift;
$self->xmlrpc_req_value($self->pkg() . "." . shift, $self->args(@_));
......@@ -103,6 +112,15 @@ sub augment_func_code {
$self->xmlrpc_req_code($self->pkg() . "." . shift, $self->args(@_));
}
sub augment_func_code0 {
my $self = shift;
my $result = $self->xmlrpc_req($self->pkg() . "." . shift, $self->args(@_));
if ( $result->{'code'} ) {
print $result->{'output'};
}
$result->{'code'};
}
=head1 NAME
TestBed::XMLRPC::Client
......
......@@ -9,15 +9,23 @@ extends 'TestBed::XMLRPC::Client';
has 'pid' => ( isa => 'Str', is => 'rw');
has 'gid' => ( isa => 'Str', is => 'rw');
has 'eid' => ( isa => 'Str', is => 'rw');
has 'eid' => ( isa => 'Str', is => 'rw', default => \&gen_random_eid);
#autoloaded/autogenerated/method_missings/etc batchexp swapexp endexp waitforactive getlist expinfo metadata modify
my $EID_INCR = 0;
sub gen_random_eid {
my $self = shift;
$EID_INCR++;
my $eid = "RANDEID$EID_INCR";
$self->eid($eid);
}
sub args {
my $self = shift;
my $pid = $self->pid || $TBConfig::DEFAULT_PID;
my $gid = $self->gid || $TBConfig::DEFAULT_GID || $TBConfig::DEFAULT_PID;
my $eid = $self->eid; # || gen_random_eid;
my $eid = $self->eid || $self->gen_random_eid;
my $args = { 'pid' => $pid, 'eid' => $eid };
$args->{'gid'} = $gid if $gid;
......
#!/usr/bin/perl
use SemiModern::Perl;
use TBConfig;
use TestBed::TestSuite;
use TestBed::TestSuite::Experiment;
use Test::More tests => 2;
use Data::Dumper;
my $ns = <<'NSEND';
source tb_compat.tcl
set ns [new Simulator]
tb-elab-in-elab 1
tb-elabinelab-singlenet
namespace eval TBCOMPAT {
set elabinelab_maxpcs 3
set elabinelab_hardware("boss") pc3000
set elabinelab_hardware("ops") pc3000
set elabinelab_nodeos("boss") FBSD62-STD
set elabinelab_nodeos("ops") FBSD62-STD
}
$ns run
NSEND
my $eid='eine';
my $e = e($eid);
#ok($e->startrun($ns, \&run_inside_exper), 'e-in-e started');
sub run_inside_exper {
my $boss_name = $e->node('myboss.eine.tbres.emulab.net')->name;
my $boss_url = "https://$boss_name:3069/usr/testbed";
say $boss_url;
ok(!system("./tbts -x -v https://$boss_url/usr/testbed t/xmlrpc/experiment.t"), 'eine single node experiment');
}
run_inside_exper;
......@@ -3,7 +3,7 @@ use SemiModern::Perl;
use TestBed::TestSuite;
use Data::Dumper;
use Test::Exception;
use Test::More tests => 10;
use Test::More tests => 11;
my $a = {
'a' => [qw(a1 a2 a3)],
......@@ -34,42 +34,23 @@ our $gen = sub {
}
};
sub hash_equals {
my ($a1, $a2) = @_;
while (my ($k, $v) = each %$a1) {
if ($a2->{$k} ne $v) {
say "$k $v " . $a2->{$k};
return 0;
}
}
return 1;
}
sub array_of_hash_equals {
my ($a1, $a2) = @_;
return 0 if ((scalar @$a1) != (scalar @$a2));
for (0 .. (@$a2 - 1)) {
return 0 unless hash_equals($a1->[$_], $a2->[$_]);
}
return 1;
}
my $expected1 = [ { 'a' => 'COOL', 'b' => 'b1' }, { 'a' => 'a2', 'b' => 'b2' } ];
my $expected2 = [ { 'a' => 'a2', 'b' => 'b1' }, { 'a' => 'a2', 'b' => 'b2' } ];
my @result1 = CartProd($b, 'filter' => $filter, 'generator' => $gen);
ok(array_of_hash_equals( $expected1, \@result1), 'CartProd($config, filter => $f, generator => $g)');
is_deeply($expected1, \@result1, 'CartProd($config, filter => $f, generator => $g)');
#say Dumper($_) for (@result);
my @result2 = CartProd($b, 'filter' => $filter2);
ok(array_of_hash_equals( $expected2, \@result2), 'CartProd($config, filter => $f_and_gen)');
is_deeply($expected2, \@result2, 'CartProd($config, filter => $f_and_gen)');
@result2 = CartProd($b, $filter2);
ok(array_of_hash_equals( $expected2, \@result2), 'CartProd($config, $filter_and_gen)');
is_deeply($expected2, \@result2, 'CartProd($config, $filter_and_gen)');
#say Dumper($_) for (@result2);
ok(hash_equals( defaults({ 'a' => 'B' }, 'a' => 'A', b => 'B'), { 'a' => 'B', 'b' => 'B' } ), 'defaults1');
ok(hash_equals( override({ 'a' => 'B' }, 'a' => 'A', b => 'B'), { 'a' => 'A', 'b' => 'B' } ), 'override1');
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');
is_deeply(TestBed::TestSuite::_build_e_from_positionals(), {}, 'e()');
is_deeply(TestBed::TestSuite::_build_e_from_positionals('e1'), { 'eid' => 'e1' }, 'e($eid)');
is_deeply(TestBed::TestSuite::_build_e_from_positionals('p1', 'e1'), { 'pid' => 'p1', 'eid' => 'e1' }, 'e($pid, $eid)');
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');
#!/usr/bin/perl
use SemiModern::Perl;
use TestBed::TestSuite::Experiment;
use TestBed::TestSuite;
use TestBed::TestSuite::Experiment
use Test::More qw(no_plan);
use Data::Dumper;
require 't/old/oldtestsuite.pm';
......@@ -20,5 +21,5 @@ for (@who_knows) {
my $ns = $Testbed::OldTestSuite::data->{$_}->{'nsfile'};
say "Running " . $_;
say $ns;
ok(launchpingkill('tbres', $_, $ns), $_);
ok(launchpingkill(e($_), $ns), $_);
}
......@@ -31,11 +31,11 @@ $e->startrunkill($ns,
ok($e->link("link1")->down, "link down");
sleep(2);
my $nlssh = $e->node("node1")->ssh;
ok($nlssh->cmdfailuredump("ping -c 5 10.1.2.3"));
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($nlssh->cmdsuccessdump("ping -c 5 10.1.2.3"));
ok($n1ssh->cmdsuccessdump("ping -c 5 10.1.2.3"));
}
);
#!/usr/bin/perl
use SemiModern::Perl;
use TestBed::TestSuite;
use TestBed::TestSuite::Experiment;
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(launchpingswapkill(e('tewkt'), $ns));
#!/usr/bin/perl
use SemiModern::Perl;
use TestBed::TestSuite;
use TestBed::TestSuite::Experiment;
use Test::More tests => 1;
use Data::Dumper;
......@@ -16,4 +17,4 @@ set lan1 [$ns make-lan "$node1 $node2" 100Mb 0ms]
$ns run
NSEND
ok(launchpingswapkill('tbres', 'tewkt', $ns));
ok(launchpingswapkill(e('tewkt'), $ns));
......@@ -29,13 +29,15 @@ use Data::Dumper;
my $project;
my $group;
my $defines;
my $xmlrpcurl;
my $result = GetOptions (
"D=s%" => \$defines,
# "D=s%" => \$defines,
"jobs=i" => \$pjobs,
"logging=i" => \$logging,
"timing" => \$timing,
"verbose" => \$verbose,
"project=s" => \$project,
"xmlrpcurl=s" => \$xmlrpcurl,
"group=s" => \$group,
"debug" => \$debug);
......@@ -45,6 +47,7 @@ use Data::Dumper;
if ($project) { $ENV { 'TBTS_PROJECT' } = $project; }
if ($timing) { $ENV { 'HARNESS_TIMER' } = 1; }
if ($verbose) { $ENV { 'HARNESS_VERBOSE' } = 1; $ENV { 'HARNESS_COLOR' } = 1; }
if ($xmlrpcurl) { $ENV { 'TBTS_XMLRPC_URL' } = $xmlrpcurl; }
}
my $THARNESS = 'perl t/harness';
......@@ -74,6 +77,7 @@ TestBed TestSwap
-p --project=PROJECTNAME
-t --timing
-v --verbose
-x --xmlrpcurl=XMLRPCURL
TESTSUITES:
test - all topology tests
......@@ -90,6 +94,15 @@ USAGE
print $tpms;
}
my @basic_exper_tests = qw(
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
);
#sayd(@basic_exper_tests);
if (@ARGV) {
my $cmd = $ARGV[0];
$_ = $cmd;
......@@ -103,6 +116,7 @@ if (@ARGV) {
elsif (/lib/) { exec "$THARNESS t/lib/*.t t/lib/*/*.t"; }
elsif (/xmlrpc/) { exec "$THARNESS t/xmlrpc/*.t"; }
elsif (/test/) { exec "$THARNESS t/topologies/*.t"; }
elsif (/test/) { exec "$THARNESS t/topologies/*.t"; }
}
else {
print usage();
......
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