Commit a36d878a authored by Kevin Tew's avatar Kevin Tew

testsuite/testswap fixes

parent e3394b92
......@@ -4,6 +4,8 @@ use warnings;
use CPAN;
sub prep_local_cpan {
my $P = shift || "~";
print "WARNING installing local CPAN to '~/lib/perl5' -- type yes <ENTER> to continue\n";
my $response = <STDIN>;
chomp $response;
......@@ -21,7 +23,8 @@ sub prep_local_cpan {
mkdir '~/share/man/man3';
CPAN::Config->load;
$CPAN::Config->{'makepl_arg'} = q[PREFIX=~/ SITELIBEXP=~/lib/perl5 LIB=~/lib/perl5 INSTALLMAN1DIR=~/share/man/man1 INSTALLMAN3DIR=~/share/man/man3 INSTALLSITEMAN1DIR=~/share/man/man1 INSTALLSITEMAN3DIR=~/share/man/man3];
$CPAN::Config->{'makepl_arg'} = qq[PREFIX=$P/ SITELIBEXP=$P/lib/perl5 LIB=$P/lib/perl5 INSTALLMAN1DIR=$P/share/man/man1 INSTALLMAN3DIR=$P/share/man/man3 INSTALLSITEMAN1DIR=$P/share/man/man1 INSTALLSITEMAN3DIR=$P/share/man/man3];
$CPAN::Config->{'prerequisites_policy'} = q[follow];
$CPAN::Config->{'urllist'} = [q[http://cpan.cs.utah.edu ftp://cpan.cs.utah.edu/pub/CPAN/]];
CPAN::Config->commit;
......
......@@ -194,16 +194,14 @@ sub eval_report_error(&$) {
sub handle_select_error {
my ($s, $r) = @_;
my ($rh, $wh, $eof, $ch, $pid) = @$r;
say "SELECT HAS EXCEPTION";
sayd($r);
=pod
eval_report_error { $ch->sendEnd; } "sendEnd";
eval_report_error { $ch->close; } "chclose";
eval_report_error { $s->selector->remove($r); } "selectorremove";
eval_report_error { @{$r}[1,2] = (undef, 1); } "undefassign";
eval_report_error { kill 9, $pid; } "kill $pid";
say "DONE SELECT HAS EXCEPTION";
=cut
}
sub process_select {
......@@ -213,7 +211,10 @@ sub process_select {
my ($r, $rh, $wh, $eof, $ch, $pid);
eval {
for $r ($selector->has_exception(0)) {
say "SELECT FD EXCEPTION";
sayd($r);
$self->handle_select_error($r);
say "DONE SELECT FD EXCEPTION";
}
};
if ( my $error = $@ ) {
......@@ -247,11 +248,12 @@ sub process_select {
}
};
if ( my $error = $@ ) {
say "SELECT HAS ERRORS";
say "SELECT BODY HAS ERRORS";
sayd($error);
$self->handle_select_error($r);
#$_->[3]->sendEnd for $selector->handles;
#$self->wait_for_all_children_to_exit;
say "DONE SELECT BODY HAS ERRORS";
}
say "SELECT_HAS_HANDLES" if $FFDEBUG;
return SELECT_HAS_HANDLES;
......
......@@ -18,7 +18,7 @@ use TestBed::Wrap::tevc;
#$TBConfig::DEBUG_XML_CLIENT = 1;
$SIG{ __DIE__ } = sub {
my $error_trace = sub {
use Carp qw(longmess);
say "Caught here " . __FILE__;
sayd(@_);
......@@ -26,6 +26,9 @@ $SIG{ __DIE__ } = sub {
Carp::confess( "DIED IN SC\n", @_ );
};
#$SIG{ __DIE__ } = $error_trace;
my $ns = <<'NSEND';
source tb_compat.tcl
......@@ -96,6 +99,10 @@ sub watchall {
}
}
sub parsee {
split(/\./, shift);
}
eval {
if (@ARGV) {
$_ = shift;
......@@ -105,7 +112,7 @@ if (@ARGV) {
elsif (/watchall/) { watchall; }
elsif (/rn/) { (say Dumper(Tools::Network::node_reboot($_))) for @ARGV; }
else {
my $e = e(shift);
my $e = e(parsee(shift));
if (/--help/) { usage; }
elsif (/end/) { $e->end_wait; }
elsif (/ping/ ) { $e->ping_test; }
......@@ -122,7 +129,6 @@ if (@ARGV) {
elsif (/ip/) { say Dumper($e->info(aspect => 'physical')) ;}
elsif (/it/) { say Dumper($e->info(aspect => 'traces')) ;}
elsif (/il/) { say Dumper($e->info(aspect => 'links')) ;}
elsif ($_ eq 'syncs') { prun( map { my $n = $_; sub { $e->node('node1')->ssh->cmdoutput('/usr/testbed/bin/emulab-sync'); } } (1..shift)); }
elsif (/watch/) { watch($e); }
elsif ($_ eq'ex') {
say $ARGV[0];
......
......@@ -129,7 +129,7 @@ if (@ARGV) {
my @lib = qw(t/lib/*.t t/lib/*/*.t t/tbts/cmdlineargs.t);
my @sanity = (@lib, @xmlrpc);
my @all = sort(array_single_difference([all_ts], [qw(t/coding/pod_coverage.t t/noautorun/tbts_cmdlineargs.t t/eine/elab_in_elab.t)]));
my @massive = (all_tpms);
my @massive = array_single_difference([all_tpms], [qw(tests/xen/xen.pm)]);
my $cmd = $ARGV[0];
$_ = $cmd;
......
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