complete-run: log verbose output, display statuslines instead

diff --git a/testcases/complete-run.pl b/testcases/complete-run.pl
index 915a7e02679a1978cca5ab156ac0c5e22103650f..73adf39da7e8afddd131db85ef8ab3c8074d0d22 100755 (executable)
--- a/testcases/complete-run.pl
+++ b/testcases/complete-run.pl
@@ -22,6 +22,7 @@ use TAP::Parser::Aggregator;
 use lib qw(lib);
 use SocketActivation;
 use StartXDummy;
+use StatusLine;
 # the following modules are not shipped with Perl
 use AnyEvent;
 use AnyEvent::Handle;
@@ -45,6 +46,10 @@ sub slurp {
     <$fh>;
 }
 
+# convinience wrapper to write to the log file
+my $log;
+sub Log { say $log "@_" }
+
 my $coverage_testing = 0;
 my $valgrind = 0;
 my $help = 0;
@@ -86,7 +91,7 @@ for my $display (@displays) {
     my $screen;
     my $x = X11::XCB->new($display, $screen);
     if ($x->has_error) {
-        say STDERR "WARNING: Not using X11 display $display, could not connect";
+        Log "WARNING: Not using X11 display $display, could not connect";
     } else {
         push @conns, $x;
         push @wdisplays, $display;
@@ -112,6 +117,10 @@ mkdir($outdir) or die "Could not create $outdir";
 unlink("latest") if -e "latest";
 symlink("$outdir", "latest") or die "Could not symlink latest to $outdir";
 
+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;
@@ -120,6 +129,8 @@ my $harness = TAP::Harness->new({ });
 my $aggregator = TAP::Parser::Aggregator->new();
 $aggregator->start();
 
+status_init(displays => \@wdisplays, tests => $num);
+
 # We start tests concurrently: For each display, one test gets started. Every
 # test starts another test after completing.
 take_job($_) for @wdisplays;
@@ -139,10 +150,12 @@ sub take_job {
 
     my $test = shift @testfiles;
     return unless $test;
+
     my $dont_start = (slurp($test) =~ /# !NO_I3_INSTANCE!/);
-    my $logpath = "$outdir/i3-log-for-" . basename($test);
+    my $basename = basename($test);
+    my $logpath = "$outdir/i3-log-for-$basename";
 
-    my ($fh, $tmpfile) = tempfile('i3-run-cfg.XXXXXX', UNLINK => 1);
+    my ($fh, $tmpfile) = tempfile("i3-cfg-for-$basename.XXXXXX", UNLINK => 1);
     say $fh $config;
     say $fh "ipc-socket /tmp/nested-$display";
     close($fh);
@@ -166,7 +179,7 @@ sub take_job {
 
         my $child_watcher;
         $child_watcher = AnyEvent->child(pid => $pid, cb => sub {
-            say "child died. pid = $pid";
+            Log status($display, "child died. pid = $pid");
             undef $child_watcher;
         });
     }
@@ -184,7 +197,7 @@ sub take_job {
         # files are not written) and fallback to killing it
         if ($coverage_testing || $valgrind) {
             my $exited = 0;
-            say "[$display] Exiting i3 cleanly...";
+            Log status($display, 'Exiting i3 cleanly...');
             my $i3 = i3("/tmp/nested-$display");
             $i3->connect->cb(sub {
                 if (!$_[0]->recv) {
@@ -199,6 +212,8 @@ sub take_job {
                 }
             });
         } 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();
@@ -214,12 +229,13 @@ sub take_job {
         my $start_duration = tv_interval($time_before_start, $time_activating);
         my ($status) = $activate_cv->recv;
         if ($dont_start) {
-            say "[$display] Not starting i3, testcase does that";
+            Log status($display, 'Not starting i3, testcase does that');
         } else {
-            say "[$display] i3 startup: took " . sprintf("%.2f", $start_duration) . "s, status = $status";
+            my $duration = sprintf("%.2f", $start_duration);
+            Log status($display, "i3 startup: took $duration sec, status = $status");
         }
 
-        say "[$display] Running $test with logfile $logpath";
+        Log status($display, "Starting $test with logfile $logpath");
 
         my $output;
         open(my $spool, '>', \$output);
@@ -229,6 +245,8 @@ sub take_job {
             merge => 1,
         });
 
+        my $tests_completed;
+
         my @watchers;
         my ($stdout, $stderr) = $parser->get_select_handles;
         for my $handle ($parser->get_select_handles) {
@@ -244,16 +262,20 @@ sub take_job {
 
                     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
-                    say "[$display] $test finished";
+                    Log status($display, "$test finished");
                     close($parser->delete_spool);
                     $aggregator->add($test, $parser);
                     push @done, [ $test, $output ];
 
+                    status_completed(scalar @done);
+
                     my $exitcv = $kill_i3->();
                     $exitcv->cb(sub {
 
@@ -275,18 +297,22 @@ $cv->recv;
 
 $aggregator->stop();
 
-# Disable buffering to make sure the output and summary appear before we exit.
-$| = 1;
+# print empty lines to seperate failed tests from statuslines
+print "\n\n";
 
 for (@done) {
     my ($test, $output) = @$_;
-    say "output for $test:";
-    say $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;
+
 kill(15, $_) for @childpids;
 
 __END__

diff --git a/testcases/lib/StatusLine.pm b/testcases/lib/StatusLine.pm
new file mode 100644 (file)
index 0000000..823c671
--- /dev/null
+++ b/testcases/lib/StatusLine.pm
@@ -0,0 +1,64 @@
+package StatusLine;
+use strict; use warnings;
+
+# enable autoflush on STDOUT.
+# this is essential, because we print our statuslines without a newline
+$| = 1;
+
+use Exporter 'import';
+our @EXPORT = qw/status_init status status_completed/;
+
+my $ansi_clear_line = "\033[2K";
+my $ansi_save_cursor = "\0337";
+my $ansi_restore_cursor = "\0338";
+my %ansi_line_upwards;
+
+my $tests_total;
+
+# setup %ansi_line_upwards to map all working displays to the
+# specific movement commands and initialize all status lines
+sub status_init {
+    my %args = @_;
+    my $displays = $args{displays};
+    $tests_total = $args{tests};
+
+    for my $n (1 .. @$displays) {
+        # since we are moving upwards, get $display in reverse order
+        my $display = $displays->[-$n];
+
+        $ansi_line_upwards{$display} = "\033[$n\101";
+
+        # print an empty line for this status line
+        print "\n";
+    }
+
+    status_completed(0);
+}
+
+# generates the status text, prints it in the appropiate line
+# and returns it, so it can be used in conjuction with C<Log()>
+sub status {
+    my ($display, $msg) = @_;
+    my $status = "[$display] $msg";
+
+    print
+        $ansi_save_cursor,
+        $ansi_line_upwards{$display},
+        $ansi_clear_line,
+        $status,
+        $ansi_restore_cursor;
+
+    return $status;
+}
+
+sub status_completed {
+    my $num = shift;
+    print
+        $ansi_save_cursor,
+        $ansi_clear_line,
+        "completed $num of $tests_total tests",
+        $ansi_restore_cursor;
+}
+
+
+__PACKAGE__ __END__