git.sur5r.net Git - i3/i3/blob - testcases/complete-run.pl

   1 #!/usr/bin/env perl
   2 # vim:ts=4:sw=4:expandtab
   3 # © 2010-2011 Michael Stapelberg and contributors
   4 package complete_run;
   5 use strict;
   6 use warnings;
   7 use v5.10;
   8 # the following are modules which ship with Perl (>= 5.10):
   9 use Pod::Usage;
  10 use Cwd qw(abs_path);
  11 use File::Temp qw(tempfile tempdir);
  12 use Getopt::Long;
  13 use POSIX ();
  14 use TAP::Harness;
  15 use TAP::Parser;
  16 use TAP::Parser::Aggregator;
  17 # these are shipped with the testsuite
  18 use lib qw(lib);
  19 use StartXDummy;
  20 use StatusLine;
  21 use TestWorker;
  22 # the following modules are not shipped with Perl
  23 use AnyEvent;
  24 use AnyEvent::Util;
  25 use AnyEvent::Handle;
  26 use AnyEvent::I3 qw(:all);
  27 use X11::XCB::Connection;
  28
  29 # Close superfluous file descriptors which were passed by running in a VIM
  30 # subshell or situations like that.
  31 AnyEvent::Util::close_all_fds_except(0, 1, 2);
  32
  33 # convinience wrapper to write to the log file
  34 my $log;
  35 sub Log { say $log "@_" }
  36
  37 my $coverage_testing = 0;
  38 my $valgrind = 0;
  39 my $strace = 0;
  40 my $help = 0;
  41 # Number of tests to run in parallel. Important to know how many Xdummy
  42 # instances we need to start (unless @displays are given). Defaults to
  43 # num_cores * 2.
  44 my $parallel = undef;
  45 my @displays = ();
  46
  47 my $result = GetOptions(
  48     "coverage-testing" => \$coverage_testing,
  49     "valgrind" => \$valgrind,
  50     "strace" => \$strace,
  51     "display=s" => \@displays,
  52     "parallel=i" => \$parallel,
  53     "help|?" => \$help,
  54 );
  55
  56 pod2usage(-verbose => 2, -exitcode => 0) if $help;
  57
  58 @displays = split(/,/, join(',', @displays));
  59 @displays = map { s/ //g; $_ } @displays;
  60
  61 # No displays specified, let’s start some Xdummy instances.
  62 @displays = start_xdummy($parallel) if @displays == 0;
  63
  64 # 1: create an output directory for this test-run
  65 my $outdir = "testsuite-";
  66 $outdir .= POSIX::strftime("%Y-%m-%d-%H-%M-%S-", localtime());
  67 $outdir .= `git describe --tags`;
  68 chomp($outdir);
  69 mkdir($outdir) or die "Could not create $outdir";
  70 unlink("latest") if -e "latest";
  71 symlink("$outdir", "latest") or die "Could not symlink latest to $outdir";
  72
  73
  74 # connect to all displays for two reasons:
  75 # 1: check if the display actually works
  76 # 2: keep the connection open so that i3 is not the only client. this prevents
  77 #    the X server from exiting (Xdummy will restart it, but not quick enough
  78 #    sometimes)
  79 my @worker;
  80 for my $display (@displays) {
  81     my $screen;
  82     my $x = X11::XCB::Connection->new(display => $display);
  83     if ($x->has_error) {
  84         die "Could not connect to display $display\n";
  85     } else {
  86         # start a TestWorker for each display
  87         push @worker, worker($display, $x, $outdir);
  88     }
  89 }
  90
  91 # 2: get a list of all testcases
  92 my @testfiles = @ARGV;
  93
  94 # if no files were passed on command line, run all tests from t/
  95 @testfiles = <t/*.t> if @testfiles == 0;
  96
  97 my $logfile = "$outdir/complete-run.log";
  98 open $log, '>', $logfile or die "Could not create '$logfile': $!";
  99 say "Writing logfile to '$logfile'...";
 100
 101 # 3: run all tests
 102 my @done;
 103 my $num = @testfiles;
 104 my $harness = TAP::Harness->new({ });
 105
 106 my $aggregator = TAP::Parser::Aggregator->new();
 107 $aggregator->start();
 108
 109 status_init(displays => \@displays, tests => $num);
 110
 111 my $cv = AE::cv;
 112
 113 # We start tests concurrently: For each display, one test gets started. Every
 114 # test starts another test after completing.
 115 for (@worker) { $cv->begin; take_job($_) }
 116
 117 $cv->recv;
 118
 119 $aggregator->stop();
 120
 121 # print empty lines to seperate failed tests from statuslines
 122 print "\n\n";
 123
 124 for (@done) {
 125     my ($test, $output) = @$_;
 126     say "no output for $test" unless $output;
 127     Log "output for $test:";
 128     Log $output;
 129     # print error messages of failed tests
 130     say for $output =~ /^not ok.+\n+((?:^#.+\n)+)/mg
 131 }
 132
 133 # 4: print summary
 134 $harness->summary($aggregator);
 135
 136 close $log;
 137
 138 END { cleanup() }
 139
 140 exit 0;
 141
 142 #
 143 # Takes a test from the beginning of @testfiles and runs it.
 144 #
 145 # The TAP::Parser (which reads the test output) will get called as soon as
 146 # there is some activity on the stdout file descriptor of the test process
 147 # (using an AnyEvent->io watcher).
 148 #
 149 # When a test completes and @done contains $num entries, the $cv condvar gets
 150 # triggered to finish testing.
 151 #
 152 sub take_job {
 153     my ($worker) = @_;
 154
 155     my $test = shift @testfiles
 156         or return $cv->end;
 157
 158     my $display = $worker->{display};
 159
 160     Log status($display, "$test: starting");
 161     worker_next($worker, $test);
 162
 163     # create a TAP::Parser with an in-memory fh
 164     my $output;
 165     my $parser = TAP::Parser->new({
 166         source => do { open(my $fh, '<', \$output); $fh },
 167     });
 168
 169     my $ipc = $worker->{ipc};
 170
 171     my $w;
 172     $w = AnyEvent->io(
 173         fh => $ipc,
 174         poll => 'r',
 175         cb => sub {
 176             state $tests_completed = 0;
 177             state $partial = '';
 178
 179             sysread($ipc, my $buf, 4096) or die "sysread: $!";
 180
 181             if ($partial) {
 182                 $buf = $partial . $buf;
 183                 $partial = '';
 184             }
 185
 186             # make sure we feed TAP::Parser complete lines so it doesn't blow up
 187             if (substr($buf, -1, 1) ne "\n") {
 188                 my $nl = rindex($buf, "\n");
 189                 if ($nl == -1) {
 190                     $partial = $buf;
 191                     return;
 192                 }
 193
 194                 # strip partial from buffer
 195                 $partial = substr($buf, $nl + 1, '');
 196             }
 197
 198             # count lines before stripping eof-marker otherwise we might
 199             # end up with for (1 .. 0) { } which would effectivly skip the loop
 200             my $lines = $buf =~ tr/\n//;
 201             my $t_eof = $buf =~ s/^$TestWorker::EOF$//m;
 202
 203             $output .= $buf;
 204
 205             for (1 .. $lines) {
 206                 my $result = $parser->next;
 207                 if (defined($result) and $result->is_test) {
 208                     $tests_completed++;
 209                     status($display, "$test: [$tests_completed/??] ");
 210                 }
 211             }
 212
 213             return unless $t_eof;
 214
 215             Log status($display, "$test: finished");
 216             status_completed(scalar @done);
 217
 218             $aggregator->add($test, $parser);
 219             push @done, [ $test, $output ];
 220
 221             undef $w;
 222             take_job($worker);
 223         }
 224     );
 225 }
 226
 227 sub cleanup {
 228     $_->() for our @CLEANUP;
 229     exit;
 230 }
 231
 232 # must be in a begin block because we C<exit 0> above
 233 BEGIN {
 234     $SIG{$_} = sub {
 235         require Carp; Carp::cluck("Caught SIG$_[0]\n");
 236         cleanup();
 237     } for qw(INT TERM QUIT KILL PIPE)
 238 }
 239
 240 __END__
 241
 242 =head1 NAME
 243
 244 complete-run.pl - Run the i3 testsuite
 245
 246 =head1 SYNOPSIS
 247
 248 complete-run.pl [files...]
 249
 250 =head1 EXAMPLE
 251
 252 To run the whole testsuite on a reasonable number of Xdummy instances (your
 253 running X11 will not be touched), run:
 254   ./complete-run.pl
 255
 256 To run only a specific test (useful when developing a new feature), run:
 257   ./complete-run t/100-fullscreen.t
 258
 259 =head1 OPTIONS
 260
 261 =over 8
 262
 263 =item B<--display>
 264
 265 Specifies which X11 display should be used. Can be specified multiple times and
 266 will parallelize the tests:
 267
 268   # Run tests on the second X server
 269   ./complete-run.pl -d :1
 270
 271   # Run four tests in parallel on some Xdummy servers
 272   ./complete-run.pl -d :1,:2,:3,:4
 273
 274 Note that it is not necessary to specify this anymore. If omitted,
 275 complete-run.pl will start (num_cores * 2) Xdummy instances.
 276
 277 =item B<--valgrind>
 278
 279 Runs i3 under valgrind to find memory problems. The output will be available in
 280 C<latest/valgrind-for-$test.log>.
 281
 282 =item B<--strace>
 283
 284 Runs i3 under strace to trace system calls. The output will be available in
 285 C<latest/strace-for-$test.log>.
 286
 287 =item B<--coverage-testing>
 288
 289 Exits i3 cleanly (instead of kill -9) to make coverage testing work properly.
 290
 291 =item B<--parallel>
 292
 293 Number of Xdummy instances to start (if you don’t want to start num_cores * 2
 294 instances for some reason).
 295
 296   # Run all tests on a single Xdummy instance
 297   ./complete-run.pl -p 1