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