tbts 6.42 KB
Newer Older
1
#!/usr/bin/perl
Mike Hibler's avatar
Mike Hibler committed
2 3
#
# Copyright (c) 2009 University of Utah and the Flux Group.
4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
# 
# {{{EMULAB-LICENSE
# 
# This file is part of the Emulab network testbed software.
# 
# This file is free software: you can redistribute it and/or modify it
# under the terms of the GNU Affero General Public License as published by
# the Free Software Foundation, either version 3 of the License, or (at
# your option) any later version.
# 
# This file is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
# FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Affero General Public
# License for more details.
# 
# You should have received a copy of the GNU Affero General Public License
# along with this file.  If not, see <http://www.gnu.org/licenses/>.
# 
# }}}
Mike Hibler's avatar
Mike Hibler committed
23
#
24 25 26 27 28 29 30 31 32 33
BEGIN {
  #add localcpan path to library search path
  if (-f glob("~/lib/perl5/Test/Harness.pm")) {
    my $localcpan_path = glob('~/lib/perl5');
    my $p5l = $ENV{PERL5LIB};
    unless ( (defined $p5l) && ($p5l =~ /$localcpan_path/)) {
      my $sep = (defined $p5l) ? ":" : "";
      $ENV { PERL5LIB} .= "$sep" . " $localcpan_path";
      push @INC, $localcpan_path;
    }
34
    push @INC, $localcpan_path;
35
  }
36
  $ENV{PERL5LIB} .= ":tests";
37
}
38

39 40
use lib qw(lib tests);
use SemiModern::Perl;
41
use Moose;
Kevin Tew's avatar
Kevin Tew committed
42

Kevin Tew's avatar
Kevin Tew committed
43
use Data::Dumper;
44
use TBConfig;
45
use TestBed::Daemonize;
Kevin Tew's avatar
Kevin Tew committed
46

47 48
my $emailme;
my $daemonize;
Kevin Tew's avatar
Kevin Tew committed
49 50
{
  use Getopt::Long;
51
  my $debug;
52 53
  my $project;
  my $group;
Kevin Tew's avatar
Kevin Tew committed
54
  my $xmlrpcurl;
55 56

  my $cmdline_defines;
57 58
  my $concurrent_prerun_jobs;
  my $concurrent_node_usage;
Kevin Tew's avatar
Kevin Tew committed
59
  my $exclude_steps;
60
  my $runonly;
61 62 63
  my $dontkill;
  my $alreadyalive;
  my $daemonize;
Kevin Tew's avatar
Kevin Tew committed
64
  my $prefix;
Kevin Tew's avatar
Kevin Tew committed
65
  my $result = GetOptions (
66 67 68 69 70 71 72 73
      "d|debug"        => \$debug,
      "define=s%"      => \$cmdline_defines,
      "project=s"      => \$project,
      "xmlrpcurl=s"    => \$xmlrpcurl,
      "group=s"        => \$group,
      "cprj=i"         => \$concurrent_prerun_jobs,
      "cnu=i"          => \$concurrent_node_usage,
      "excludesteps=s" => \$exclude_steps,
Kevin Tew's avatar
Kevin Tew committed
74
      "runonly=s"      => \$runonly,
75 76 77
      "dontkill"       => \$dontkill,
      "alreadyalive"   => \$alreadyalive,
      "daemonize"      => \$daemonize,
78
      "emailme=s"      => \$emailme,
Kevin Tew's avatar
Kevin Tew committed
79
      "prefix=s"       => \$prefix,
80
    );
Kevin Tew's avatar
Kevin Tew committed
81

82 83 84 85
  if ($debug)     { $ENV { 'TBTS_DEBUG'      } = 1          ; $TBConfig::DEBUG_XML_CLIENT = 1       ; }
  if ($group)     { $ENV { 'TBTS_GROUP'      } = $group     ; $TBConfig::DEFAULT_GID = $group       ; }
  if ($project)   { $ENV { 'TBTS_PROJECT'    } = $project   ; $TBConfig::DEFAULT_PID = $project     ; }
  if ($xmlrpcurl) { $ENV { 'TBTS_XMLRPC_URL' } = $xmlrpcurl ; $TBConfig::XMLRPC_SERVER = $xmlrpcurl ; }
86
  if ($concurrent_prerun_jobs) { $TBConfig::concurrent_prerun_jobs = $concurrent_prerun_jobs; }
87 88 89
  if ($concurrent_node_usage)  { $TBConfig::concurrent_node_usage = $concurrent_node_usage; }
  if ($cmdline_defines)        { $TBConfig::cmdline_defines = $cmdline_defines; }
  if ($exclude_steps)          { $TBConfig::exclude_steps = [split(/ /, $exclude_steps)]; }
90
  if ($runonly)                { $TBConfig::runonly = [split(/ /, $runonly)]; }
91 92
  if ($dontkill)               { $TBConfig::exclude_steps = [qw/swapout end/]}
  if ($alreadyalive)           { $TBConfig::exclude_steps = [qw/create swapin swapout end/]}
Kevin Tew's avatar
Kevin Tew committed
93
  if ($prefix)                 { $TBConfig::prefix = $prefix; }
94
  if ($daemonize or $emailme)  { TestBed::Daemonize::daemonize; }
Kevin Tew's avatar
Kevin Tew committed
95
}
96

