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