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