97 98 99 100
sub find_rx_in_dir {
  my ($rx, $dir) = @_;
  my @results;
  my $scandir = sub { if (-f && m/$rx/)  { push @results,   $File::Find::name; } };
101
  use File::Find;
102 103 104 105 106 107 108 109 110 111 112 113
  find($scandir, $dir);
  @results;
}

sub all_ts { find_rx_in_dir(qr{\.t$}, 't'); }
sub all_tpms { find_rx_in_dir(qr{\.pm$}, 'tests'); }

sub usage {
  my $ts_text;
  my $tpms_text;
  for (all_ts) { $ts_text     .= "        " . $_ . "\n"; }
  for (all_tpms) { $tpms_text .= "        " . $_ . "\n"; }
114
  print <<"USAGE";
115 116 117
TestBed TestSwap
./tbts OPTIONS TESTSUITE|TESTFILE
        -d --debug
118 119
        -g --group=GROUPNAME
        -p --project=PROJECTNAME
Kevin Tew's avatar
Kevin Tew committed
120
        -x --xmlrpcurl=XMLRPCURL
Kevin Tew's avatar
Kevin Tew committed
121 122 123
        --define OS=FBSD410-UPDATE
        --cprj=4  => \$concurrent_prerun_jobs,
        --cnu=20  => \$concurrent_node_usage,
124
        --dontkill => --excludesteps "swapout end"
Kevin Tew's avatar
Kevin Tew committed
125
        --alreadyalive => --excludesteps "create swapin swapout end"
126 127
        --excludesteps "swapout end"
        --excludesteps "create swapin swapout end"
128
        --runonly "testname1 testname2 testname3"
129
        --daemonize
130
        --emailme user\@emulab.net
Kevin Tew's avatar
Kevin Tew committed
131
	--prefix=PREFIX #prefixes all eids with PREFIX
132
        
133 134

    TESTSUITES:
Kevin Tew's avatar
Kevin Tew committed
135
        massive  - all experiment tests
Kevin Tew's avatar
Kevin Tew committed
136
        all      - all framework tests
137 138 139 140
        sanity   - all framework utility and xmlrpc client modules test
        lib      - all framework utility tests
        xmlrpc   - all xmlrpc client modules tests
        critic   - runs perl critic on framework code
141

142
    TESTFILES:
143
USAGE
144 145 146 147 148 149 150
  print $ts_text;
  print $tpms_text;
}

sub array_single_difference {
  my ($src, $minus) = @_;
  grep { my $s = $_; !(grep { $s eq $_ } @$minus) } @$src;
151
}
152

153
use TestBed::Harness;
154
if (@ARGV) {
155 156 157
  my @xmlrpc = qw(t/xmlrpc/*.t);
  my @lib = qw(t/lib/*.t t/lib/*/*.t t/tbts/cmdlineargs.t);
  my @sanity = (@lib, @xmlrpc);
Kevin Tew's avatar
Kevin Tew committed
158
  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)]));
Kevin Tew's avatar
Kevin Tew committed
159
  my @massive = array_single_difference([all_tpms], [qw(tests/xen/xen.pm)]);
Kevin Tew's avatar
Kevin Tew committed
160

Kevin Tew's avatar
Kevin Tew committed
161
  my $cmd = $ARGV[0];
162
  $_   = $cmd;
163
  chomp $_;
164
  if (/.*\.t$/ || /.*\.pm$/) { runharness(@ARGV); }
165 166 167
  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 (/critic/)          { exec 'perlcritic lib t'; }
Kevin Tew's avatar
Kevin Tew committed
168
  elsif (/massive/)         { runharness( @massive ); }
169 170 171 172
  elsif (/all/)             { runharness( @all ); }
  elsif (/sanity/)          { runharness( @sanity ); }
  elsif (/lib/)             { runharness( @lib ); }
  elsif (/xmlrpc/)          { runharness( @xmlrpc ); }
Kevin Tew's avatar
Kevin Tew committed
173 174 175 176 177 178 179 180 181 182 183
  elsif (/podcov/)          { 
    eval "use Test::Pod::Coverage";
    if ($@) { say "Test::Pod::Coverage not found you need to install it first"; }
    else { 
      use IPC::Run3;
      use Tools;
      my $out = `./tbts t/coding/pod_coverage.t 2>&1`;
      #Tools::splat("podcov.data", $out);
      run3('perl devtools/podfailure.pl', \$out); 
    }
  }
184 185
}
else {
186
  usage();
187 188
}

189
TestBed::Daemonize::email_daemonize_logs($emailme) if $emailme;