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