Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
emulab
emulab-devel
Commits
eb6db7d9
Commit
eb6db7d9
authored
Jun 04, 2009
by
Kevin Tew
Browse files
testsuite/testswap tevc_at_host
parent
25229e6c
Changes
5
Hide whitespace changes
Inline
Side-by-side
testsuite/testswap/lib/TestBed/TestSuite/Experiment.pm
View file @
eb6db7d9
...
...
@@ -104,7 +104,7 @@ sub linktest {
TestBed::Wrap::linktest::
linktest
(
$e
->
pid
,
$e
->
eid
);
}
=item C<< $e->tevc(
$
arg) >>
=item C<< $e->tevc(
@
arg
s
) >>
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_a
r
tive_ns
(
$ns
)
&&
die
"
batchexp
$eid
failed
";
$e
->
ensure_a
c
tive_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
View file @
eb6db7d9
...
...
@@ -31,20 +31,30 @@ TestBed::Wrap::tevc
=over 4
=item C<tevc($pid, $eid,
$
arg)>
=item C<tevc($pid, $eid,
@
arg
s
)>
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
View file @
eb6db7d9
...
...
@@ -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
0 → 100644
View file @
eb6db7d9
#!/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
View file @
eb6db7d9
...
...
@@ -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
();
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment