git.sur5r.net Git - i3/i3/blob - testcases/complete-run.pl

   1 #!/usr/bin/env perl
   2 # vim:ts=4:sw=4:expandtab
   3 #
   4 # © 2010-2011 Michael Stapelberg and contributors
   5 #
   6 # syntax: ./complete-run.pl --display :1 --display :2
   7 # to run the test suite on the X11 displays :1 and :2
   8 # use 'Xdummy :1' and 'Xdummy :2' before to start two
   9 # headless X11 servers
  10 #
  11
  12 use strict;
  13 use warnings;
  14 use EV;
  15 use AnyEvent;
  16 use IO::Scalar; # not in core :\
  17 use File::Temp qw(tempfile tempdir);
  18 use v5.10;
  19 use DateTime;
  20 use Data::Dumper;
  21 use Cwd qw(abs_path);
  22 use Proc::Background;
  23 use TAP::Harness;
  24 use TAP::Parser;
  25 use TAP::Parser::Aggregator;
  26 use File::Basename qw(basename);
  27 use AnyEvent::I3 qw(:all);
  28 use Try::Tiny;
  29 use Getopt::Long;
  30 use Time::HiRes qw(sleep);
  31 use X11::XCB::Connection;
  32
  33 # install a dummy CHLD handler to overwrite the CHLD handler of AnyEvent / EV
  34 # XXX: we could maybe also use a different loop than the default loop in EV?
  35 $SIG{CHLD} = sub {
  36 };
  37
  38 # reads in a whole file
  39 sub slurp {
  40     open my $fh, '<', shift;
  41     local $/;
  42     <$fh>;
  43 }
  44
  45 my $coverage_testing = 0;
  46 my @displays = ();
  47
  48 my $result = GetOptions(
  49     "coverage-testing" => \$coverage_testing,
  50     "display=s" => \@displays,
  51 );
  52
  53 @displays = split(/,/, join(',', @displays));
  54 @displays = map { s/ //g; $_ } @displays;
  55
  56 @displays = qw(:1) if @displays == 0;
  57
  58 # connect to all displays for two reasons:
  59 # 1: check if the display actually works
  60 # 2: keep the connection open so that i3 is not the only client. this prevents
  61 #    the X server from exiting (Xdummy will restart it, but not quick enough
  62 #    sometimes)
  63 my @conns;
  64 my @wdisplays;
  65 for my $display (@displays) {
  66     try {
  67         my $x = X11::XCB::Connection->new(display => $display);
  68         push @conns, $x;
  69         push @wdisplays, $display;
  70     } catch {
  71         say STDERR "WARNING: Not using X11 display $display, could not connect";
  72     };
  73 }
  74
  75 my $i3cmd = abs_path("../i3") . " -V -d all --disable-signalhandler";
  76 my $config = slurp('i3-test.config');
  77
  78 # 1: get a list of all testcases
  79 my @testfiles = @ARGV;
  80
  81 # if no files were passed on command line, run all tests from t/
  82 @testfiles = <t/*.t> if @testfiles == 0;
  83
  84 # 2: create an output directory for this test-run
  85 my $outdir = "testsuite-";
  86 $outdir .= DateTime->now->strftime("%Y-%m-%d-%H-%M-%S-");
  87 $outdir .= `git describe --tags`;
  88 chomp($outdir);
  89 mkdir($outdir) or die "Could not create $outdir";
  90 unlink("latest") if -e "latest";
  91 symlink("$outdir", "latest") or die "Could not symlink latest to $outdir";
  92
  93 # 3: run all tests
  94 my @done;
  95 my $num = @testfiles;
  96 my $harness = TAP::Harness->new({ });
  97
  98 my $aggregator = TAP::Parser::Aggregator->new();
  99 $aggregator->start();
 100
 101 my $cv = AnyEvent->condvar;
 102
 103 # We start tests concurrently: For each display, one test gets started. Every
 104 # test starts another test after completing.
 105 take_job($_) for @wdisplays;
 106
 107 #
 108 # Takes a test from the beginning of @testfiles and runs it.
 109 #
 110 # The TAP::Parser (which reads the test output) will get called as soon as
 111 # there is some activity on the stdout file descriptor of the test process
 112 # (using an AnyEvent->io watcher).
 113 #
 114 # When a test completes and @done contains $num entries, the $cv condvar gets
 115 # triggered to finish testing.
 116 #
 117 sub take_job {
 118     my ($display) = @_;
 119     my ($fh, $tmpfile) = tempfile();
 120     say $fh $config;
 121     say $fh "ipc-socket /tmp/nested-$display";
 122     close($fh);
 123
 124     my $test = shift @testfiles;
 125     return unless $test;
 126     my $logpath = "$outdir/i3-log-for-" . basename($test);
 127     my $cmd = "export DISPLAY=$display; exec $i3cmd -c $tmpfile >$logpath 2>&1";
 128     my $dont_start = (slurp($test) =~ /# !NO_I3_INSTANCE!/);
 129
 130     my $process = Proc::Background->new($cmd) unless $dont_start;
 131     say "[$display] Running $test with logfile $logpath";
 132
 133     sleep 0.5;
 134     my $kill_i3 = sub {
 135         # Don’t bother killing i3 when we haven’t started it
 136         return if $dont_start;
 137
 138         # When measuring code coverage, try to exit i3 cleanly (otherwise, .gcda
 139         # files are not written) and fallback to killing it
 140         if ($coverage_testing) {
 141             my $exited = 0;
 142             try {
 143                 say "Exiting i3 cleanly...";
 144                 i3("/tmp/nested-$display")->command('exit')->recv;
 145                 $exited = 1;
 146             };
 147             return if $exited;
 148         }
 149
 150         say "[$display] killing i3";
 151         kill(9, $process->pid) or die "could not kill i3";
 152     };
 153
 154     my $output;
 155     my $parser = TAP::Parser->new({
 156         exec => [ 'sh', '-c', "DISPLAY=$display /usr/bin/perl -It/lib $test" ],
 157         spool => IO::Scalar->new(\$output),
 158         merge => 1,
 159     });
 160
 161     my @watchers;
 162     my ($stdout, $stderr) = $parser->get_select_handles;
 163     for my $handle ($parser->get_select_handles) {
 164         my $w;
 165         $w = AnyEvent->io(
 166             fh => $handle,
 167             poll => 'r',
 168             cb => sub {
 169                 # Ignore activity on stderr (unnecessary with merge => 1,
 170                 # but let’s keep it in here if we want to use merge => 0
 171                 # for some reason in the future).
 172                 return if defined($stderr) and $handle == $stderr;
 173
 174                 my $result = $parser->next;
 175                 if (defined($result)) {
 176                     # TODO: check if we should bail out
 177                     return;
 178                 }
 179
 180                 # $result is not defined, we are done parsing
 181                 say "[$display] $test finished";
 182                 close($parser->delete_spool);
 183                 $aggregator->add($test, $parser);
 184                 push @done, [ $test, $output ];
 185
 186                 $kill_i3->();
 187
 188                 undef $_ for @watchers;
 189                 if (@done == $num) {
 190                     $cv->send;
 191                 } else {
 192                     take_job($display);
 193                 }
 194             }
 195         );
 196         push @watchers, $w;
 197     }
 198 }
 199
 200 $cv->recv;
 201
 202 $aggregator->stop();
 203
 204 for (@done) {
 205     my ($test, $output) = @$_;
 206     say "output for $test:";
 207     say $output;
 208 }
 209
 210 # 4: print summary
 211 $harness->summary($aggregator);