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 use Time::HiRes qw(time);
  18 use IO::Handle;
  19 # these are shipped with the testsuite
  20 use lib qw(lib);
  21 use StartXDummy;
  22 use StatusLine;
  23 use TestWorker;
  24 # the following modules are not shipped with Perl
  25 use AnyEvent;
  26 use AnyEvent::Util;
  27 use AnyEvent::Handle;
  28 use AnyEvent::I3 qw(:all);
  29 use X11::XCB::Connection;
  30 use JSON::XS; # AnyEvent::I3 depends on it, too.
  31
  32 # Close superfluous file descriptors which were passed by running in a VIM
  33 # subshell or situations like that.
  34 AnyEvent::Util::close_all_fds_except(0, 1, 2);
  35
  36 # convinience wrapper to write to the log file
  37 my $log;
  38 sub Log { say $log "@_" }
  39
  40 my %timings;
  41 my $help = 0;
  42 # Number of tests to run in parallel. Important to know how many Xdummy
  43 # instances we need to start (unless @displays are given). Defaults to
  44 # num_cores * 2.
  45 my $parallel = undef;
  46 my @displays = ();
  47 my %options = (
  48     valgrind => 0,
  49     strace => 0,
  50     xtrace => 0,
  51     coverage => 0,
  52     restart => 0,
  53 );
  54 my $keep_xdummy_output = 0;
  55
  56 my $result = GetOptions(
  57     "coverage-testing" => \$options{coverage},
  58     "keep-xdummy-output" => \$keep_xdummy_output,
  59     "valgrind" => \$options{valgrind},
  60     "strace" => \$options{strace},
  61     "xtrace" => \$options{xtrace},
  62     "display=s" => \@displays,
  63     "parallel=i" => \$parallel,
  64     "help|?" => \$help,
  65 );
  66
  67 pod2usage(-verbose => 2, -exitcode => 0) if $help;
  68
  69 # Check for missing executables
  70 my @binaries = qw(
  71                    ../i3
  72                    ../i3bar/i3bar
  73                    ../i3-config-wizard/i3-config-wizard
  74                    ../i3-dump-log/i3-dump-log
  75                    ../i3-input/i3-input
  76                    ../i3-msg/i3-msg
  77                    ../i3-nagbar/i3-nagbar
  78                );
  79
  80 foreach my $binary (@binaries) {
  81     die "$binary executable not found" unless -e $binary;
  82     die "$binary is not an executable" unless -x $binary;
  83 }
  84
  85 @displays = split(/,/, join(',', @displays));
  86 @displays = map { s/ //g; $_ } @displays;
  87
  88 # 2: get a list of all testcases
  89 my @testfiles = @ARGV;
  90
  91 # if no files were passed on command line, run all tests from t/
  92 @testfiles = <t/*.t> if @testfiles == 0;
  93
  94 my $numtests = scalar @testfiles;
  95
  96 # No displays specified, let’s start some Xdummy instances.
  97 if (@displays == 0) {
  98     @displays = start_xdummy($parallel, $numtests, $keep_xdummy_output);
  99 }
 100
 101 # 1: create an output directory for this test-run
 102 my $outdir = "testsuite-";
 103 $outdir .= POSIX::strftime("%Y-%m-%d-%H-%M-%S-", localtime());
 104 $outdir .= `git describe --tags`;
 105 chomp($outdir);
 106 mkdir($outdir) or die "Could not create $outdir";
 107 unlink("latest") if -e "latest";
 108 symlink("$outdir", "latest") or die "Could not symlink latest to $outdir";
 109
 110
 111 # connect to all displays for two reasons:
 112 # 1: check if the display actually works
 113 # 2: keep the connection open so that i3 is not the only client. this prevents
 114 #    the X server from exiting (Xdummy will restart it, but not quick enough
 115 #    sometimes)
 116 my @single_worker;
 117 for my $display (@displays) {
 118     my $screen;
 119     my $x = X11::XCB::Connection->new(display => $display);
 120     if ($x->has_error) {
 121         die "Could not connect to display $display\n";
 122     } else {
 123         # start a TestWorker for each display
 124         push @single_worker, worker($display, $x, $outdir, \%options);
 125     }
 126 }
 127
 128 # Read previous timing information, if available. We will be able to roughly
 129 # predict the test duration and schedule a good order for the tests.
 130 my $timingsjson = StartXDummy::slurp('.last_run_timings.json');
 131 %timings = %{decode_json($timingsjson)} if length($timingsjson) > 0;
 132
 133 # Re-order the files so that those which took the longest time in the previous
 134 # run will be started at the beginning to not delay the whole run longer than
 135 # necessary.
 136 @testfiles = map  { $_->[0] }
 137              sort { $b->[1] <=> $a->[1] }
 138              map  { [$_, $timings{$_} // 999] } @testfiles;
 139
 140 # Run 000-load-deps.t first to bail out early when dependencies are missing.
 141 my $loadtest = "t/000-load-deps.t";
 142 if ($loadtest ~~ @testfiles) {
 143     @testfiles = ($loadtest, grep { $_ ne $loadtest } @testfiles);
 144 }
 145
 146 printf("\nRough time estimate for this run: %.2f seconds\n\n", $timings{GLOBAL})
 147     if exists($timings{GLOBAL});
 148
 149 # Forget the old timings, we don’t necessarily run the same set of tests as
 150 # before. Otherwise we would end up with left-overs.
 151 %timings = (GLOBAL => time());
 152
 153 my $logfile = "$outdir/complete-run.log";
 154 open $log, '>', $logfile or die "Could not create '$logfile': $!";
 155 $log->autoflush(1);
 156 say "Writing logfile to '$logfile'...";
 157
 158 # 3: run all tests
 159 my @done;
 160 my $num = @testfiles;
 161 my $harness = TAP::Harness->new({ });
 162
 163 my $aggregator = TAP::Parser::Aggregator->new();
 164 $aggregator->start();
 165
 166 status_init(displays => \@displays, tests => $num);
 167
 168 my $single_cv = AE::cv;
 169
 170 # We start tests concurrently: For each display, one test gets started. Every
 171 # test starts another test after completing.
 172 for (@single_worker) {
 173     $single_cv->begin;
 174     take_job($_, $single_cv, \@testfiles);
 175 }
 176
 177 $single_cv->recv;
 178
 179 $aggregator->stop();
 180
 181 # print empty lines to seperate failed tests from statuslines
 182 print "\n\n";
 183
 184 for (@done) {
 185     my ($test, $output) = @$_;
 186     say "no output for $test" unless $output;
 187     Log "output for $test:";
 188     Log $output;
 189     # print error messages of failed tests
 190     say for $output =~ /^not ok.+\n+((?:^#.+\n)+)/mg
 191 }
 192
 193 # 4: print summary
 194 $harness->summary($aggregator);
 195
 196 close $log;
 197
 198 # 5: Save the timings for better scheduling/prediction next run.
 199 $timings{GLOBAL} = time() - $timings{GLOBAL};
 200 open(my $fh, '>', '.last_run_timings.json');
 201 print $fh encode_json(\%timings);
 202 close($fh);
 203
 204 # 6: Print the slowest test files.
 205 my @slowest = map  { $_->[0] }
 206               sort { $b->[1] <=> $a->[1] }
 207               map  { [$_, $timings{$_}] }
 208               grep { !/^GLOBAL$/ } keys %timings;
 209 say '';
 210 say 'The slowest tests are:';
 211 printf("\t%s with %.2f seconds\n", $_, $timings{$_})
 212     for @slowest[0..($#slowest > 4 ? 4 : $#slowest)];
 213
 214 # When we are running precisely one test, print the output. Makes developing
 215 # with a single testcase easier.
 216 if ($numtests == 1) {
 217     say '';
 218     say 'Test output:';
 219     say StartXDummy::slurp($logfile);
 220 }
 221
 222 END { cleanup() }
 223
 224 exit 0;
 225
 226 #
 227 # Takes a test from the beginning of @testfiles and runs it.
 228 #
 229 # The TAP::Parser (which reads the test output) will get called as soon as
 230 # there is some activity on the stdout file descriptor of the test process
 231 # (using an AnyEvent->io watcher).
 232 #
 233 # When a test completes and @done contains $num entries, the $cv condvar gets
 234 # triggered to finish testing.
 235 #
 236 sub take_job {
 237     my ($worker, $cv, $tests) = @_;
 238
 239     my $test = shift @$tests
 240         or return $cv->end;
 241
 242     my $display = $worker->{display};
 243
 244     Log status($display, "$test: starting");
 245     $timings{$test} = time();
 246     worker_next($worker, $test);
 247
 248     # create a TAP::Parser with an in-memory fh
 249     my $output;
 250     my $parser = TAP::Parser->new({
 251         source => do { open(my $fh, '<', \$output); $fh },
 252     });
 253
 254     my $ipc = $worker->{ipc};
 255
 256     my $w;
 257     $w = AnyEvent->io(
 258         fh => $ipc,
 259         poll => 'r',
 260         cb => sub {
 261             state $tests_completed = 0;
 262             state $partial = '';
 263
 264             sysread($ipc, my $buf, 4096) or die "sysread: $!";
 265
 266             if ($partial) {
 267                 $buf = $partial . $buf;
 268                 $partial = '';
 269             }
 270
 271             # make sure we feed TAP::Parser complete lines so it doesn't blow up
 272             if (substr($buf, -1, 1) ne "\n") {
 273                 my $nl = rindex($buf, "\n");
 274                 if ($nl == -1) {
 275                     $partial = $buf;
 276                     return;
 277                 }
 278
 279                 # strip partial from buffer
 280                 $partial = substr($buf, $nl + 1, '');
 281             }
 282
 283             # count lines before stripping eof-marker otherwise we might
 284             # end up with for (1 .. 0) { } which would effectivly skip the loop
 285             my $lines = $buf =~ tr/\n//;
 286             my $t_eof = $buf =~ s/^$TestWorker::EOF$//m;
 287
 288             $output .= $buf;
 289
 290             for (1 .. $lines) {
 291                 my $result = $parser->next;
 292                 next unless defined($result);
 293                 if ($result->is_test) {
 294                     $tests_completed++;
 295                     status($display, "$test: [$tests_completed/??] ");
 296                 } elsif ($result->is_bailout) {
 297                     Log status($display, "$test: BAILOUT");
 298                     status_completed(scalar @done);
 299                     say "";
 300                     say "test $test bailed out: " . $result->explanation;
 301                     exit 1;
 302                 }
 303             }
 304
 305             return unless $t_eof;
 306
 307             Log status($display, "$test: finished");
 308             $timings{$test} = time() - $timings{$test};
 309             status_completed(scalar @done);
 310
 311             $aggregator->add($test, $parser);
 312             push @done, [ $test, $output ];
 313
 314             undef $w;
 315             take_job($worker, $cv, $tests);
 316         }
 317     );
 318 }
 319
 320 sub cleanup {
 321     $_->() for our @CLEANUP;
 322     exit;
 323 }
 324
 325 # must be in a begin block because we C<exit 0> above
 326 BEGIN {
 327     $SIG{$_} = sub {
 328         require Carp; Carp::cluck("Caught SIG$_[0]\n");
 329         cleanup();
 330     } for qw(INT TERM QUIT KILL PIPE)
 331 }
 332
 333 __END__
 334
 335 =head1 NAME
 336
 337 complete-run.pl - Run the i3 testsuite
 338
 339 =head1 SYNOPSIS
 340
 341 complete-run.pl [files...]
 342
 343 =head1 EXAMPLE
 344
 345 To run the whole testsuite on a reasonable number of Xdummy instances (your
 346 running X11 will not be touched), run:
 347   ./complete-run.pl
 348
 349 To run only a specific test (useful when developing a new feature), run:
 350   ./complete-run t/100-fullscreen.t
 351
 352 =head1 OPTIONS
 353
 354 =over 8
 355
 356 =item B<--display>
 357
 358 Specifies which X11 display should be used. Can be specified multiple times and
 359 will parallelize the tests:
 360
 361   # Run tests on the second X server
 362   ./complete-run.pl -d :1
 363
 364   # Run four tests in parallel on some Xdummy servers
 365   ./complete-run.pl -d :1,:2,:3,:4
 366
 367 Note that it is not necessary to specify this anymore. If omitted,
 368 complete-run.pl will start (num_cores * 2) Xdummy instances.
 369
 370 =item B<--valgrind>
 371
 372 Runs i3 under valgrind to find memory problems. The output will be available in
 373 C<latest/valgrind-for-$test.log>.
 374
 375 =item B<--strace>
 376
 377 Runs i3 under strace to trace system calls. The output will be available in
 378 C<latest/strace-for-$test.log>.
 379
 380 =item B<--xtrace>
 381
 382 Runs i3 under xtrace to trace X11 requests/replies. The output will be
 383 available in C<latest/xtrace-for-$test.log>.
 384
 385 =item B<--coverage-testing>
 386
 387 Exits i3 cleanly (instead of kill -9) to make coverage testing work properly.
 388
 389 =item B<--parallel>
 390
 391 Number of Xdummy instances to start (if you don’t want to start num_cores * 2
 392 instances for some reason).
 393
 394   # Run all tests on a single Xdummy instance
 395   ./complete-run.pl -p 1