Commit 25229e6c authored by Kevin Tew's avatar Kevin Tew

testsuite/testswap subroutine documentation

parent 340f10a4
......@@ -19,8 +19,6 @@ ensures perl version >= 5.008
implements a perl5.10 like say for perl < 5.10
=back
=cut
sub say {
......@@ -40,11 +38,22 @@ sub say {
croak $warning;
}
=item sayd
dumps args and prints result with say
=cut
sub sayd {
use Data::Dumper;
say Dumper(@_);
}
=back
=cut
if (1 || $] < 5.010) {
*IO::Handle::say = \&say if ! defined &IO::Handle::say;
}
......
......@@ -307,8 +307,8 @@ extends 'TestBed::ForkFramework::Scheduler';
has 'maxnodes' => ( isa => 'Int' , is => 'rw');
has 'currnodes' => ( isa => 'Int' , is => 'rw');
has 'schedule' => ( isa => 'ArrayRef', is => 'rw');
has 'weight' => ( isa => 'ArrayRef', is => 'rw');
has 'schedule' => ( isa => 'ArrayRef' , is => 'rw');
has 'weight' => ( isa => 'ArrayRef' , is => 'rw');
sub work {
my ($max_nodes, $proc, $weight, $items) = @_;
......
......@@ -37,8 +37,33 @@ sub runharness {
my $harness = TAP::Harness->new( \%harness_args );
$harness->callback('parser_args', \&parser_args_callback);
push @$ts, TestBed::ParallelRunner->new() if @$pms;
push @$ts, [TestBed::ParallelRunner->new(), 'Parallel Tests'] if @$pms;
$harness->runtests(@$ts);
}
=head1 NAME
TestBed::Harness
=over 4
=item C<< runharness(@test_file_names) >>
ex. runharness( 't/lib/*.t', 't/xmlrpc/*.t' 'test/BasicTopologies.pm' )
runs the specified test in a TAP::harness
pushes a ParallelRunner on if .pm parallel test modules are specified
=item C<< split_t_pm(@test_file_names) >>
splits test filenames into to lists based on .t and .pm extensions
=item C<< parser_args_callback >>
TAP::Harness parser_args callback that allow for special processing (pre_running) of parallel tests
=back
=cut
1;
......@@ -142,4 +142,38 @@ sub build_TAP_stream {
return TAP::Parser::Iterator::StdOutErr->new($out, $err, $pid);
}
=head1 NAME
TestBed::ParallelRunner
=over 4
=item C<< add_experiment >>
helper function called by rege.
creates a TestBed::ParallelRunner::Test job and pushes it onto @$ExperimentTests
=item C<< runtests >>
kicks off execution of parallel tests.
=item C<< set_test_builder_to_end_state >>
=item C<< reset_test_builder >>
=item C<< setup_test_builder_ouputs >>
B<INTERNAL> functions to get Test::Builder to behave correctly with parallel tests
=item C<< tap_wrapper >>
wraps two different ways of executing parallel tests and wrapping their TAP output stream
=item C<< build_TAP_stream >>
given a TestBed::ParallelRunner returns a TAP stream
=back
=cut
1;
......@@ -56,4 +56,38 @@ sub kill {
$self->e->end;
}
=head1 NAME
TestBed::ParallelRunner::Test
Represents a ParallelRunner Job
=over 4
=item C<< tn($e, $ns, $sub, $test_count, $desc) >>
constructs a TestBed::ParallelRunner::Test job
=item C<< $prt->prep >>
executes the pre_running phase of experiment and determines min and max node counts.
=item C<< $prt->run >>
swaps in the experiment and runs the specified test
=item C<< $prt->run_ensure_kill >>
swaps in the experiment and runs the specified test
it kills the experiment unconditionaly after the test returns
=item C<< $prt->kill >>
kills the experiment
=back
=cut
1;
......@@ -11,6 +11,7 @@ our @ISA = qw(Exporter);
our @EXPORT = qw(e CartProd CartProdRunner concretize defaults override rege runtests);
sub e { TestBed::TestSuite::Experiment->new(_build_e_from_positionals(@_)); }
sub rege {
my $e;
if (@_ == 4) { $e = e(); }
......@@ -20,7 +21,7 @@ sub rege {
else { die 'Too many args to rege'; }
return TestBed::ParallelRunner::add_experiment($e, @_);
}
sub runtests { TestBed::ParallelRunner::runtests; }
sub runtests { TestBed::ParallelRunner::runtests(@_); }
sub _build_e_from_positionals {
......@@ -119,6 +120,20 @@ creates a new experiment with pid and eid and uses the default gid in TBConfig
creates a new experiment with pid, gid, and eid
=item C<rege($ns_contents, &test_sub, $test_count, $desc)>
=item C<rege($eid, $ns_contents, &test_sub, $test_count, $desc)>
=item C<rege($pid, $eid, $ns_contents, &test_sub, $test_count, $desc)>
=item C<rege($pid, $gid, $eid, $ns_contents, &test_sub, $test_count, $desc)>
registers experiement with parallel test running engine
=item C<runtests($concurrent_pre_runs, $concurrent_node_count_usage) >
allows a maximum of $concurrent_pre_runs during parallel execution
allows a maximum of $concurrent_nodes during parallel execution
start the execution of parallel tests, not needed
=item C<CartProd($hashref)> Cartesian Product Runner
=item C<CartProd($hashref, &filter_gen_func)> Cartesian Product Runner
......
......@@ -132,6 +132,7 @@ sub parallel_tevc {
=item C<< $e->loghole($cmd) >>
runs loghole on ops
=cut
sub loghole {
my ($e) = shift;
......@@ -140,6 +141,7 @@ sub loghole {
=item C<< $e->loghole_sync_allnodes($cmd) >>
runs loghole sync all hostnames on ops
=cut
sub loghole_sync_allnodes {
my ($e) = shift;
......@@ -147,8 +149,9 @@ sub loghole_sync_allnodes {
TestBed::Wrap::loghole::loghole($e, "sync @hostnames");
}
=item C<< $e->splat($cmd) >>
=item C<< $e->splat($data, $filename) >>
splats $data to $filename on each node
=cut
sub splat {
my ($e, $data, $fn) = @_;
......@@ -219,6 +222,11 @@ sub startrunkill {
} $e;
}
=item C<< $e->startrun($ns_contents, $worker_sub) >>
starts an experiment given a $ns file and a $worker
call the $worker passing in the experiment $e
=cut
sub startrun {
my ($e, $ns, $worker) = @_;
my $eid = $e->eid;
......@@ -240,7 +248,7 @@ sub launchpingkill {
} $e;
}
=item C<launchpingkill($e, $ns)>
=item C<launchpingswapkill($e, $ns)>
method that starts an experiment, runs a ping_test,
swaps the experiment out and then back in, runs a ping test, and finally
......
......@@ -26,6 +26,30 @@ B<EXPERIMENTAL>
provides some common used class methods as global functions in the current package namespace
=over 4
=item echo
deprecated
=item list
deprecated
=item list_brief
deprecated
=item list_full
deprecated
=item plistexps
deprecated
=back
=cut
1;
......@@ -165,6 +165,10 @@ B<INTERNAL:> reaches up the caller chain three levels and returns the XMLRPC pac
B<INTERNAL:> executes a single XMLRPC $command with @args and returns a XMLRPC response
=item C<< $client->xmlrpc_req(@args) >>
B<INTERNAL:> returns the response of a XMLRPC call with @args
=item C<< $client->xmlrpc_req_value(@args) >>
B<INTERNAL:> returns the value member of a XMLRPC call with @args
......@@ -207,6 +211,23 @@ returns XMLRPC reponse output
executes xmlrpc request divining the XMLRPC package from the current perl package
returns XMLRPC reponse code
=item C<< $client->augment_code0($funcname, @other_args) >>
executes xmlrpc request divining the XMLRPC package from the current perl package
prints the output if response code is nonzero
returns XMLRPC reponse code
=item C<< $client->augment_func_code($funcname, @other_args) >>
executes xmlrpc request divining the XMLRPC package from the current perl package
returns XMLRPC reponse code
=item C<< $client->augment_func_code0($funcname, @other_args) >>
executes xmlrpc request divining the XMLRPC package from the current perl package
prints the output if response code is nonzero
returns XMLRPC reponse code
=back
=cut
......
......@@ -229,6 +229,35 @@ returns experiment linkinfo
returns experiment link shaping
=item C<< $e->create_and_get_metadata($ns) >>
creates the experiment and returns the create metadata
i.e. min and max nodes, as well as a bunch of other stuff
=item C<< $e->ensure_active_ns($ns) >>
creates the experiment if it doesn't already exist and ensures that the experiement is swapped in
=item C<< $e->gen_random_eid >>
hook for generating a random $eid if desired
=item C<< $e->modify_ns($ns) >>
modifies the current experiment with the give $ns file
=item C<< $e->noemail >>
B<INTERNAL>: generates the noemail attribute for xmlrpc calls if so configured in TBConfig
=item C<< gen_expinfo_funcs >>
B<INTERNAL>: generates expinfo subs
=item C<< retry_on_TIMEOUT(&sub, $messag) >>
B<INTERNAL>: catches socket timeout exceptions and rexecutes &sub after printing $message
=back
=cut
......
......@@ -8,24 +8,6 @@ extends 'TestBed::XMLRPC::Client';
#autoloaded/autogenerated/method_missings/etc available getlist typeinfo
=head1 NAME
TestBed::XMLRPC::Client::Node
=over 4
=item C<available>
returns a list of available nodes
=item C<getlist>
returns a list of available nodes
=back
=cut
sub filter_hash {
my ($hash, $proc) = @_;
my %new_hash;
......@@ -51,4 +33,35 @@ sub get_free {
sub get_free_names {
keys %{shift->get_free(@_)};
}
=head1 NAME
TestBed::XMLRPC::Client::Node
=over 4
=item C<available>
returns a list of available nodes
=item C<getlist>
returns a list of available nodes
=item C<filter_hash($hash, $proc)>
returns a new has containing key,value pairs that $proce returned true for
=item C<get_free()>
given a list of nodeshashes return nodehashes for nodes that are free
=item C<get_free_names()>
given a list of nodeshashes returns a list of node names that are free
=back
=cut
1;
......@@ -71,7 +71,7 @@ sub splitlines {
\@lines;
}
=item beforeaftermatch
=item C< beforeaftermatch($pattern, $array) >
Return lines from $array before and after matching $pattern
=cut
......@@ -92,6 +92,10 @@ sub beforeaftermatch {
(\@before, \@after);
}
=item C< aftermatch($pattern, $array) >
Return lines from $array after matching $pattern
=cut
sub aftermatch {
[beforeaftermatch(@_)]->[1]
}
......
......@@ -6,18 +6,6 @@ our @ISA = qw(Exporter);
our @EXPORT = qw(pretty_listexp experiments_hash_to_list);
use Data::Dumper;
=head1 NAME
TestBed::XMLRPC::Client::Pretty;
=over 4
=item C<pretty_listexp>
pretty prints the XMLRPC response from listexp
=cut
sub pretty_listexp {
for my $ed (experiments_hash_to_list(@_)) {
my ($pid, $gid, $eid,) = @{ $ed->[0] };
......@@ -46,6 +34,20 @@ sub experiments_hash_to_list {
return wantarray ? @exper_list : \@exper_list;
}
=head1 NAME
TestBed::XMLRPC::Client::Pretty;
=over 4
=item C<pretty_listexp>
pretty prints the XMLRPC response from listexp
=item C<experiments_hash_to_list>
converts the nested explist hash to an array of [ [$pid, $gid, $pid] $e]
=back
=cut
......
......@@ -43,6 +43,7 @@ sub slurp {
close($fh);
return $data;
}
=item C<splat($filename, $file_data)>
writes $file_data out to $filename
......@@ -74,7 +75,7 @@ sub timestamp {
sprintf "%4d%02d%02d%02d%02d%02d", $year+1900,$mon+1,$mday,$hour,$min,$sec;
}
=item C<saysts($msg)>
=item C<sayts($msg)>
prints "2009-01-30T10:10:20 $msg\n"
=cut
......@@ -190,7 +191,7 @@ sub getyn {
lc($key) eq 'y';
}
=item C<yn($prompt)>
=item C<yn_prompt($prompt)>
prints $prompt
returns 1 if user types Y or y 0 otherwise
......@@ -204,6 +205,12 @@ sub yn_prompt {
return $r;
}
=item C<splat_to_temp($data)>
writes $data to tempfile and returns a File::Temp object
=cut
sub splat_to_temp {
my $data = shift;
use File::Temp;
......
......@@ -5,6 +5,7 @@ use Data::Dumper;
use Mouse;
eval{
#force use of 'Tools::WrappedSSH'
require BOZO;
};
if ($@) {
......@@ -85,6 +86,20 @@ Tools::TBSSH
=over 4
=item C< instance($host, %options) >
creates a new $ssh object with $host, $user = $TBConfig::EMULAB_USER, and %options
=item C<< $ssh->wrapped_ssh($user, $cmd, $checker) >>
=item C<< $host->wrapped_ssh($user, $cmd, $checker) >>
=item C<< $ssh->wrapped_scp($user, @files) >>
=item C<< $host->wrapped_scp($user, #files) >>
=item C<< $host->scp($host, #files) >>
=item C<cmdcheckoutput($host, $cmd, $checker = sub { my ($out, $err, $resultcode) = @_; ... }>
executes $cmd as $TBConfig::EMULAB_USER on $host and calls checker with ($out, $err, $resultcode)
......@@ -97,6 +112,14 @@ returns the ssh result code of executing $cmd as $TBConfig::EMULAB_USER
returns the ssh result code of executing $cmd as $TBConfig::EMULAB_USER and dumps the ssh stdout, stderr, resultcode
=item C<cmdfailure($host, $cmd)>
returns the ssh result code of executing $cmd as $TBConfig::EMULAB_USER
=item C<cmdfailuredump($host, $cmd)>
returns the ssh result code of executing $cmd as $TBConfig::EMULAB_USER and dumps the ssh stdout, stderr, resultcode
=back
=cut
......
......@@ -42,21 +42,13 @@ Tools::TBSSH
=over 4
=item C< wrapped_ssh($host, $user, $cmd, $checker)>
=item C<< $ssh->cmd($cmd) >>
B<LOWLEVEL SUB> execute $cmd on $host as $user and check result with $checker sub
B<LOWLEVEL SUB> execute $cmd on $host as $user by wrapping cmdline ssh
=item C<cmdcheckoutput($host, $cmd, $checker = sub { my ($out, $err, $resultcode) = @_; ... }>
=item C<< $ssh->scp_worker(@files) >>
executes $cmd as $TBConfig::EMULAB_USER on $host and calls checker with ($out, $err, $resultcode)
=item C<cmdsuccess($host, $cmd)>
returns the ssh result code of executing $cmd as $TBConfig::EMULAB_USER
=item C<cmdsuccessdump($host, $cmd)>
returns the ssh result code of executing $cmd as $TBConfig::EMULAB_USER and dumps the ssh stdout, stderr, resultcode
B<LOWLEVEL SUB> execute $scp with $files as arguments
=back
......
#!/usr/bin/perl
use Test::More;
eval "use Test::Pod::Coverage 1.00";
plan skip_all => "Test::Pod::Coverage 1.00 required for testing POD coverage" if $@;
all_pod_coverage_ok();
......@@ -90,6 +90,15 @@ if (@ARGV) {
if (/.*\.t$/ || /.*\.pm$/) { runharness(@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 ($_ eq 'pode') {
eval { use Pod::Coverage; };
unless ($@) {
my $pc = Pod::Coverage->new(package => 'Pod::Coverage');
print "We rock!" if $pc->coverage == 1;
}
}
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); }
......
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