Commit d45017f7 authored by Kevin Tew's avatar Kevin Tew

testsuite testswap fix 5.8.8 and bsd issues

parent 5c98c4a8
#!/usr/bin/perl #!/usr/bin/perl
use Modern::Perl;
use inc::Module::Install; use inc::Module::Install;
# Define metadata # Define metadata
name 'tbts'; name 'tbts';
all_from 'lib/TestBed/XMLRPC/Client.pm'; all_from 'lib/TestBed/XMLRPC/Client.pm';
perl_version '5.010'; perl_version '5.008';
author 'Kevin Tew <tewk@flux.utah.edu>'; author 'Kevin Tew <tewk@flux.utah.edu>';
version '0.01'; version '0.01';
# Specific dependencies # Specific dependencies
requires 'Crypt::SSLeay' => ''; requires 'bignum' => '0.23';
requires 'File::Spec' => '0.80'; requires 'Math::BigRat' => '0.22';
requires 'Carp' => '1.08'; requires 'Crypt::SSLeay' => '';
requires 'Modern::Perl' => '1.03'; requires 'Test::Exception' => '';
requires 'Mouse' => '0.19'; requires 'Sub::Uplevel' => '';
requires 'RPC::XML::Client' => '1.24'; requires 'Mouse' => '';
requires 'RPC::XML' => '1.41'; requires 'RPC::XML::Client' => '1.24';
requires 'Sys::Hostname' => '1.11'; requires 'RPC::XML' => '1.41';
requires 'Test::More' => '0.86'; requires 'Sys::Hostname' => '1.11';
requires 'Time::Local' => '1.1901'; requires 'Test::More' => '0.86';
requires 'TAP::Harness' => '3.16'; requires 'Time::Local' => '1.1901';
requires 'Math::BigInt::GMP' => ''; requires 'TAP::Harness' => '3.16';
requires 'Math::BigInt::Pari' => ''; requires 'Math::BigInt::GMP' => '';
requires 'Net::SSH::Perl' => '1.34'; requires 'Math::BigInt::Pari' => '';
requires 'Net::SFTP' => '0.10'; requires 'Net::SSH::Perl' => '1.34';
requires 'Crypt::X509' => '0.32'; requires 'Net::SFTP' => '0.10';
requires 'Log::Log4perl' => '1.20'; requires 'Crypt::X509' => '0.32';
requires 'Log::Dispatch::File' => '1.22'; requires 'Log::Log4perl' => '1.20';
requires 'Data::UUID' => ''; requires 'Log::Dispatch::File' => '1.22';
requires 'Data::UUID' => '';
requires 'Net::Ping' => '';
test_requires 'Test::More' => '0.42'; test_requires 'Test::More' => '0.42';
no_index 'directory' => 'demos'; no_index 'directory' => 'demos';
......
use Modern::Perl; use SemiModern::Perl;
package TBConfig; package TBConfig;
use Sys::Hostname; use Sys::Hostname;
......
our $VERSION = '1.00';
use 5.008_000;
use strict;
use warnings;
package SemiModern::Perl;
use IO::Handle;
use Scalar::Util 'openhandle';
use Carp;
sub say {
my $currfh = select();
my $handle;
{
no strict 'refs';
$handle = openhandle($_[0]) ? shift : \*$currfh;
use strict 'refs';
}
@_ = $_ unless @_;
my $warning;
local $SIG{__WARN__} = sub { $warning = join q{}, @_ };
my $res = print {$handle} @_, "\n";
return $res if $res;
$warning =~ s/[ ]at[ ].*//xms;
croak $warning;
}
if (1 || $] < 5.010) {
*IO::Handle::say = \&say if ! defined &IO::Handle::say;
}
sub import {
warnings->import();
strict->import();
if (1 || $] < 5.010) {
no strict 'refs';
*{caller() . '::say'} = \&say;
use strict 'refs';
}
}
1;
#!/usr/bin/perl #!/usr/bin/perl
use Modern::Perl; use SemiModern::Perl;
package TestBed::TestSuite::Experiment; package TestBed::TestSuite::Experiment;
use Mouse; use Mouse;
......
#!/usr/bin/perl #!/usr/bin/perl
use Modern::Perl; use SemiModern::Perl;
package TestBed::TestSuite::Experiment::Macros; package TestBed::TestSuite::Experiment::Macros;
use Data::Dumper; use Data::Dumper;
......
#!/usr/bin/perl #!/usr/bin/perl
use Modern::Perl;
package TestBed::XMLRPC::Client; package TestBed::XMLRPC::Client;
use SemiModern::Perl;
use Mouse; use Mouse;
use RPC::XML::Client; use RPC::XML::Client;
use TBConfig; use TBConfig;
......
#!/usr/bin/perl #!/usr/bin/perl
use Modern::Perl; use SemiModern::Perl;
package TestBed::XMLRPC::Client::Emulab; package TestBed::XMLRPC::Client::Emulab;
use Mouse; use Mouse;
......
#!/usr/bin/perl #!/usr/bin/perl
use Modern::Perl; use SemiModern::Perl;
package TestBed::XMLRPC::Client::Experiment; package TestBed::XMLRPC::Client::Experiment;
use Mouse; use Mouse;
......
#!/usr/bin/perl #!/usr/bin/perl
use Modern::Perl; use SemiModern::Perl;
package TestBed::XMLRPC::Client::NodeInfo; package TestBed::XMLRPC::Client::NodeInfo;
require Exporter; require Exporter;
......
use Modern::Perl;
package Tools; package Tools;
use SemiModern::Perl;
use Log::Log4perl qw(get_logger :levels); use Log::Log4perl qw(get_logger :levels);
#use Log::Log4perl::Appender::Screen #use Log::Log4perl::Appender::Screen
#use Log::Log4perl::Appender::ScreenColoredLevels #use Log::Log4perl::Appender::ScreenColoredLevels
...@@ -45,7 +44,7 @@ sub sayts { ...@@ -45,7 +44,7 @@ sub sayts {
} }
sub perlit { sub perlit {
map {_perlit($_)} @_; map {_perlit($_)} @_;
} }
sub toperl { sub toperl {
......
#!/usr/bin/perl #!/usr/bin/perl
use Modern::Perl; use SemiModern::Perl;
use Net::Ping;
package Tools::PingTest; package Tools::PingTest;
require Exporter; require Exporter;
...@@ -9,8 +10,8 @@ use Data::Dumper; ...@@ -9,8 +10,8 @@ use Data::Dumper;
sub ping { sub ping {
my ($host) = @_; my ($host) = @_;
system("ping -c 3 -W 1 -w 5 $host"); my $p = Net::Ping->new('tcp', 2);
$?; $p->ping($host);
} }
1; 1;
#!/usr/bin/perl #!/usr/bin/perl
use Modern::Perl; use SemiModern::Perl;
use Net::SSH::Perl; use Net::SSH::Perl;
use Net::SFTP; use Net::SFTP;
use Data::UUID; use Data::UUID;
...@@ -11,7 +11,6 @@ sub uuid { ...@@ -11,7 +11,6 @@ sub uuid {
my $ug = new Data::UUID; my $ug = new Data::UUID;
my $uuid = $ug->create_hex(); my $uuid = $ug->create_hex();
$uuid =~ s/^0x//; $uuid =~ s/^0x//;
say $uuid;
$uuid; $uuid;
} }
......
#!/usr/bin/perl #!/usr/bin/perl
use Modern::Perl;
use lib 'lib'; use lib 'lib';
use SemiModern::Perl;
use TestBed::TestSuite::Experiment::Macros; use TestBed::TestSuite::Experiment::Macros;
use Data::Dumper; use Data::Dumper;
use Tools::TBSSH; use Tools::TBSSH;
...@@ -27,11 +27,8 @@ sub output { ...@@ -27,11 +27,8 @@ sub output {
while(my ($gk, $v) = each %$v) { while(my ($gk, $v) = each %$v) {
for my $e (@$v) { for my $e (@$v) {
my $eid; my $eid;
given ($e) { if ( exists $e->{'name'} ) { $eid = sprintf("%s %s", $e->{'name'}, $e->{'state'});}
when('name') { $eid = sprintf("%s %s", $e->{'name'}, $e->{'state'});} else { $eid = $e; }
default { $eid = $e; }
};
say "$pk :: $gk :: $eid"; say "$pk :: $gk :: $eid";
} }
} }
......
#!/usr/bin/perl #!/usr/bin/perl
use Modern::Perl; use SemiModern::Perl;
use TestBed::XMLRPC::Client::Emulab; use TestBed::XMLRPC::Client::Emulab;
use Test::More tests => 3; use Test::More tests => 3;
......
#!/usr/bin/perl #!/usr/bin/perl
use Modern::Perl; use SemiModern::Perl;
use TestBed::TestSuite::Experiment::Macros tests => 3; use TestBed::TestSuite::Experiment::Macros tests => 3;
use Test::More; use Test::More;
use Data::Dumper; use Data::Dumper;
......
#/usr/bin/perl #/usr/bin/perl
use Modern::Perl; use strict;
use warnings;
use TAP::Harness; use TAP::Harness;
use Data::Dumper; use Data::Dumper;
my %args = ( my %args = (
......
#!/usr/bin/perl #!/usr/bin/perl
use Modern::Perl; use SemiModern::Perl;
use TestBed::TestSuite::Experiment; use TestBed::TestSuite::Experiment;
use Test::More qw(no_plan); use Test::More qw(no_plan);
use Data::Dumper; use Data::Dumper;
......
#!/usr/bin/perl #!/usr/bin/perl
use Modern::Perl; use SemiModern::Perl;
use TestBed::TestSuite::Experiment; use TestBed::TestSuite::Experiment;
use Test::More tests => 1; use Test::More tests => 1;
use Data::Dumper; use Data::Dumper;
......
#!/usr/bin/perl #!/usr/bin/perl
use Modern::Perl; use lib 'lib';
use SemiModern::Perl;
use Data::Dumper; use Data::Dumper;
{ {
...@@ -17,7 +18,7 @@ use Data::Dumper; ...@@ -17,7 +18,7 @@ use Data::Dumper;
if ($pjobs > 1) { if ($pjobs > 1) {
$ENV{'HARNESS_OPTIONS'} = "j$pjobs"; $ENV{'HARNESS_OPTIONS'} = "j$pjobs";
} }
if ($timing > 1) { if ($timing) {
$ENV{'HARNESS_TIMER'} = 1; $ENV{'HARNESS_TIMER'} = 1;
} }
if ($verbose) { if ($verbose) {
...@@ -25,23 +26,34 @@ use Data::Dumper; ...@@ -25,23 +26,34 @@ use Data::Dumper;
$ENV{HARNESS_COLOR} = 1; $ENV{HARNESS_COLOR} = 1;
} }
} }
my $THARNESS = 'perl t/harness'; my $THARNESS = 'perl t/harness';
my $usage = <<"USAGE";
sub usage {
our $ts;
sub wanted {
if (-f && /\.t$/) {
$ts .= " " . $File::Find::name . "\n";
}
}
use File::Find;
find(\&wanted, 't');
print <<"USAGE";
./tbts ./tbts
test test
t/SPECIFIC_TEST.t
USAGE USAGE
print $ts;
}
if (@ARGV) { if (@ARGV) {
my $cmd = $ARGV[0]; my $cmd = $ARGV[0];
my $_ = $cmd; $_ = $cmd;
if (/critic/) { exec 'perlcritic .'; } if (/critic/) { exec 'perlcritic .'; }
elsif (/test/) { exec $THARNESS; } elsif (/test/) { exec $THARNESS; }
elsif (/test/) { exec "$THARNESS t/topologies/*.t"; } elsif (/test/) { exec "$THARNESS t/topologies/*.t"; }
elsif (/.*\.t$/) { exec "$THARNESS $cmd"; } elsif (/.*\.t$/) { exec "$THARNESS $cmd"; }
} }
else { else {
print $usage; print usage();
} }
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