X-Git-Url: https://git.sur5r.net/?a=blobdiff_plain;f=testcases%2Fcomplete-run.pl;h=560dd4c3de0bc21f6c4126b7f152ef4b424d89fb;hb=b1cc4d5166f3c9b4908c7424d3b577ca25a45940;hp=c62623f10245ae29ceab38165ed1c01156f62d49;hpb=f7f1ec5dab85e934de8220fb48dee861e1097e35;p=i3%2Fi3

diff --git a/testcases/complete-run.pl b/testcases/complete-run.pl
index c62623f1..560dd4c3 100755
--- a/testcases/complete-run.pl
+++ b/testcases/complete-run.pl
@@ -1,74 +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 POSIX ();
 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 SocketActivation;
 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 {
-};
-
-# 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 $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,
@@ -76,55 +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 = <t/*.t> 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;
-
-my $config = slurp('i3-test.config');
-
-# 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 = <t/*.t> 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
@@ -135,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.
@@ -152,175 +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 $dont_start = (slurp($test) =~ /# !NO_I3_INSTANCE!/);
-    my $basename = basename($test);
-    my $logpath = "$outdir/i3-log-for-$basename";
+    my $display = $worker->{display};
 
-    my ($fh, $tmpfile) = tempfile("i3-cfg-for-$basename.XXXXXX", UNLINK => 1);
-    say $fh $config;
-    say $fh "ipc-socket /tmp/nested-$display";
-    close($fh);
+    Log status($display, "$test: starting");
+    $timings{$test} = time();
+    worker_next($worker, $test);
 
-    my $activate_cv = AnyEvent->condvar;
-    my $time_before_start = [gettimeofday];
-
-    my $pid;
-    if ($dont_start) {
-        $activate_cv->send(1);
-    } else {
-        $pid = activate_i3(
-            unix_socket_path => "/tmp/nested-$display-activation",
-            display => $display,
-            configfile => $tmpfile,
-            outdir => $outdir,
-            testname => $basename,
-            valgrind => $valgrind,
-            strace => $strace,
-            cv => $activate_cv
-        );
-
-        my $child_watcher;
-        $child_watcher = AnyEvent->child(pid => $pid, cb => sub {
-            Log status($display, "child died. pid = $pid");
-            undef $child_watcher;
-        });
-    }
-
-    my $kill_i3 = sub {
-        my $kill_cv = AnyEvent->condvar;
-
-        # Don’t bother killing i3 when we haven’t started it
-        if ($dont_start) {
-            $kill_cv->send();
-            return $kill_cv;
-        }
+    # create a TAP::Parser with an in-memory fh
+    my $output;
+    my $parser = TAP::Parser->new({
+        source => do { open(my $fh, '<', \$output); $fh },
+    });
 
-        # When measuring code coverage, try to exit i3 cleanly (otherwise, .gcda
-        # files are not written) and fallback to killing it
-        if ($coverage_testing || $valgrind) {
-            my $exited = 0;
-            Log status($display, 'Exiting i3 cleanly...');
-            my $i3 = i3("/tmp/nested-$display");
-            $i3->connect->cb(sub {
-                if (!$_[0]->recv) {
-                    # Could not connect to i3, just kill -9 it
-                    kill(9, $pid) or die "Could not kill i3 using kill($pid)";
-                    $kill_cv->send();
-                } else {
-                    # Connected. Now send exit and continue once that’s acked.
-                    $i3->command('exit')->cb(sub {
-                        $kill_cv->send();
-                    });
+    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;
                 }
-            });
-        } else {
-            Log status($display, 'killing i3');
-
-            # No coverage testing or valgrind? Just kill -9 i3.
-            kill(9, $pid) or die "Could not kill i3 using kill($pid)";
-            $kill_cv->send();
-        }
-
-        return $kill_cv;
-    };
-
-    # This will be called as soon as i3 is running and answered to our
-    # IPC request
-    $activate_cv->cb(sub {
-        my $time_activating = [gettimeofday];
-        my $start_duration = tv_interval($time_before_start, $time_activating);
-        my ($status) = $activate_cv->recv;
-        if ($dont_start) {
-            Log status($display, 'Not starting i3, testcase does that');
-        } else {
-            my $duration = sprintf("%.2f", $start_duration);
-            Log status($display, "i3 startup: took $duration sec, status = $status");
-        }
-
-        Log status($display, "Starting $test");
-
-        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 /usr/bin/perl -Ilib $test| ],
-            spool => $spool,
-            merge => 1,
-        });
-
-        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 $result = $parser->next;
-                    if (defined($result)) {
-                        $tests_completed++;
-                        status($display, "Running $test: [$tests_completed/??]");
-                        # TODO: check if we should bail out
-                        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;
+
+            $output .= $buf;
+
+            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);
-
-                    my $exitcv = $kill_i3->();
-                    $exitcv->cb(sub {
-
-                        undef $_ for @watchers;
-                        if (@done == $num) {
-                            $cv->end;
-                        } else {
-                            take_job($display);
-                        }
-                    });
+                    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<exit 0> above
+BEGIN {
+    $SIG{$_} = sub {
+        require Carp; Carp::cluck("Caught SIG$_[0]\n");
+        cleanup();
+    } for qw(INT TERM QUIT KILL PIPE)
+}
 
 __END__
 
@@ -369,6 +381,11 @@ C<latest/valgrind-for-$test.log>.
 Runs i3 under strace to trace system calls. The output will be available in
 C<latest/strace-for-$test.log>.
 
+=item B<--xtrace>
+
+Runs i3 under xtrace to trace X11 requests/replies. The output will be
+available in C<latest/xtrace-for-$test.log>.
+
 =item B<--coverage-testing>
 
 Exits i3 cleanly (instead of kill -9) to make coverage testing work properly.