Commit 62069c30 authored by Kevin Tew's avatar Kevin Tew

testsuite/testswap Templating code

parent 2326fbf8
......@@ -2,18 +2,40 @@ REQUIREMENTS
ssh-agent running with SSH emulab keys added
emulab client certificate and key
TBConfig.pm set up correctly
ssh executable in path
INSTALLATION INSTRUCTIONS
cpan needs to be configured and functional
cpan Module::Install
perl Makefile.PL
make
perl ./localcpan.pl
add export PERL5LIB=~/lib/perl5 to your environment
edit TBConfig.pm to point to your client certificate
add your emulab keys to a running ssh-agent
TO RUN Tests
make test
make t/old/old.t
make t/topologies/basic.t
DEPRECATED Module::Install instructions
cpan needs to be configured and functional
cpan Module::Install
perl Makefile.PL
make
Module::Install is a perl library for installing perl modules/frameworks like testswap
If you need help getting CPAN to run as non-root:
......
......@@ -3,10 +3,11 @@ package TestBed::TestSuite;
use SemiModern::Perl;
use TestBed::TestSuite::Experiment;
use Data::Dumper;
use Tools;
require Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw(e ep dpe);
our @EXPORT = qw(e ep dpe CartProd CartProdRunner concretize defaults);
=head1 NAME
......@@ -26,6 +27,30 @@ creates a new experiment with pid and eid
new experiement takes one arg a eid and uses the default pid in TBConfig
=item C<CartProd($hashref)> Cartesian Product Runner
my $config = {
'OS' => [qw( AOS BOS COS )],
'HARDWARE' => [qw( AHW BHW CHW )],
'LINKTYPE' => [qw( ALT BLT CLT )],
};
returns [ { OS => 'AOS', HARDWARE => 'AHW', LINKTYPE => 'ALT' },
{ OS => 'BOS', HARDWARE => 'AHW', LINKTYPE => 'ALT' },
...
]
=item C<CartProdRunner($sub, $hashref)> Cartesian Product Runner
my $config = {
'OS' => [qw( AOS BOS COS )],
'HARDWARE' => [qw( AHW BHW CHW )],
'LINKTYPE' => [qw( ALT BLT CLT )],
};
CartProdRunner(\&VNodeTest::VNodeTest, $config);
=back
=cut
......@@ -34,4 +59,49 @@ sub ep { TestBed::TestSuite::Experiment->new }
sub e { TestBed::TestSuite::Experiment->new('pid'=> shift, 'eid' => shift) }
sub dpe { TestBed::TestSuite::Experiment->new('pid'=> $TBConfig::DEFAULT_PID, 'eid' => shift) }
sub CartProd {
my ($config, %options) = @_;
#say Dumper($config);
my @a;
while (my ($k, $v) = each %$config) {
if ( @a ) {
my @b;
#say "induct";
map {
my $c = {$k => $_};
push @b, map {{ %$_, %$c}} @a;
} @$v;
#say Dumper(\@b);
@a = @b;
}
else {
#say "basis";
@a = map {{$k => $_}} @$v;
#say Dumper(\@a);
}
}
if (exists $options{'filter'}) {
my @newa;
@a = map { if ($options{'filter'}->($_)) {
push @newa, $_;}
} @a;
@a = @newa;
}
if (exists $options{'generator'}) {
@a = map &{$options{'generator'}}, @a;
}
@a;
}
sub CartProdRunner {
my ($proc, $config, %options) = @_;
for (CartProd($config, %options)) { $proc->($_); }
}
sub defaults {
my ($params, %defaults) = @_;
+{ %defaults, %{($params || {})} };
}
1;
......@@ -41,7 +41,7 @@ sub link {
TestBed::TestSuite::Link->new('experiment' => $e, 'name' => $linkname);
}
=item C<nodes()>
=item C<< $e->nodes() >>
returns a list of node objects representing each node in the experiment
=cut
......@@ -51,7 +51,7 @@ sub nodes {
\@node_instances;
}
=item C<ping_test()>
=item C<< $e->ping_test() >>
runs a ping test across all nodes
=cut
......@@ -62,7 +62,7 @@ sub ping_test {
}
}
=item C<single_node_tests()>
=item C<< $e->single_node_tests() >>
runs a single_node_tests test across all nodes
=cut
......@@ -73,7 +73,7 @@ sub single_node_tests {
}
}
=item C<linktest>
=item C<< $e->linktest >>
runs a linktest on the experiment
=cut
......@@ -82,7 +82,7 @@ sub linktest {
TestBed::Wrap::linktest::linktest($e->pid, $e->eid);
}
=item C<tevc>
=item C<< $e->tevc($arg) >>
runs tevc on ops for this experiment.
takes an argument string such as "now link1 down"
......
#!/usr/bin/perl
use SemiModern::Perl;
use TestBed::TestSuite;
use Data::Dumper;
use Test::More tests => 1;
my $a = {
'a' => [qw(a1 a2 a3)],
'b' => [qw(b1 b2 b3)],
'c' => [qw(c1 c2 c3)],
};
our $filter = sub {
($_->{'a'} eq 'a1');
};
our $gen = sub {
if ($_->{'b'} eq 'b1') {
+{ %{$_}, 'a' => "COOL" }
}
else {
$_;
}
};
for (CartProd($a, 'filter' => $filter, 'generator' => $gen)) {
say Dumper($_);
}
ok(1);
#!/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);
......@@ -2,7 +2,7 @@
use lib 'lib';
use SemiModern::Perl;
if (-f glob("~/lib/perl5/Net/SSH/Perl.pm")) {
if (-f glob("~/lib/perl5/Test/Harness.pm")) {
my $glob = glob('~/lib/perl5');
my $p5l = $ENV{PERL5LIB};
unless ( (defined $p5l) && ($p5l =~ /$glob/)) {
......@@ -15,6 +15,8 @@ if (-f glob("~/lib/perl5/Net/SSH/Perl.pm")) {
}
}
$ENV{PERL5LIB} .= ":tests";
use Data::Dumper;
{
......@@ -75,7 +77,9 @@ if (@ARGV) {
my $cmd = $ARGV[0];
$_ = $cmd;
chomp $_;
if (/.*\.t$/) { exec "$THARNESS $cmd"; }
if (/.*\.t$/ || /.*\.pm/) {
exec "$THARNESS $cmd";
}
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'; }
......
#!/usr/bin/perl
package VNodeTest;
use SemiModern::Perl;
use TestBed::TestSuite;
use Test::More 'no_plan';
my $nsfile = <<'END';
set ns [new Simulator]
source tb_compat.tcl
set node0 [$ns node]
tb-set-node-os $node0 @OS@
tb-set-hardware $node @HARDWARE@
set node1 [$ns node]
tb-set-node-os $node1 @OS@
tb-set-hardware $node @HARDWARE@
set node2 [$ns node]
tb-set-node-os $node2 @OS@
tb-set-hardware $node @HARDWARE@
#@LINKTYPE@
set lan0 [$ns make-lan "$node0 $node1 $node2 " 100Mb 0ms]
$ns rtproto Static
$ns run
END
sub VNodeTest {
my ($params) = @_;
my $options = defaults($params, 'OS' => 'RedHat9', 'HARDWARE' => 'pc3000', 'LINKTYPE' => 'REALLYFAST');
my $ns = concretize($nsfile, %$options);
say $ns;
ok(1);
}
sub VNodeTest2 {
my ($config) = @_;
my @cases = CartProd($config);
for (@cases) {
my $ns = concretize($nsfile, %$_);
say $ns;
ok(1);
}
}
VNodeTest unless caller;
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