testsuite/testswap tevc_at_host

testsuite/testswap/lib/TestBed/TestSuite/Experiment.pm

@@ -104,7 +104,7 @@ sub linktest {
   TestBed::Wrap::linktest::linktest($e->pid, $e->eid);
 }
 
-=item C<< $e->tevc($arg) >>
+=item C<< $e->tevc(@args) >>
 
 runs tevc on ops for this experiment.
 takes an argument string such as "now link1 down"
@@ -114,6 +114,17 @@ sub tevc {
   TestBed::Wrap::tevc::tevc($e->pid, $e->eid, @_);
 }
 
+=item C<< $e->tevc_at_host($host, @args) >>
+
+runs tevc on $host for this experiment.
+takes an argument string such as "now link1 down"
+=cut
+
+sub tevc_at_host {
+  my ($e) = shift;
+  TestBed::Wrap::tevc::tevc_at_host($e->pid, $e->eid, @_);
+}
+
 =item C<< $e->parallel_tevc($proc, $items) >>
 
 runs tevc on ops for each cmdline produced by calling $proc on each $item.
@@ -130,6 +141,22 @@ sub parallel_tevc {
   }
 }
 
+=item C<< $e->parallel_tevc_at_host($host, $proc, $items) >>
+
+runs tevc on $host for each cmdline produced by calling $proc on each $item.
+=cut
+sub parallel_tevc_at_host {
+  my ($e, $host, $proc, $items) = @_;
+  my $result = TestBed::ForkFramework::ForEach::work(sub {
+    my @tevc_cmd = $proc->(@_);
+    TestBed::Wrap::tevc::tevc_at_host($e->pid, $e->eid, $host, @tevc_cmd);
+  }, $items);
+  if ($result->[0]) {
+    sayd($result->[2]);
+    die 'TestBed::ParallelRunner::runtests died during parallel_tevc';
+  }
+}
+
 =item C<< $e->loghole($cmd) >>
 
 runs loghole on ops
@@ -258,7 +285,7 @@ sub launchpingswapkill {
   my ($e, $ns) = @_;
   my $eid = $e->eid;
 trytest {
-    $e->ensure_artive_ns($ns) && die "batchexp $eid failed";
+    $e->ensure_active_ns($ns) && die "batchexp $eid failed";
     $e->ping_test             && die "connectivity test $eid failed";
     $e->swapout_wait          && die "swap out $eid failed";
     $e->swapin_wait           && die "swap in $eid failed";

testsuite/testswap/lib/TestBed/Wrap/tevc.pm

@@ -31,20 +31,30 @@ TestBed::Wrap::tevc
 
 =over 4
 
-=item C<tevc($pid, $eid, $arg)>
+=item C<tevc($pid, $eid, @args)>
 
 executes tevc on $pid and $eid with $arg string such as "now link1 down"
 by sshing to ops
 
+=item C<tevc_at_host($pid, $eid, $host, @args)>
+
+executes tevc on $pid and $eid with $arg string such as "now link1 down"
+by sshing to $host
+
 =back
 
 =cut
 
 sub tevc {
   my ($pid, $eid, @args) = @_;
+  tevc_at_host($pid, $eid, $TBConfig::OPS_SERVER, @args);
+}
+
+sub tevc_at_host {
+  my ($pid, $eid, $host, @args) = @_;
   my $cmd = 'PATH=/usr/testbed/bin:$PATH tevc ' . "-e $pid/$eid " . join(" ", @args);
   say $cmd;
-  Tools::TBSSH::cmdsuccess($TBConfig::OPS_SERVER, $cmd);
+  Tools::TBSSH::cmdsuccess($host, $cmd);
 }
 
 1;

testsuite/testswap/sc

@@ -47,7 +47,6 @@ sub end_all_experiments {
     e(@{$_->[0]})->end for( experiments_hash_to_list(list_full));
   }
 }
-
 if (@ARGV) {
   $_ = shift;
   if (/endall/) { end_all_experiments; }
@@ -55,7 +54,7 @@ if (@ARGV) {
   else {
     my $e = e(shift);
     if (/--help/) { usage; } 
-    elsif (/end/) { $e->end(); }
+    elsif (/end/) { $e->end; }
     elsif (/ping/ ) { $e->ping_test; }
     elsif (/swapin/) { $e->swapin_wait; }
     elsif (/swapout/) { $e->swapout_wait; }
@@ -65,7 +64,15 @@ if (@ARGV) {
     elsif (/single_node_tests/) { $e->single_node_tests; }
     elsif (/ni/) { say Dumper($e->nodeinfo) ;}
     elsif (/li/) { say Dumper($e->linkinfo) ;}
-    else { 
+    elsif (/ex/) { 
+      say $ARGV[0];
+      my $result = eval $ARGV[0];
+      sayd($result);
+    }
+    else {
+      my $cmdstring = "sayd(\$e->$_);"; 
+      say $cmdstring;
+      eval $cmdstring;
     }
   }
 }

testsuite/testswap/t/examples/frisbee.t

+#!/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->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;

testsuite/testswap/tbts

@@ -30,7 +30,7 @@ use Data::Dumper;
   my $xmlrpcurl;
   my $result = GetOptions (
 #      "D=s%"        => \$defines,
-      "jobs=i"      => \$pjobs,
+#      "jobs=i"      => \$pjobs,
       "logging=i"   => \$logging,
       "timing"      => \$timing,
       "verbose"     => \$verbose,
@@ -104,6 +104,7 @@ if (@ARGV) {
   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 (/coding/)            { runharness qw(t/coding/pod_coverage.t); }
 }
 else {
   print usage();