X-Git-Url: https://git.sur5r.net/?a=blobdiff_plain;f=testcases%2Fcomplete-run.pl;h=560dd4c3de0bc21f6c4126b7f152ef4b424d89fb;hb=b1cc4d5166f3c9b4908c7424d3b577ca25a45940;hp=1b05235e27e5fee6e2faa1ac27ab0e014f6b0621;hpb=8349190e09c1b75965824c8d88e0aeae6587a6a4;p=i3%2Fi3 diff --git a/testcases/complete-run.pl b/testcases/complete-run.pl index 1b05235e..560dd4c3 100755 --- a/testcases/complete-run.pl +++ b/testcases/complete-run.pl @@ -1,66 +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 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 # instances we need to start (unless @displays are given). Defaults to # num_cores * 2. my $parallel = undef; my @displays = (); -my @childpids = (); +my %options = ( + valgrind => 0, + strace => 0, + xtrace => 0, + coverage => 0, + restart => 0, +); +my $keep_xdummy_output = 0; my $result = GetOptions( - "coverage-testing" => \$coverage_testing, - "valgrind" => \$valgrind, - "strace" => \$strace, + "coverage-testing" => \$options{coverage}, + "keep-xdummy-output" => \$keep_xdummy_output, + "valgrind" => \$options{valgrind}, + "strace" => \$options{strace}, + "xtrace" => \$options{xtrace}, "display=s" => \@displays, "parallel=i" => \$parallel, "help|?" => \$help, @@ -68,53 +70,93 @@ 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; +} + @displays = split(/,/, join(',', @displays)); @displays = map { s/ //g; $_ } @displays; +# 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 Xdummy instances. if (@displays == 0) { - my ($displays, $pids) = start_xdummy($parallel); - @displays = @$displays; - @childpids = @$pids; + @displays = start_xdummy($parallel, $numtests, $keep_xdummy_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 -e "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; -my @wdisplays; +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) { - Log "WARNING: Not using X11 display $display, could not connect"; + die "Could not connect to display $display\n"; } else { - push @conns, $x; - push @wdisplays, $display; + # start a TestWorker for each display + push @single_worker, worker($display, $x, $outdir, \%options); } } -die "No usable displays found" if @wdisplays == 0; - -# 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 = StartXDummy::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 ($loadtest ~~ @testfiles) { + @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 @@ -125,11 +167,65 @@ my $harness = TAP::Harness->new({ }); my $aggregator = TAP::Parser::Aggregator->new(); $aggregator->start(); -status_init(displays => \@wdisplays, tests => $num); +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 (@wdisplays) { $cv->begin; take_job($_) } +for (@single_worker) { + $single_cv->begin; + take_job($_, $single_cv, \@testfiles); +} + +$single_cv->recv; + +$aggregator->stop(); + +# print empty lines to seperate failed tests from statuslines +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 + say for $output =~ /^not ok.+\n+((?:^#.+\n)+)/mg +} + +# 4: print summary +$harness->summary($aggregator); + +close $log; + +# 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 StartXDummy::slurp($logfile); +} + +END { cleanup() } + +exit 0; # # Takes a test from the beginning of @testfiles and runs it. @@ -142,87 +238,101 @@ for (@wdisplays) { $cv->begin; take_job($_) } # 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; - } -} -$cv->recv; + return unless $t_eof; -$aggregator->stop(); + Log status($display, "$test: finished"); + $timings{$test} = time() - $timings{$test}; + status_completed(scalar @done); -# print empty lines to seperate failed tests from statuslines -print "\n\n"; + $aggregator->add($test, $parser); + push @done, [ $test, $output ]; -for (@done) { - my ($test, $output) = @$_; - Log "output for $test:"; - Log $output; - # print error messages of failed tests - say for $output =~ /^not ok.+\n+((?:^#.+\n)+)/mg + undef $w; + take_job($worker, $cv, $tests); + } + ); } -# 4: print summary -$harness->summary($aggregator); - -close $log; +sub cleanup { + $_->() for our @CLEANUP; + exit; +} -kill(15, $_) for @childpids; +# must be in a begin block because we C above +BEGIN { + $SIG{$_} = sub { + require Carp; Carp::cluck("Caught SIG$_[0]\n"); + cleanup(); + } for qw(INT TERM QUIT KILL PIPE) +} __END__ @@ -271,6 +381,11 @@ 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.