X-Git-Url: https://git.sur5r.net/?a=blobdiff_plain;f=testcases%2Fcomplete-run.pl;h=61f2ef52451115e3051e3a6d88d0945fb41350f7;hb=dd5be77d1dcc7e7eb40ce1c33f985816fc0b8f79;hp=d74da831c95639964545f13a8146415e8913bfec;hpb=55c474d8646cef60958b1c6a53ead85f2133b697;p=i3%2Fi3 diff --git a/testcases/complete-run.pl b/testcases/complete-run.pl index d74da831..61f2ef52 100755 --- a/testcases/complete-run.pl +++ b/testcases/complete-run.pl @@ -1,65 +1,68 @@ #!/usr/bin/env perl # vim:ts=4:sw=4:expandtab -# © 2010-2011 Michael Stapelberg and contributors - +# © 2010-2012 Michael Stapelberg and contributors +package complete_run; use strict; use warnings; use v5.10; +use utf8; # the following are modules which ship with Perl (>= 5.10): use Pod::Usage; use Cwd qw(abs_path); -use File::Basename qw(basename); use File::Temp qw(tempfile tempdir); use Getopt::Long; -use IO::Socket::UNIX; use POSIX (); -use Time::HiRes qw(sleep gettimeofday tv_interval); use TAP::Harness; use TAP::Parser; use TAP::Parser::Aggregator; +use Time::HiRes qw(time); +use IO::Handle; # these are shipped with the testsuite use lib qw(lib); -use StartXDummy; +use StartXServer; use StatusLine; +use TestWorker; # the following modules are not shipped with Perl use AnyEvent; use AnyEvent::Util; use AnyEvent::Handle; use AnyEvent::I3 qw(:all); -use X11::XCB; +use X11::XCB::Connection; +use JSON::XS; # AnyEvent::I3 depends on it, too. + +binmode STDOUT, ':utf8'; +binmode STDERR, ':utf8'; # Close superfluous file descriptors which were passed by running in a VIM # subshell or situations like that. AnyEvent::Util::close_all_fds_except(0, 1, 2); -# We actually use AnyEvent to make sure it loads an event loop implementation. -# Afterwards, we overwrite SIGCHLD: -my $cv = AnyEvent->condvar; - -# Install a dummy CHLD handler to overwrite the CHLD handler of AnyEvent. -# AnyEvent’s handler wait()s for every child which conflicts with TAP (TAP -# needs to get the exit status to determine if a test is successful). -$SIG{CHLD} = sub { -}; - # convinience wrapper to write to the log file my $log; sub Log { say $log "@_" } -my $coverage_testing = 0; -my $valgrind = 0; -my $strace = 0; +my %timings; my $help = 0; -# Number of tests to run in parallel. Important to know how many Xdummy +# Number of tests to run in parallel. Important to know how many Xephyr # instances we need to start (unless @displays are given). Defaults to # num_cores * 2. my $parallel = undef; my @displays = (); +my %options = ( + valgrind => 0, + strace => 0, + xtrace => 0, + coverage => 0, + restart => 0, +); +my $keep_xserver_output = 0; my $result = GetOptions( - "coverage-testing" => \$coverage_testing, - "valgrind" => \$valgrind, - "strace" => \$strace, + "coverage-testing" => \$options{coverage}, + "keep-xserver-output" => \$keep_xserver_output, + "valgrind" => \$options{valgrind}, + "strace" => \$options{strace}, + "xtrace" => \$options{xtrace}, "display=s" => \@displays, "parallel=i" => \$parallel, "help|?" => \$help, @@ -67,46 +70,95 @@ my $result = GetOptions( pod2usage(-verbose => 2, -exitcode => 0) if $help; +# Check for missing executables +my @binaries = qw( + ../i3 + ../i3bar/i3bar + ../i3-config-wizard/i3-config-wizard + ../i3-dump-log/i3-dump-log + ../i3-input/i3-input + ../i3-msg/i3-msg + ../i3-nagbar/i3-nagbar + ); + +foreach my $binary (@binaries) { + die "$binary executable not found, did you run “make”?" unless -e $binary; + die "$binary is not an executable" unless -x $binary; +} + +qx(Xephyr -help 2>&1); +die "Xephyr was not found in your path. Please install Xephyr (xserver-xephyr on Debian)." if $?; + @displays = split(/,/, join(',', @displays)); @displays = map { s/ //g; $_ } @displays; -# No displays specified, let’s start some Xdummy instances. -@displays = start_xdummy($parallel) if @displays == 0; +# 2: get a list of all testcases +my @testfiles = @ARGV; + +# if no files were passed on command line, run all tests from t/ +@testfiles = if @testfiles == 0; + +my $numtests = scalar @testfiles; + +# No displays specified, let’s start some Xephyr instances. +if (@displays == 0) { + @displays = start_xserver($parallel, $numtests, $keep_xserver_output); +} + +# 1: create an output directory for this test-run +my $outdir = "testsuite-"; +$outdir .= POSIX::strftime("%Y-%m-%d-%H-%M-%S-", localtime()); +$outdir .= `git describe --tags`; +chomp($outdir); +mkdir($outdir) or die "Could not create $outdir"; +unlink("latest") if -l "latest"; +symlink("$outdir", "latest") or die "Could not symlink latest to $outdir"; # connect to all displays for two reasons: # 1: check if the display actually works # 2: keep the connection open so that i3 is not the only client. this prevents -# the X server from exiting (Xdummy will restart it, but not quick enough -# sometimes) -my @conns; +# the X server from exiting +my @single_worker; for my $display (@displays) { my $screen; - my $x = X11::XCB->new($display, $screen); + my $x = X11::XCB::Connection->new(display => $display); if ($x->has_error) { die "Could not connect to display $display\n"; } else { - push @conns, $x; + # start a TestWorker for each display + push @single_worker, worker($display, $x, $outdir, \%options); } } -# 1: get a list of all testcases -my @testfiles = @ARGV; +# Read previous timing information, if available. We will be able to roughly +# predict the test duration and schedule a good order for the tests. +my $timingsjson = StartXServer::slurp('.last_run_timings.json'); +%timings = %{decode_json($timingsjson)} if length($timingsjson) > 0; + +# Re-order the files so that those which took the longest time in the previous +# run will be started at the beginning to not delay the whole run longer than +# necessary. +@testfiles = map { $_->[0] } + sort { $b->[1] <=> $a->[1] } + map { [$_, $timings{$_} // 999] } @testfiles; + +# Run 000-load-deps.t first to bail out early when dependencies are missing. +my $loadtest = "t/000-load-deps.t"; +if ((scalar grep { $_ eq $loadtest } @testfiles) > 0) { + @testfiles = ($loadtest, grep { $_ ne $loadtest } @testfiles); +} -# if no files were passed on command line, run all tests from t/ -@testfiles = if @testfiles == 0; +printf("\nRough time estimate for this run: %.2f seconds\n\n", $timings{GLOBAL}) + if exists($timings{GLOBAL}); -# 2: create an output directory for this test-run -my $outdir = "testsuite-"; -$outdir .= POSIX::strftime("%Y-%m-%d-%H-%M-%S-", localtime()); -$outdir .= `git describe --tags`; -chomp($outdir); -mkdir($outdir) or die "Could not create $outdir"; -unlink("latest") if -e "latest"; -symlink("$outdir", "latest") or die "Could not symlink latest to $outdir"; +# Forget the old timings, we don’t necessarily run the same set of tests as +# before. Otherwise we would end up with left-overs. +%timings = (GLOBAL => time()); my $logfile = "$outdir/complete-run.log"; open $log, '>', $logfile or die "Could not create '$logfile': $!"; +$log->autoflush(1); say "Writing logfile to '$logfile'..."; # 3: run all tests @@ -119,11 +171,16 @@ $aggregator->start(); status_init(displays => \@displays, tests => $num); +my $single_cv = AE::cv; + # We start tests concurrently: For each display, one test gets started. Every # test starts another test after completing. -for (@displays) { $cv->begin; take_job($_) } +for (@single_worker) { + $single_cv->begin; + take_job($_, $single_cv, \@testfiles); +} -$cv->recv; +$single_cv->recv; $aggregator->stop(); @@ -132,6 +189,7 @@ print "\n\n"; for (@done) { my ($test, $output) = @$_; + say "no output for $test" unless $output; Log "output for $test:"; Log $output; # print error messages of failed tests @@ -143,7 +201,31 @@ $harness->summary($aggregator); close $log; -cleanup(); +# 5: Save the timings for better scheduling/prediction next run. +$timings{GLOBAL} = time() - $timings{GLOBAL}; +open(my $fh, '>', '.last_run_timings.json'); +print $fh encode_json(\%timings); +close($fh); + +# 6: Print the slowest test files. +my @slowest = map { $_->[0] } + sort { $b->[1] <=> $a->[1] } + map { [$_, $timings{$_}] } + grep { !/^GLOBAL$/ } keys %timings; +say ''; +say 'The slowest tests are:'; +printf("\t%s with %.2f seconds\n", $_, $timings{$_}) + for @slowest[0..($#slowest > 4 ? 4 : $#slowest)]; + +# When we are running precisely one test, print the output. Makes developing +# with a single testcase easier. +if ($numtests == 1) { + say ''; + say 'Test output:'; + say StartXServer::slurp($logfile); +} + +END { cleanup() } exit 0; @@ -158,72 +240,101 @@ exit 0; # triggered to finish testing. # sub take_job { - my ($display) = @_; + my ($worker, $cv, $tests) = @_; - my $test = shift @testfiles + my $test = shift @$tests or return $cv->end; - my $basename = basename($test); + my $display = $worker->{display}; - Log status($display, "Starting $test"); + Log status($display, "$test: starting"); + $timings{$test} = time(); + worker_next($worker, $test); + # create a TAP::Parser with an in-memory fh my $output; - open(my $spool, '>', \$output); my $parser = TAP::Parser->new({ - exec => [ 'sh', '-c', qq|DISPLAY=$display TESTNAME="$basename" OUTDIR="$outdir" VALGRIND=$valgrind STRACE=$strace COVERAGE=$coverage_testing /usr/bin/perl -Ilib $test| ], - spool => $spool, - merge => 1, + source => do { open(my $fh, '<', \$output); $fh }, }); - my $tests_completed; - - my @watchers; - my ($stdout, $stderr) = $parser->get_select_handles; - for my $handle ($parser->get_select_handles) { - my $w; - $w = AnyEvent->io( - fh => $handle, - poll => 'r', - cb => sub { - # Ignore activity on stderr (unnecessary with merge => 1, - # but let’s keep it in here if we want to use merge => 0 - # for some reason in the future). - return if defined($stderr) and $handle == $stderr; + my $ipc = $worker->{ipc}; - my $result = $parser->next; - if (defined($result)) { - $tests_completed++; - status($display, "Running $test: [$tests_completed/??]"); - # TODO: check if we should bail out + my $w; + $w = AnyEvent->io( + fh => $ipc, + poll => 'r', + cb => sub { + state $tests_completed = 0; + state $partial = ''; + + sysread($ipc, my $buf, 4096) or die "sysread: $!"; + + if ($partial) { + $buf = $partial . $buf; + $partial = ''; + } + + # make sure we feed TAP::Parser complete lines so it doesn't blow up + if (substr($buf, -1, 1) ne "\n") { + my $nl = rindex($buf, "\n"); + if ($nl == -1) { + $partial = $buf; return; } - # $result is not defined, we are done parsing - Log status($display, "$test finished"); - close($parser->delete_spool); - $aggregator->add($test, $parser); - push @done, [ $test, $output ]; + # strip partial from buffer + $partial = substr($buf, $nl + 1, ''); + } + + # count lines before stripping eof-marker otherwise we might + # end up with for (1 .. 0) { } which would effectivly skip the loop + my $lines = $buf =~ tr/\n//; + my $t_eof = $buf =~ s/^$TestWorker::EOF$//m; - status_completed(scalar @done); + $output .= $buf; - undef $_ for @watchers; - if (@done == $num) { - $cv->end; - } else { - take_job($display); + for (1 .. $lines) { + my $result = $parser->next; + next unless defined($result); + if ($result->is_test) { + $tests_completed++; + status($display, "$test: [$tests_completed/??] "); + } elsif ($result->is_bailout) { + Log status($display, "$test: BAILOUT"); + status_completed(scalar @done); + say ""; + say "test $test bailed out: " . $result->explanation; + exit 1; } } - ); - push @watchers, $w; - } + + return unless $t_eof; + + Log status($display, "$test: finished"); + $timings{$test} = time() - $timings{$test}; + status_completed(scalar @done); + + $aggregator->add($test, $parser); + push @done, [ $test, $output ]; + + undef $w; + take_job($worker, $cv, $tests); + } + ); } sub cleanup { $_->() for our @CLEANUP; + exit; } # must be in a begin block because we C above -BEGIN { $SIG{$_} = \&cleanup for qw(INT TERM QUIT KILL) } +BEGIN { + $SIG{$_} = sub { + require Carp; Carp::cluck("Caught SIG$_[0]\n"); + cleanup(); + } for qw(INT TERM QUIT KILL PIPE) +} __END__ @@ -237,7 +348,7 @@ complete-run.pl [files...] =head1 EXAMPLE -To run the whole testsuite on a reasonable number of Xdummy instances (your +To run the whole testsuite on a reasonable number of Xephyr instances (your running X11 will not be touched), run: ./complete-run.pl @@ -256,11 +367,11 @@ will parallelize the tests: # Run tests on the second X server ./complete-run.pl -d :1 - # Run four tests in parallel on some Xdummy servers + # Run four tests in parallel on some Xephyr servers ./complete-run.pl -d :1,:2,:3,:4 Note that it is not necessary to specify this anymore. If omitted, -complete-run.pl will start (num_cores * 2) Xdummy instances. +complete-run.pl will start (num_cores * 2) Xephyr instances. =item B<--valgrind> @@ -272,14 +383,19 @@ C. Runs i3 under strace to trace system calls. The output will be available in C. +=item B<--xtrace> + +Runs i3 under xtrace to trace X11 requests/replies. The output will be +available in C. + =item B<--coverage-testing> Exits i3 cleanly (instead of kill -9) to make coverage testing work properly. =item B<--parallel> -Number of Xdummy instances to start (if you don’t want to start num_cores * 2 +Number of Xephyr instances to start (if you don’t want to start num_cores * 2 instances for some reason). - # Run all tests on a single Xdummy instance + # Run all tests on a single Xephyr instance ./complete-run.pl -p 1