X-Git-Url: https://git.sur5r.net/?a=blobdiff_plain;f=testcases%2Fcomplete-run.pl;h=3475a45cb9a854d42f5b71e7902884d10758a9fa;hb=f88c77945744565c1b637d8fcaab271312bf1a1c;hp=8f740d8caf2965cafb5bc4b535bb8f02ace36b71;hpb=143663f0317d4a5c527976aac59ada2b0f7d7cd6;p=i3%2Fi3 diff --git a/testcases/complete-run.pl b/testcases/complete-run.pl index 8f740d8c..3475a45c 100755 --- a/testcases/complete-run.pl +++ b/testcases/complete-run.pl @@ -1,119 +1,222 @@ #!/usr/bin/env perl # vim:ts=4:sw=4:expandtab -# # © 2010-2011 Michael Stapelberg and contributors -# -# syntax: ./complete-run.pl --display :1 --display :2 -# to run the test suite on the X11 displays :1 and :2 -# use 'Xdummy :1' and 'Xdummy :2' before to start two -# headless X11 servers -# - +package complete_run; use strict; use warnings; -use EV; -use AnyEvent; -use IO::Scalar; # not in core :\ -use File::Temp qw(tempfile tempdir); use v5.10; -use DateTime; -use Data::Dumper; +# the following are modules which ship with Perl (>= 5.10): +use Pod::Usage; use Cwd qw(abs_path); -use Proc::Background; +use File::Temp qw(tempfile tempdir); +use Getopt::Long; +use POSIX (); use TAP::Harness; use TAP::Parser; use TAP::Parser::Aggregator; -use File::Basename qw(basename); +use Time::HiRes qw(time); +# 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 Try::Tiny; -use Getopt::Long; -use Time::HiRes qw(sleep); use X11::XCB::Connection; -use IO::Socket::UNIX; # core -use POSIX; # core -use AnyEvent::Handle; - -# open a file so that we get file descriptor 3. we will later close it in the -# child and dup() the listening socket file descriptor to 3 to pass it to i3 -open(my $reserved, '<', '/dev/null'); -if (fileno($reserved) != 3) { - warn "Socket file descriptor is not 3."; - warn "Please don't start this script within a subshell of vim or something."; - exit 1; -} +use JSON::XS; # AnyEvent::I3 depends on it, too. -# install a dummy CHLD handler to overwrite the CHLD handler of AnyEvent / EV -# XXX: we could maybe also use a different loop than the default loop in EV? -$SIG{CHLD} = sub { -}; +# 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); -# reads in a whole file -sub slurp { - open my $fh, '<', shift; - local $/; - <$fh>; -} +# convinience wrapper to write to the log file +my $log; +sub Log { say $log "@_" } +my %timings; my $coverage_testing = 0; +my $valgrind = 0; +my $strace = 0; +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 $result = GetOptions( "coverage-testing" => \$coverage_testing, + "valgrind" => \$valgrind, + "strace" => \$strace, "display=s" => \@displays, + "parallel=i" => \$parallel, + "help|?" => \$help, ); +pod2usage(-verbose => 2, -exitcode => 0) if $help; + @displays = split(/,/, join(',', @displays)); @displays = map { s/ //g; $_ } @displays; -@displays = qw(:1) 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; + +# When the user specifies displays, we don’t run multi-monitor tests at all +# (because we don’t know which displaynumber is the X-Server with multiple +# monitors). +my $multidpy = undef; + +# No displays specified, let’s start some Xdummy instances. +if (@displays == 0) { + my $dpyref; + ($dpyref, $multidpy) = start_xdummy($parallel, $numtests); + @displays = @$dpyref; +} + +# 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) { - try { - my $x = X11::XCB::Connection->new(display => $display); - push @conns, $x; - push @wdisplays, $display; - } catch { - say STDERR "WARNING: Not using X11 display $display, could not connect"; - }; + my $screen; + my $x = X11::XCB::Connection->new(display => $display); + if ($x->has_error) { + die "Could not connect to display $display\n"; + } else { + # start a TestWorker for each display + push @single_worker, worker($display, $x, $outdir); + } } -my $config = slurp('i3-test.config'); +my @multi_worker; +if (defined($multidpy)) { + my $x = X11::XCB::Connection->new(display => $multidpy); + if ($x->has_error) { + die "Could not connect to multi-monitor display $multidpy\n"; + } else { + push @multi_worker, worker($multidpy, $x, $outdir); + } +} -# 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; -# if no files were passed on command line, run all tests from t/ -@testfiles = if @testfiles == 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; -# 2: create an output directory for this test-run -my $outdir = "testsuite-"; -$outdir .= DateTime->now->strftime("%Y-%m-%d-%H-%M-%S-"); -$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"; +printf("\nRough time estimate for this run: %.2f seconds\n\n", $timings{GLOBAL}) + if exists($timings{GLOBAL}); + +# 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': $!"; +say "Writing logfile to '$logfile'..."; # 3: run all tests my @done; my $num = @testfiles; my $harness = TAP::Harness->new({ }); +my @single_monitor_tests = grep { m,^t/([0-9]+)-, && $1 < 500 } @testfiles; +my @multi_monitor_tests = grep { m,^t/([0-9]+)-, && $1 >= 500 } @testfiles; + my $aggregator = TAP::Parser::Aggregator->new(); $aggregator->start(); -my $cv = AnyEvent->condvar; +status_init(displays => [ @displays, $multidpy ], tests => $num); + +my $single_cv = AE::cv; +my $multi_cv = AE::cv; # We start tests concurrently: For each display, one test gets started. Every # test starts another test after completing. -take_job($_) for @wdisplays; +for (@single_worker) { + $single_cv->begin; + take_job($_, $single_cv, \@single_monitor_tests); +} +for (@multi_worker) { + $multi_cv->begin; + take_job($_, $multi_cv, \@multi_monitor_tests); +} + +$single_cv->recv; +$multi_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. @@ -126,178 +229,150 @@ take_job($_) for @wdisplays; # triggered to finish testing. # sub take_job { - my ($display) = @_; - - my $test = shift @testfiles; - return unless $test; - my $dont_start = (slurp($test) =~ /# !NO_I3_INSTANCE!/); - my $logpath = "$outdir/i3-log-for-" . basename($test); - - my ($fh, $tmpfile) = tempfile(); - say $fh $config; - say $fh "ipc-socket /tmp/nested-$display"; - close($fh); - - my $activate_cv = AnyEvent->condvar; - my $start_i3 = sub { - # remove the old unix socket - unlink("/tmp/nested-$display-activation"); - - # pass all file descriptors up to three to the children. - # we need to set this flag before opening the socket. - open(my $fdtest, '<', '/dev/null'); - $^F = fileno($fdtest); - close($fdtest); - my $socket = IO::Socket::UNIX->new( - Listen => 1, - Local => "/tmp/nested-$display-activation", - ); - - my $pid = fork; - if (!defined($pid)) { - die "could not fork()"; - } - say "pid = $pid"; - if ($pid == 0) { - say "child!"; - $ENV{LISTEN_PID} = $$; - $ENV{LISTEN_FDS} = 1; - $ENV{DISPLAY} = $display; - $^F = 3; - - say "fileno is " . fileno($socket); - close($reserved); - POSIX::dup2(fileno($socket), 3); - - # now execute i3 - my $i3cmd = abs_path("../i3") . " -V -d all --disable-signalhandler"; - my $cmd = "exec $i3cmd -c $tmpfile >$logpath 2>&1"; - exec "/bin/sh", '-c', $cmd; - - # if we are still here, i3 could not be found or exec failed. bail out. - exit 1; - } + my ($worker, $cv, $tests) = @_; - my $child_watcher; - $child_watcher = AnyEvent->child(pid => $pid, cb => sub { - say "child died. pid = $pid"; - undef $child_watcher; - }); - - # close the socket, the child process should be the only one which keeps a file - # descriptor on the listening socket. - $socket->close; - - # We now connect (will succeed immediately) and send a request afterwards. - # As soon as the reply is there, i3 is considered ready. - my $cl = IO::Socket::UNIX->new(Peer => "/tmp/nested-$display-activation"); - my $hdl; - $hdl = AnyEvent::Handle->new(fh => $cl, on_error => sub { $activate_cv->send(0) }); - - # send a get_tree message without payload - $hdl->push_write('i3-ipc' . pack("LL", 0, 4)); - - # wait for the reply - $hdl->push_read(chunk => 1, => sub { - my ($h, $line) = @_; - say "read something from i3"; - $activate_cv->send(1); - undef $hdl; - }); - - return $pid; - }; - - my $pid; - $pid = $start_i3->() unless $dont_start; - - my $kill_i3 = sub { - # Don’t bother killing i3 when we haven’t started it - return if $dont_start; - - # When measuring code coverage, try to exit i3 cleanly (otherwise, .gcda - # files are not written) and fallback to killing it - if ($coverage_testing) { - my $exited = 0; - try { - say "Exiting i3 cleanly..."; - i3("/tmp/nested-$display")->command('exit')->recv; - $exited = 1; - }; - return if $exited; - } + my $test = shift @$tests + or return $cv->end; - say "[$display] killing i3"; - kill(9, $pid) or die "could not kill i3"; - }; - - # This will be called as soon as i3 is running and answered to our - # IPC request - $activate_cv->cb(sub { - say "cb"; - my ($status) = $activate_cv->recv; - say "complete-run: status = $status"; - - say "[$display] Running $test with logfile $logpath"; - - my $output; - my $parser = TAP::Parser->new({ - exec => [ 'sh', '-c', qq|DISPLAY=$display LOGPATH="$logpath" /usr/bin/perl -It/lib $test| ], - spool => IO::Scalar->new(\$output), - merge => 1, - }); - - 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 $result = $parser->next; - if (defined($result)) { - # TODO: check if we should bail out - return; - } - - # $result is not defined, we are done parsing - say "[$display] $test finished"; - close($parser->delete_spool); - $aggregator->add($test, $parser); - push @done, [ $test, $output ]; - - $kill_i3->(); - - undef $_ for @watchers; - if (@done == $num) { - $cv->send; - } else { - take_job($display); - } + my $display = $worker->{display}; + + Log status($display, "$test: starting"); + $timings{$test} = time(); + worker_next($worker, $test); + + # create a TAP::Parser with an in-memory fh + my $output; + my $parser = TAP::Parser->new({ + source => do { open(my $fh, '<', \$output); $fh }, + }); + + my $ipc = $worker->{ipc}; + + 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; } - ); - push @watchers, $w; + + # 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; + + $output .= $buf; + + for (1 .. $lines) { + my $result = $parser->next; + if (defined($result) and $result->is_test) { + $tests_completed++; + status($display, "$test: [$tests_completed/??] "); + } + } + + 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; +} - $activate_cv->send(1) if $dont_start; +# 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) } -$cv->recv; +__END__ -$aggregator->stop(); +=head1 NAME -for (@done) { - my ($test, $output) = @$_; - say "output for $test:"; - say $output; -} +complete-run.pl - Run the i3 testsuite -# 4: print summary -$harness->summary($aggregator); +=head1 SYNOPSIS + +complete-run.pl [files...] + +=head1 EXAMPLE + +To run the whole testsuite on a reasonable number of Xdummy instances (your +running X11 will not be touched), run: + ./complete-run.pl + +To run only a specific test (useful when developing a new feature), run: + ./complete-run t/100-fullscreen.t + +=head1 OPTIONS + +=over 8 + +=item B<--display> + +Specifies which X11 display should be used. Can be specified multiple times and +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 + ./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. + +=item B<--valgrind> + +Runs i3 under valgrind to find memory problems. The output will be available in +C. + +=item B<--strace> + +Runs i3 under strace to trace system calls. 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 +instances for some reason). + + # Run all tests on a single Xdummy instance + ./complete-run.pl -p 1