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
   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::Basename qw(basename);
  12 use File::Temp qw(tempfile tempdir);
  13 use Getopt::Long;
  14 use IO::Socket::UNIX;
  15 use POSIX;
  16 use Time::HiRes qw(sleep gettimeofday tv_interval);
  17 use TAP::Harness;
  18 use TAP::Parser;
  19 use TAP::Parser::Aggregator;
  20 # these are shipped with the testsuite
  21 use lib qw(lib);
  22 use SocketActivation;
  23 use StartXDummy;
  24 use StatusLine;
  25 # the following modules are not shipped with Perl
  26 use AnyEvent;
  27 use AnyEvent::Util;
  28 use AnyEvent::Handle;
  29 use AnyEvent::I3 qw(:all);
  30 use X11::XCB;
  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 # We actually use AnyEvent to make sure it loads an event loop implementation.
  37 # Afterwards, we overwrite SIGCHLD:
  38 my $cv = AnyEvent->condvar;
  39
  40 # Install a dummy CHLD handler to overwrite the CHLD handler of AnyEvent.
  41 # AnyEvent’s handler wait()s for every child which conflicts with TAP (TAP
  42 # needs to get the exit status to determine if a test is successful).
  43 $SIG{CHLD} = sub {
  44 };
  45
  46 # reads in a whole file
  47 sub slurp {
  48     open(my $fh, '<', shift);
  49     local $/;
  50     <$fh>;
  51 }
  52
  53 # convinience wrapper to write to the log file
  54 my $log;
  55 sub Log { say $log "@_" }
  56
  57 my $coverage_testing = 0;
  58 my $valgrind = 0;
  59 my $strace = 0;
  60 my $help = 0;
  61 # Number of tests to run in parallel. Important to know how many Xdummy
  62 # instances we need to start (unless @displays are given). Defaults to
  63 # num_cores * 2.
  64 my $parallel = undef;
  65 my @displays = ();
  66 my @childpids = ();
  67
  68 my $result = GetOptions(
  69     "coverage-testing" => \$coverage_testing,
  70     "valgrind" => \$valgrind,
  71     "strace" => \$strace,
  72     "display=s" => \@displays,
  73     "parallel=i" => \$parallel,
  74     "help|?" => \$help,
  75 );
  76
  77 pod2usage(-verbose => 2, -exitcode => 0) if $help;
  78
  79 @displays = split(/,/, join(',', @displays));
  80 @displays = map { s/ //g; $_ } @displays;
  81
  82 # No displays specified, let’s start some Xdummy instances.
  83 if (@displays == 0) {
  84     my ($displays, $pids) = start_xdummy($parallel);
  85     @displays = @$displays;
  86     @childpids = @$pids;
  87 }
  88
  89 # connect to all displays for two reasons:
  90 # 1: check if the display actually works
  91 # 2: keep the connection open so that i3 is not the only client. this prevents
  92 #    the X server from exiting (Xdummy will restart it, but not quick enough
  93 #    sometimes)
  94 my @conns;
  95 my @wdisplays;
  96 for my $display (@displays) {
  97     my $screen;
  98     my $x = X11::XCB->new($display, $screen);
  99     if ($x->has_error) {
 100         Log "WARNING: Not using X11 display $display, could not connect";
 101     } else {
 102         push @conns, $x;
 103         push @wdisplays, $display;
 104     }
 105 }
 106
 107 die "No usable displays found" if @wdisplays == 0;
 108
 109 my $config = slurp('i3-test.config');
 110
 111 # 1: get a list of all testcases
 112 my @testfiles = @ARGV;
 113
 114 # if no files were passed on command line, run all tests from t/
 115 @testfiles = <t/*.t> if @testfiles == 0;
 116
 117 # 2: create an output directory for this test-run
 118 my $outdir = "testsuite-";
 119 $outdir .= POSIX::strftime("%Y-%m-%d-%H-%M-%S-", localtime());
 120 $outdir .= `git describe --tags`;
 121 chomp($outdir);
 122 mkdir($outdir) or die "Could not create $outdir";
 123 unlink("latest") if -e "latest";
 124 symlink("$outdir", "latest") or die "Could not symlink latest to $outdir";
 125
 126 my $logfile = "$outdir/complete-run.log";
 127 open $log, '>', $logfile or die "Could not create '$logfile': $!";
 128 say "Writing logfile to '$logfile'...";
 129
 130 # 3: run all tests
 131 my @done;
 132 my $num = @testfiles;
 133 my $harness = TAP::Harness->new({ });
 134
 135 my $aggregator = TAP::Parser::Aggregator->new();
 136 $aggregator->start();
 137
 138 status_init(displays => \@wdisplays, tests => $num);
 139
 140 # We start tests concurrently: For each display, one test gets started. Every
 141 # test starts another test after completing.
 142 for (@wdisplays) { $cv->begin; take_job($_) }
 143
 144 #
 145 # Takes a test from the beginning of @testfiles and runs it.
 146 #
 147 # The TAP::Parser (which reads the test output) will get called as soon as
 148 # there is some activity on the stdout file descriptor of the test process
 149 # (using an AnyEvent->io watcher).
 150 #
 151 # When a test completes and @done contains $num entries, the $cv condvar gets
 152 # triggered to finish testing.
 153 #
 154 sub take_job {
 155     my ($display) = @_;
 156
 157     my $test = shift @testfiles
 158         or return $cv->end;
 159
 160     my $dont_start = (slurp($test) =~ /# !NO_I3_INSTANCE!/);
 161     my $basename = basename($test);
 162     my $logpath = "$outdir/i3-log-for-$basename";
 163
 164     my ($fh, $tmpfile) = tempfile("i3-cfg-for-$basename.XXXXXX", UNLINK => 1);
 165     say $fh $config;
 166     say $fh "ipc-socket /tmp/nested-$display";
 167     close($fh);
 168
 169     my $activate_cv = AnyEvent->condvar;
 170     my $time_before_start = [gettimeofday];
 171
 172     my $pid;
 173     if ($dont_start) {
 174         $activate_cv->send(1);
 175     } else {
 176         $pid = activate_i3(
 177             unix_socket_path => "/tmp/nested-$display-activation",
 178             display => $display,
 179             configfile => $tmpfile,
 180             outdir => $outdir,
 181             testname => $basename,
 182             valgrind => $valgrind,
 183             strace => $strace,
 184             cv => $activate_cv
 185         );
 186
 187         my $child_watcher;
 188         $child_watcher = AnyEvent->child(pid => $pid, cb => sub {
 189             Log status($display, "child died. pid = $pid");
 190             undef $child_watcher;
 191         });
 192     }
 193
 194     my $kill_i3 = sub {
 195         my $kill_cv = AnyEvent->condvar;
 196
 197         # Don’t bother killing i3 when we haven’t started it
 198         if ($dont_start) {
 199             $kill_cv->send();
 200             return $kill_cv;
 201         }
 202
 203         # When measuring code coverage, try to exit i3 cleanly (otherwise, .gcda
 204         # files are not written) and fallback to killing it
 205         if ($coverage_testing || $valgrind) {
 206             my $exited = 0;
 207             Log status($display, 'Exiting i3 cleanly...');
 208             my $i3 = i3("/tmp/nested-$display");
 209             $i3->connect->cb(sub {
 210                 if (!$_[0]->recv) {
 211                     # Could not connect to i3, just kill -9 it
 212                     kill(9, $pid) or die "Could not kill i3 using kill($pid)";
 213                     $kill_cv->send();
 214                 } else {
 215                     # Connected. Now send exit and continue once that’s acked.
 216                     $i3->command('exit')->cb(sub {
 217                         $kill_cv->send();
 218                     });
 219                 }
 220             });
 221         } else {
 222             Log status($display, 'killing i3');
 223
 224             # No coverage testing or valgrind? Just kill -9 i3.
 225             kill(9, $pid) or die "Could not kill i3 using kill($pid)";
 226             $kill_cv->send();
 227         }
 228
 229         return $kill_cv;
 230     };
 231
 232     # This will be called as soon as i3 is running and answered to our
 233     # IPC request
 234     $activate_cv->cb(sub {
 235         my $time_activating = [gettimeofday];
 236         my $start_duration = tv_interval($time_before_start, $time_activating);
 237         my ($status) = $activate_cv->recv;
 238         if ($dont_start) {
 239             Log status($display, 'Not starting i3, testcase does that');
 240         } else {
 241             my $duration = sprintf("%.2f", $start_duration);
 242             Log status($display, "i3 startup: took $duration sec, status = $status");
 243         }
 244
 245         Log status($display, "Starting $test");
 246
 247         my $output;
 248         open(my $spool, '>', \$output);
 249         my $parser = TAP::Parser->new({
 250             exec => [ 'sh', '-c', qq|DISPLAY=$display TESTNAME="$basename" OUTDIR="$outdir" VALGRIND=$valgrind STRACE=$strace /usr/bin/perl -Ilib $test| ],
 251             spool => $spool,
 252             merge => 1,
 253         });
 254
 255         my $tests_completed;
 256
 257         my @watchers;
 258         my ($stdout, $stderr) = $parser->get_select_handles;
 259         for my $handle ($parser->get_select_handles) {
 260             my $w;
 261             $w = AnyEvent->io(
 262                 fh => $handle,
 263                 poll => 'r',
 264                 cb => sub {
 265                     # Ignore activity on stderr (unnecessary with merge => 1,
 266                     # but let’s keep it in here if we want to use merge => 0
 267                     # for some reason in the future).
 268                     return if defined($stderr) and $handle == $stderr;
 269
 270                     my $result = $parser->next;
 271                     if (defined($result)) {
 272                         $tests_completed++;
 273                         status($display, "Running $test: [$tests_completed/??]");
 274                         # TODO: check if we should bail out
 275                         return;
 276                     }
 277
 278                     # $result is not defined, we are done parsing
 279                     Log status($display, "$test finished");
 280                     close($parser->delete_spool);
 281                     $aggregator->add($test, $parser);
 282                     push @done, [ $test, $output ];
 283
 284                     status_completed(scalar @done);
 285
 286                     my $exitcv = $kill_i3->();
 287                     $exitcv->cb(sub {
 288
 289                         undef $_ for @watchers;
 290                         if (@done == $num) {
 291                             $cv->end;
 292                         } else {
 293                             take_job($display);
 294                         }
 295                     });
 296                 }
 297             );
 298             push @watchers, $w;
 299         }
 300     });
 301 }
 302
 303 $cv->recv;
 304
 305 $aggregator->stop();
 306
 307 # print empty lines to seperate failed tests from statuslines
 308 print "\n\n";
 309
 310 for (@done) {
 311     my ($test, $output) = @$_;
 312     Log "output for $test:";
 313     Log $output;
 314     # print error messages of failed tests
 315     say for $output =~ /^not ok.+\n+((?:^#.+\n)+)/mg
 316 }
 317
 318 # 4: print summary
 319 $harness->summary($aggregator);
 320
 321 close $log;
 322
 323 kill(15, $_) for @childpids;
 324
 325 __END__
 326
 327 =head1 NAME
 328
 329 complete-run.pl - Run the i3 testsuite
 330
 331 =head1 SYNOPSIS
 332
 333 complete-run.pl [files...]
 334
 335 =head1 EXAMPLE
 336
 337 To run the whole testsuite on a reasonable number of Xdummy instances (your
 338 running X11 will not be touched), run:
 339   ./complete-run.pl
 340
 341 To run only a specific test (useful when developing a new feature), run:
 342   ./complete-run t/100-fullscreen.t
 343
 344 =head1 OPTIONS
 345
 346 =over 8
 347
 348 =item B<--display>
 349
 350 Specifies which X11 display should be used. Can be specified multiple times and
 351 will parallelize the tests:
 352
 353   # Run tests on the second X server
 354   ./complete-run.pl -d :1
 355
 356   # Run four tests in parallel on some Xdummy servers
 357   ./complete-run.pl -d :1,:2,:3,:4
 358
 359 Note that it is not necessary to specify this anymore. If omitted,
 360 complete-run.pl will start (num_cores * 2) Xdummy instances.
 361
 362 =item B<--valgrind>
 363
 364 Runs i3 under valgrind to find memory problems. The output will be available in
 365 C<latest/valgrind-for-$test.log>.
 366
 367 =item B<--strace>
 368
 369 Runs i3 under strace to trace system calls. The output will be available in
 370 C<latest/strace-for-$test.log>.
 371
 372 =item B<--coverage-testing>
 373
 374 Exits i3 cleanly (instead of kill -9) to make coverage testing work properly.
 375
 376 =item B<--parallel>
 377
 378 Number of Xdummy instances to start (if you don’t want to start num_cores * 2
 379 instances for some reason).
 380
 381   # Run all tests on a single Xdummy instance
 382   ./complete-run.pl -p 1