From a46a9d72d6fe2b0f2c9e65584586318affa98bc1 Mon Sep 17 00:00:00 2001
From: Avery Pennarun <apenwarr@gmail.com>
Date: Thu, 30 Apr 2009 21:02:00 -0400
Subject: [PATCH] Replaced wvtesthelper/meter/colour scripts with an all-new
 wvtestrunner.pl.

This one is much smarter than previous versions: by default, it prints out
only the headers from "Testing blah blah:" lines and then prints just a "."
for each "! whatever  ok" line.  But, if a test does fail, it prints out
*all* the stdout/stderr that was produced by the test from the "Testing blah
blah" line all the way to the failing test.

It also auto-colours ok/FAILED lines, but only if stdout is a tty, so you
don't need to decide whether you want it coloured or not.

Finally, its output is actually compatible with itself: you can run a
top-level wvtestrunner and it'll further summarize the output of inner
wvtestrunners, because the complete output of a given testrunner is in a
single "Testing blah blah:" section.  But if a failure occurs, you'll still
get the more detailed results.

(cherry picked from commit 49efbe24c148d69873ca78c05e9c5825d50ef49d)
---
 wvtestrunner.pl | 143 ++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 143 insertions(+)
 create mode 100755 wvtestrunner.pl

diff --git a/wvtestrunner.pl b/wvtestrunner.pl
new file mode 100755
index 0000000..9eace82
--- /dev/null
+++ b/wvtestrunner.pl
@@ -0,0 +1,143 @@
+#!/usr/bin/perl -w
+use strict;
+
+# always flush
+$| = 1;
+
+if (@ARGV < 1) {
+    print STDERR "Usage: $0 <command line...>\n";
+    exit 127;
+}
+
+print STDERR "Testing \"all\" in @ARGV:\n";
+
+my $pid = open(my $fh, "-|");
+if (!$pid) {
+    # child
+    setpgrp();
+    open STDERR, '>&STDOUT' or die("Can't dup stdout: $!\n");
+    exec(@ARGV);
+    exit 126; # just in case
+}
+
+my $istty = -t STDOUT;
+my @log = ();
+my ($gpasses, $gfails) = (0,0);
+
+sub bigkill($)
+{
+    my $pid = shift;
+    
+    if (@log) {
+	print "\n" . join("\n", @log) . "\n";
+    }
+    
+    print STDERR "Killed by signal.\n";
+
+    ($pid > 0) || die("pid is '$pid'?!\n");
+
+    local $SIG{CHLD} = sub { }; # this will wake us from sleep() faster
+    kill 15, $pid;
+    sleep(2);
+    
+    if ($pid > 1) {
+	kill 9, -$pid;
+    }
+    kill 9, $pid;
+    
+    exit(125);
+}
+
+# parent
+local $SIG{INT} = sub { bigkill($pid); };
+local $SIG{TERM} = sub { bikill($pid); };
+
+sub colourize($)
+{
+    my $result = shift;
+    my $pass = ($result eq "ok");
+    
+    if ($istty) {
+	my $colour = $pass ? "\e[32;1m" : "\e[31;1m";
+	return "$colour$result\e[0m";
+    } else {
+	return $result;
+    }
+}
+
+sub resultline($$)
+{
+    my ($name, $result) = @_;
+    return sprintf("! %-65s %s", $name, colourize($result));
+}
+
+my $insection = 0;
+
+while (<$fh>)
+{
+    chomp;
+    
+    if (/^\s*Testing "(.*)" in (.*):\s*$/)
+    {
+	my ($sect, $file) = ($1, $2);
+	
+	if ($insection) {
+	    printf " %s\n", colourize("ok");
+	}
+	
+	printf("! %s  %s: ", $file, $sect);
+	@log = ();
+	$insection = 1;
+    }
+    elsif (/^!\s*(.*?)\s+(\S+)\s*$/)
+    {
+	my ($name, $result) = ($1, $2);
+	my $pass = ($result eq "ok");
+	
+	if (!$insection) {
+	    printf("\n! Startup: ");
+	}
+	$insection++;
+	
+	push @log, resultline($name, $result);
+	
+	if (!$pass) {
+	    $gfails++;
+	    if (@log) {
+		print "\n" . join("\n", @log) . "\n";
+		@log = ();
+	    }
+	} else {
+	    $gpasses++;
+	    print ".";
+	}
+    }
+    else
+    {
+	push @log, $_;
+    }
+}
+
+if ($insection) {
+    printf " %s\n", colourize("ok");
+}
+
+my $newpid = waitpid($pid, 0);
+if ($newpid != $pid) {
+    die("waitpid returned '$newpid', expected '$pid'\n");
+}
+
+my $code = $?;
+my $ret = ($code >> 8);
+
+if ($ret && @log) {
+    print "\n" . join("\n", @log) . "\n";
+}
+
+
+my $gtotal = $gpasses+$gfails;
+printf("\nWvTest: %d test%s, %d failure%s.\n",
+    $gtotal, $gtotal==1 ? "" : "s",
+    $gfails, $gfails==1 ? "" : "s");
+print STDERR "\nWvTest result code: $ret\n";
+exit( $ret ? $ret : ($gfails ? 125 : 0) );
-- 
2.39.2