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 StartXDummy;
  23 use StatusLine;
  24 # the following modules are not shipped with Perl
  25 use AnyEvent;
  26 use AnyEvent::Util;
  27 use AnyEvent::Handle;
  28 use AnyEvent::I3 qw(:all);
  29 use X11::XCB;
  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 # We actually use AnyEvent to make sure it loads an event loop implementation.
  36 # Afterwards, we overwrite SIGCHLD:
  37 my $cv = AnyEvent->condvar;
  38
  39 # Install a dummy CHLD handler to overwrite the CHLD handler of AnyEvent.
  40 # AnyEvent’s handler wait()s for every child which conflicts with TAP (TAP
  41 # needs to get the exit status to determine if a test is successful).
  42 $SIG{CHLD} = sub {
  43 };
  44
  45 # convinience wrapper to write to the log file
  46 my $log;
  47 sub Log { say $log "@_" }
  48
  49 my $coverage_testing = 0;
  50 my $valgrind = 0;
  51 my $strace = 0;
  52 my $help = 0;
  53 # Number of tests to run in parallel. Important to know how many Xdummy
  54 # instances we need to start (unless @displays are given). Defaults to
  55 # num_cores * 2.
  56 my $parallel = undef;
  57 my @displays = ();
  58
  59 my $result = GetOptions(
  60     "coverage-testing" => \$coverage_testing,
  61     "valgrind" => \$valgrind,
  62     "strace" => \$strace,
  63     "display=s" => \@displays,
  64     "parallel=i" => \$parallel,
  65     "help|?" => \$help,
  66 );
  67
  68 pod2usage(-verbose => 2, -exitcode => 0) if $help;
  69
  70 @displays = split(/,/, join(',', @displays));
  71 @displays = map { s/ //g; $_ } @displays;
  72
  73 # No displays specified, let’s start some Xdummy instances.
  74 if (@displays == 0) {
  75     my ($displays, $pids) = start_xdummy($parallel);
  76     @displays = @$displays;
  77
  78     push our @CLEANUP, sub { kill(15, $_) for @$pids };
  79 }
  80
  81 # connect to all displays for two reasons:
  82 # 1: check if the display actually works
  83 # 2: keep the connection open so that i3 is not the only client. this prevents
  84 #    the X server from exiting (Xdummy will restart it, but not quick enough
  85 #    sometimes)
  86 my @conns;
  87 for my $display (@displays) {
  88     my $screen;
  89     my $x = X11::XCB->new($display, $screen);
  90     if ($x->has_error) {
  91         die "Could not connect to display $display\n";
  92     } else {
  93         push @conns, $x;
  94     }
  95 }
  96
  97 # 1: get a list of all testcases
  98 my @testfiles = @ARGV;
  99
 100 # if no files were passed on command line, run all tests from t/
 101 @testfiles = <t/*.t> if @testfiles == 0;
 102
 103 # 2: create an output directory for this test-run
 104 my $outdir = "testsuite-";
 105 $outdir .= POSIX::strftime("%Y-%m-%d-%H-%M-%S-", localtime());
 106 $outdir .= `git describe --tags`;
 107 chomp($outdir);
 108 mkdir($outdir) or die "Could not create $outdir";
 109 unlink("latest") if -e "latest";
 110 symlink("$outdir", "latest") or die "Could not symlink latest to $outdir";
 111
 112 my $logfile = "$outdir/complete-run.log";
 113 open $log, '>', $logfile or die "Could not create '$logfile': $!";
 114 say "Writing logfile to '$logfile'...";
 115
 116 # 3: run all tests
 117 my @done;
 118 my $num = @testfiles;
 119 my $harness = TAP::Harness->new({ });
 120
 121 my $aggregator = TAP::Parser::Aggregator->new();
 122 $aggregator->start();
 123
 124 status_init(displays => \@displays, tests => $num);
 125
 126 # We start tests concurrently: For each display, one test gets started. Every
 127 # test starts another test after completing.
 128 for (@displays) { $cv->begin; take_job($_) }
 129
 130 $cv->recv;
 131
 132 $aggregator->stop();
 133
 134 # print empty lines to seperate failed tests from statuslines
 135 print "\n\n";
 136
 137 for (@done) {
 138     my ($test, $output) = @$_;
 139     Log "output for $test:";
 140     Log $output;
 141     # print error messages of failed tests
 142     say for $output =~ /^not ok.+\n+((?:^#.+\n)+)/mg
 143 }
 144
 145 # 4: print summary
 146 $harness->summary($aggregator);
 147
 148 close $log;
 149
 150 cleanup();
 151
 152 exit 0;
 153
 154 #
 155 # Takes a test from the beginning of @testfiles and runs it.
 156 #
 157 # The TAP::Parser (which reads the test output) will get called as soon as
 158 # there is some activity on the stdout file descriptor of the test process
 159 # (using an AnyEvent->io watcher).
 160 #
 161 # When a test completes and @done contains $num entries, the $cv condvar gets
 162 # triggered to finish testing.
 163 #
 164 sub take_job {
 165     my ($display) = @_;
 166
 167     my $test = shift @testfiles
 168         or return $cv->end;
 169
 170     my $basename = basename($test);
 171
 172     Log status($display, "Starting $test");
 173
 174     my $output;
 175     open(my $spool, '>', \$output);
 176     my $parser = TAP::Parser->new({
 177         exec => [ 'sh', '-c', qq|DISPLAY=$display TESTNAME="$basename" OUTDIR="$outdir" VALGRIND=$valgrind STRACE=$strace COVERAGE=$coverage_testing /usr/bin/perl -Ilib $test| ],
 178         spool => $spool,
 179         merge => 1,
 180     });
 181
 182     my $tests_completed;
 183
 184     my @watchers;
 185     my ($stdout, $stderr) = $parser->get_select_handles;
 186     for my $handle ($parser->get_select_handles) {
 187         my $w;
 188         $w = AnyEvent->io(
 189             fh => $handle,
 190             poll => 'r',
 191             cb => sub {
 192                 # Ignore activity on stderr (unnecessary with merge => 1,
 193                 # but let’s keep it in here if we want to use merge => 0
 194                 # for some reason in the future).
 195                 return if defined($stderr) and $handle == $stderr;
 196
 197                 my $result = $parser->next;
 198                 if (defined($result)) {
 199                     $tests_completed++;
 200                     status($display, "Running $test: [$tests_completed/??]");
 201                     # TODO: check if we should bail out
 202                     return;
 203                 }
 204
 205                 # $result is not defined, we are done parsing
 206                 Log status($display, "$test finished");
 207                 close($parser->delete_spool);
 208                 $aggregator->add($test, $parser);
 209                 push @done, [ $test, $output ];
 210
 211                 status_completed(scalar @done);
 212
 213                 undef $_ for @watchers;
 214                 if (@done == $num) {
 215                     $cv->end;
 216                 } else {
 217                     take_job($display);
 218                 }
 219             }
 220         );
 221         push @watchers, $w;
 222     }
 223 }
 224
 225 sub cleanup {
 226     $_->() for our @CLEANUP;
 227 }
 228
 229 # must be in a begin block because we C<exit 0> above
 230 BEGIN { $SIG{$_} = \&cleanup for qw(INT TERM QUIT KILL) }
 231
 232 __END__
 233
 234 =head1 NAME
 235
 236 complete-run.pl - Run the i3 testsuite
 237
 238 =head1 SYNOPSIS
 239
 240 complete-run.pl [files...]
 241
 242 =head1 EXAMPLE
 243
 244 To run the whole testsuite on a reasonable number of Xdummy instances (your
 245 running X11 will not be touched), run:
 246   ./complete-run.pl
 247
 248 To run only a specific test (useful when developing a new feature), run:
 249   ./complete-run t/100-fullscreen.t
 250
 251 =head1 OPTIONS
 252
 253 =over 8
 254
 255 =item B<--display>
 256
 257 Specifies which X11 display should be used. Can be specified multiple times and
 258 will parallelize the tests:
 259
 260   # Run tests on the second X server
 261   ./complete-run.pl -d :1
 262
 263   # Run four tests in parallel on some Xdummy servers
 264   ./complete-run.pl -d :1,:2,:3,:4
 265
 266 Note that it is not necessary to specify this anymore. If omitted,
 267 complete-run.pl will start (num_cores * 2) Xdummy instances.
 268
 269 =item B<--valgrind>
 270
 271 Runs i3 under valgrind to find memory problems. The output will be available in
 272 C<latest/valgrind-for-$test.log>.
 273
 274 =item B<--strace>
 275
 276 Runs i3 under strace to trace system calls. The output will be available in
 277 C<latest/strace-for-$test.log>.
 278
 279 =item B<--coverage-testing>
 280
 281 Exits i3 cleanly (instead of kill -9) to make coverage testing work properly.
 282
 283 =item B<--parallel>
 284
 285 Number of Xdummy instances to start (if you don’t want to start num_cores * 2
 286 instances for some reason).
 287
 288   # Run all tests on a single Xdummy instance
 289   ./complete-run.pl -p 1