update release date to actual daterelease-qpdf-2.0

git-svn-id: svn+q:///qpdf/trunk@599 71b93d88-0707-0410-a8cf-f5a4172ac649

4 files changed, 2393 insertions, 0 deletions

diff --git a/qtest/QTC/perl/QTC.pm b/qtest/QTC/perl/QTC.pm
new file mode 100644
index 00000000..2f78b3a6
--- /dev/null
+++ b/qtest/QTC/perl/QTC.pm
@@ -0,0 +1,26 @@
+# -*- perl -*-
+
+require 5.005;
+use strict;
+use FileHandle;
+
+package QTC;
+
+sub TC
+{
+    my ($scope, $case, $n) = @_;
+    local $!;
+    $n = 0 unless defined $n;
+    return unless ($scope eq ($ENV{'TC_SCOPE'} || ""));
+    my $filename = $ENV{'TC_FILENAME'} || return;
+    my $fh = new FileHandle(">>$filename") or
+	die "open test coverage file: $!\n";
+    print $fh "$case $n\n";
+    $fh->close();
+}
+
+1;
+
+#
+# END OF QTC
+#
diff --git a/qtest/README.txt b/qtest/README.txt
new file mode 100644
index 00000000..a4e21b04
--- /dev/null
+++ b/qtest/README.txt
@@ -0,0 +1,3 @@
+This is a copy of qtest (http://qtest.qbilt.org) which is distributed
+under the terms of the Artistic license and has the same author as
+qpdf.
diff --git a/qtest/bin/qtest-driver b/qtest/bin/qtest-driver
new file mode 100755
index 00000000..9ca1ec44
--- /dev/null
+++ b/qtest/bin/qtest-driver
@@ -0,0 +1,798 @@
+#!/usr/bin/env perl
+#
+# This file is part of qtest.
+#
+# Copyright 1993-2007, Jay Berkenbilt
+#
+# QTest is distributed under the terms of version 2.0 of the Artistic
+# license which may be found in the source distribution.
+#
+require 5.008;
+BEGIN { $^W = 1; }
+use strict;
+use IO::Handle;
+use IO::File;
+use IO::Socket;
+use Cwd 'abs_path';
+use Cwd;
+use Config;
+use File::Copy;
+use File::Basename;
+use File::Spec;
+
+my $whoami = basename($0);
+my $dirname = dirname(abs_path($0));
+my $cwd = getcwd();
+my $top = dirname($dirname);
+my $module_dir = "$top/module";
+my $qtc_dir = "$top/QTC/perl";
+
+unshift(@INC, $module_dir, $qtc_dir);
+require QTC;
+require TestDriver;
+
+if ((@ARGV == 1) && ($ARGV[0] eq '--version'))
+{
+    print "$whoami version 1.1\n";
+    exit 0;
+}
+if ((@ARGV == 1) && ($ARGV[0] eq '--print-path'))
+{
+    print $top, "\n";
+    exit 0;
+}
+
+my @bindirs = ();
+my $datadir = undef;
+my $covdir = '.';
+my $stdout_tty = (-t STDOUT) ? "1" : "0";
+
+while (@ARGV)
+{
+    my $arg = shift(@ARGV);
+    if ($arg eq '-bindirs')
+    {
+	usage() unless @ARGV;
+	push(@bindirs, split(':', shift(@ARGV)));
+    }
+    elsif ($arg eq '-datadir')
+    {
+	usage() unless @ARGV;
+	$datadir = shift(@ARGV);
+    }
+    elsif ($arg eq '-covdir')
+    {
+	usage() unless @ARGV;
+	$covdir = shift(@ARGV);
+    }
+    elsif ($arg =~ m/^-stdout-tty=([01])$/)
+    {
+	$stdout_tty = $1;
+    }
+    else
+    {
+	usage();
+    }
+}
+usage() unless defined($datadir);
+if (@bindirs)
+{
+    my @path = ();
+    foreach my $d (@bindirs)
+    {
+	my $abs = abs_path($d) or
+	    fatal("can't canonicalize path to bindir $d: $!");
+	push(@path, $abs);
+    }
+    my $path = join(':', @path) . ':' . $ENV{'PATH'};
+    # Delete and explicitly recreate the PATH environment variable.
+    # This seems to be more reliable.  If we just reassign, in some
+    # cases, the modified environment is not inherited by the child
+    # process.  (This happens when qtest-driver is invoked from ant
+    # running from gjc-compat.  I have no idea how or why.)
+    delete $ENV{'PATH'};
+    $ENV{'PATH'} = $path;
+}
+
+if ($stdout_tty)
+{
+    TestDriver::get_tty_features();
+}
+
+my $pid = undef;
+my $pid_cleanup = new TestDriver::PidKiller(\$pid);
+
+# $in_testsuite is whether the test driver itself is being run from a
+# test suite!  Check before we set the environment variable.
+my $in_testsuite = $ENV{'IN_TESTSUITE'} || 0;
+
+$ENV{'IN_TESTSUITE'} = 1;
+
+# Temporary path is intended to be easy to locate so its contents can
+# be inspected by impatient test suite runners.  It is not intended to
+# be a "secure" (unpredictable) path.
+my $tempdir = File::Spec->tmpdir() . "/testtemp.$$";
+
+my $file_cleanup = new TestDriver::TmpFileDeleter([$tempdir]);
+
+$| = 1;
+$SIG{'PIPE'} = 'IGNORE';
+$SIG{'INT'} = $SIG{'HUP'} = $SIG{'TERM'} = $SIG{'QUIT'} = sub { exit 2 };
+
+TestDriver::rmrf($tempdir);
+fatal("removal of $tempdir failed") if -e "$tempdir";
+
+mkdir($tempdir, 0777) || die "mkdir $tempdir: $!\n";
+$tempdir = abs_path($tempdir) or
+    fatal("can't canonicalize path to $tempdir: $!");
+
+my $errors = 0;
+
+my $tc_input = undef;
+my $tc_scope = undef;
+my @testcov = (<$covdir/*.testcov>);
+if (@testcov > 1)
+{
+    fatal("more than one testcov file exists");
+}
+elsif (@testcov)
+{
+    &QTC::TC("testdriver", "coverage directory",
+	     ($covdir eq '.' ? 1 : 0));
+    $tc_input = $testcov[0];
+    $tc_input =~ s,^\./,,;
+    $tc_scope = basename($tc_input);
+    $tc_scope =~ s/\.testcov$// or
+	fatal("can't get scope from testcov filename");
+}
+
+my $testlogfile = 'qtest.log';
+my $testxmlfile = 'qtest-results.xml';
+unlink $testlogfile;
+unlink $testxmlfile;
+
+my $totmissing = 0;
+my $totextra = 0;
+my $tottests = 0;
+my $totpasses = 0;
+my $totfails = 0;
+my $totxpasses = 0;
+my $totxfails = 0;
+
+my $now = ($in_testsuite ? '---timestamp---' : localtime(time));
+my $msg = "STARTING TESTS on $now";
+print "\n";
+print_and_log(('*' x length($msg)) . "\n$msg\n" .
+	      ('*' x length($msg)) . "\n\n");
+
+my $tc_log = undef;
+my $tc_winlog = undef;
+my %tc_cases = ();
+my %tc_ignored_scopes = ();
+parse_tc_file();
+tc_do_initial_checks();
+
+my $tests_to_run;
+defined($tests_to_run = $ENV{"TESTS"}) or $tests_to_run = "";
+my @tests = ();
+if ($tests_to_run ne "")
+{
+    @tests = split(/\s+/, $tests_to_run);
+    for (@tests)
+    {
+	&QTC::TC("testdriver", "driver tests specified");
+	$_ = "$datadir/$_.test";
+    }
+}
+else
+{
+    &QTC::TC("testdriver", "driver tests not specified");
+    @tests = <$datadir/*.test>;
+}
+
+print_xml("<?xml version=\"1.0\"?>\n" .
+	  "<qtest-results version=\"1\" timestamp=\"$now\"");
+if (defined $tc_log)
+{
+    print_xml(" coverage-scope=\"$tc_scope\"");
+}
+print_xml(">\n");
+foreach my $test (@tests)
+{
+    print_and_log("\nRunning $test\n");
+    print_xml(" <testsuite file=\"$test\">\n");
+    my @results = run_test($test);
+    if (scalar(@results) != 5)
+    {
+	error("test driver $test returned invalid results");
+    }
+    else
+    {
+	my ($ntests, $passes, $fails, $xpasses, $xfails) = @results;
+	my $actual = $passes + $fails + $xpasses + $xfails;
+	my $extra = 0;
+	my $missing = 0;
+	if ($actual > $ntests)
+	{
+	    &QTC::TC("testdriver", "driver extra tests");
+	    my $n = ($actual - $ntests);
+	    print_and_log(sprintf("\n*** WARNING: saw $n extra test%s\n\n",
+				  ($n == 1 ? "" : "s")));
+	    $extra = $n;
+	}
+	elsif ($actual < $ntests)
+	{
+	    &QTC::TC("testdriver", "driver missing tests");
+	    my $n = ($ntests - $actual);
+	    print_and_log(sprintf("\n*** WARNING: missing $n test%s\n\n",
+				  ($n == 1 ? "" : "s")));
+	    $missing = $n;
+	}
+
+	$totmissing += $missing;
+	$totextra += $extra;
+	$totpasses += $passes;
+	$totfails += $fails;
+	$totxpasses += $xpasses;
+	$totxfails += $xfails;
+	$tottests += ($passes + $fails + $xpasses + $xfails);
+
+	my $passed = (($extra == 0) && ($missing == 0) &&
+		      ($fails == 0) && ($xpasses == 0));
+
+	print_xml("  <testsummary\n" .
+		  "   overall-outcome=\"" .($passed ? 'pass' : 'fail') . "\"\n".
+		  "   total-cases=\"$actual\"\n" .
+		  "   passes=\"$passes\"\n" .
+		  "   failures=\"$fails\"\n" .
+		  "   unexpected-passes=\"$xpasses\"\n" .
+		  "   expected-failures=\"$xfails\"\n" .
+		  "   missing-cases=\"$missing\"\n" .
+		  "   extra-cases=\"$extra\"\n");
+	print_xml("  />\n");
+    }
+    print_xml(" </testsuite>\n");
+}
+
+my $coverage_okay = 1;
+tc_do_final_checks();
+
+my $okay = ((($totpasses + $totxfails) == $tottests) &&
+	    ($errors == 0) && ($totmissing == 0) && ($totextra == 0) &&
+	    ($coverage_okay));
+
+print "\n";
+print_and_pad("Overall test suite");
+if ($okay)
+{
+    &QTC::TC("testdriver", "driver overall pass");
+    print_results(pass(), pass());
+}
+else
+{
+    &QTC::TC("testdriver", "driver overall fail");
+    print_results(fail(), pass());
+    print "\nFailure summary may be found in $testlogfile\n";
+}
+
+my $summary = "\nTESTS COMPLETE.  Summary:\n\n";
+$summary .=
+    sprintf("Total tests: %d\n" .
+	    "Passes: %d\n" .
+	    "Failures: %d\n" .
+	    "Unexpected Passes: %d\n" .
+	    "Expected Failures: %d\n" .
+	    "Missing Tests: %d\n" .
+	    "Extra Tests: %d\n",
+	    $tottests, $totpasses, $totfails, $totxpasses, $totxfails,
+	    $totmissing, $totextra);
+
+print_and_log($summary);
+print "\n";
+
+print_xml(" <testsummary\n" .
+	  "  overall-outcome=\"" . ($okay ? 'pass' : 'fail') . "\"\n" .
+	  "  total-cases=\"$tottests\"\n" .
+	  "  passes=\"$totpasses\"\n" .
+	  "  failures=\"$totfails\"\n" .
+	  "  unexpected-passes=\"$totxpasses\"\n" .
+	  "  expected-failures=\"$totxfails\"\n" .
+	  "  missing-cases=\"$totmissing\"\n" .
+	  "  extra-cases=\"$totextra\"\n");
+if (defined $tc_log)
+{
+    print_xml("  coverage-outcome=\"" .
+	      ($coverage_okay ? 'pass' : 'fail') . "\"\n");
+}
+print_xml(" />\n" .
+	  "</qtest-results>\n");
+
+exit ($okay ? 0 : 2);
+
+sub run_test
+{
+    my $prog = shift;
+    my @results = ();
+
+    # Open a socket for communication with subsidiary test drivers.
+    # Exchange some handshaking information over this socket.  When
+    # the subsidiary test suite exits, it reports its results over the
+    # socket.
+
+    my $use_socketpair = (defined $Config{d_sockpair});
+    if ($Config{'osname'} eq 'cygwin')
+    {
+	$use_socketpair = 0;
+    }
+
+    my $listensock;
+    my $for_parent;
+    my $for_child;
+
+    my @comm_args = ();
+
+    if ($use_socketpair)
+    {
+	socketpair($for_child, $for_parent, AF_UNIX, SOCK_STREAM, PF_UNSPEC)
+	    or fatal("socketpair: $!");
+	my $fd = fileno($for_child);
+	close($for_child);
+	close($for_parent);
+	local $^F = $fd; # prevent control fd from being closed on exec
+	socketpair($for_child, $for_parent, AF_UNIX, SOCK_STREAM, PF_UNSPEC)
+	    or fatal("socketpair: $!");
+	if (fileno($for_child) != $fd)
+	{
+	    fatal("FOR_CHILD socket has wrong file descriptor number: got " .
+		  fileno($for_child) . "; wanted $fd");
+	}
+	$for_parent->autoflush(1);
+	$for_child->autoflush(1);
+	binmode $for_parent;
+	binmode $for_child;
+	@comm_args = ('-fd', $fd);
+    }
+    else
+    {
+	$listensock = IO::Socket::INET->new(
+	    Listen => 1, Proto => 'tcp', LocalPort => 0) or
+	    fatal("listen: $!");
+	my ($s_port, $s_addr) = unpack_sockaddr_in($listensock->sockname());
+	@comm_args = ('-port', $s_port);
+    }
+
+    my $pid = fork;
+    fatal("fork failed: $!") unless defined $pid;
+    if ($pid == 0)
+    {
+	if ($use_socketpair)
+	{
+	    close($for_parent);
+	}
+	chdir($datadir) or fatal("chdir $datadir failed: $!");
+
+	if (defined $tc_log)
+	{
+	    # Set these environment variables in the child process so
+	    # that we can actually use the coverage system
+	    # successfully to test the test driver itself.
+	    $ENV{'TC_SCOPE'} = $tc_scope;
+	    $ENV{'TC_FILENAME'} = $tc_log;
+	    if (defined $tc_winlog)
+	    {
+		$ENV{'TC_WIN_FILENAME'} = $tc_winlog;
+	    }
+	}
+
+	# Clear this environment variable so that nested test suites
+	# don't inherit the value from this test suite.  Note that as
+	# of perl 5.8.7 in cygwin, deleting an environment variable
+	# doesn't work.
+	$ENV{'TESTS'} = "";
+
+	exec +('perl', '-I', $module_dir, '-I', $qtc_dir,
+	       basename($prog),
+	       @comm_args,
+	       '-origdir', $cwd,
+	       '-tempdir', $tempdir,
+	       '-testlog', "$cwd/$testlogfile",
+	       '-testxml', "$cwd/$testxmlfile",
+	       "-stdout-tty=$stdout_tty") or
+		   fatal("exec $prog failed: $!");
+    }
+    if ($use_socketpair)
+    {
+	close($for_child);
+    }
+    else
+    {
+	$for_parent = $listensock->accept() or die $!;
+	$for_parent->autoflush();
+	$listensock->close();
+    }
+
+    eval
+    {
+	# Either CHLD or PIPE here indicates premature exiting of
+	# subsidiary process which will be detected by either a
+	# protocol error or a timeout on the select below.
+	local $SIG{'CHLD'} = local $SIG{'PIPE'} = 'IGNORE';
+	print $for_parent "TEST_DRIVER 1\n"
+	    or die "--child--\n";
+	my $rin = '';
+	vec($rin, fileno($for_parent), 1) = 1;
+	my $nfound = select($rin, '', '', 5);
+	if ($nfound == 0)
+	{
+	    fatal("timed out waiting for input on $for_parent");
+	}
+	# Setting to DEFAULT should be unnecessary because of "local"
+	# above, but there seems to be a race condition that this
+	# helps to correct.
+	$SIG{'CHLD'} = $SIG{'PIPE'} = 'DEFAULT';
+    };
+    if ($@)
+    {
+	if ($@ =~ m/--child--/)
+	{
+	    error("subsidiary test driver exited");
+	}
+	else
+	{
+	    die $@;
+	}
+    }
+    else
+    {
+	my $line = <$for_parent>;
+	if (! ((defined $line) && ($line =~ m/^TEST_DRIVER_CLIENT 1$/)))
+	{
+	    error("invalid protocol with subdiary test driver");
+	    kill 1, $pid;
+	}
+	waitpid $pid, 0;
+	my $results = <$for_parent>;
+	close($for_parent);
+	if (! ((defined $results) && ($results =~ m/^\d+(?: \d+){4}$/)))
+	{
+	    &QTC::TC("testdriver", "driver test returned invalid results");
+	    error("invalid results from subsidiary test driver");
+	}
+	else
+	{
+	    @results = split(/ /, $results);
+	}
+    }
+    @results;
+}
+
+sub parse_tc_file
+{
+    return unless defined $tc_input;
+
+    my $tc = new IO::File("<$tc_input") or fatal("can't read $tc_input: $!");
+    while (<$tc>)
+    {
+	s/\r?\n$//s;
+	next if m/^\#/;
+	next if m/^\s*$/;
+	if (m/^ignored-scope: (\S+)$/)
+	{
+	    $tc_ignored_scopes{$1} = 1;
+	}
+	elsif (m/^\s*?(\S.+?)\s+(\d+)$/)
+	{
+	    my ($case, $n) = ($1, $2);
+	    if (exists $tc_cases{$case})
+	    {
+		&QTC::TC("testdriver", "driver duplicate coverage case");
+		error("$tc_input:$.: duplicate case");
+	    }
+	    $tc_cases{$case} = $n;
+	}
+	else
+	{
+	    error("$tc_input:$.: invalid syntax");
+	}
+    }
+    $tc->close();
+}
+
+sub tc_do_initial_checks
+{
+    return unless defined $tc_input;
+
+    if (! exists $ENV{'TC_SRCS'})
+    {
+	fatal("TC_SRCS must be set");
+    }
+
+    my @tc_srcs = (grep { m/\S/ } (split(/\s+/, $ENV{'TC_SRCS'})));
+
+    my %seen_cases = ();
+    foreach my $src (@tc_srcs)
+    {
+	my $s = new IO::File("<$src") or die "$whoami: open $src: $!\n";
+	binmode $s;
+	while (<$s>)
+	{
+	    # Look for coverage calls in the source subject to certain
+	    # lexical constraints
+	    my ($lscope, $case);
+	    if (m/^\s*\&?QTC(?:::|\.)TC\(\"([^\"]+)\",\s*\"([^\"]+)\"/)
+	    {
+		# C++, Java, Perl, etc.
+		($lscope, $case) = ($1, $2);
+	    }
+	    elsif (m/^[^\#]*\$\(call QTC.TC,([^,]+),([^,\)]+)/)
+	    {
+		# make
+		($lscope, $case) = ($1, $2);
+	    }
+	    if ((defined $lscope) && (defined $case))
+	    {
+		if ($lscope eq $tc_scope)
+		{
+		    push(@{$seen_cases{$case}}, [$src, $.]);
+		}
+		elsif (exists $tc_ignored_scopes{$lscope})
+		{
+		    &QTC::TC("testdriver", "driver ignored scope");
+		}
+		else
+		{
+		    &QTC::TC("testdriver", "driver out-of-scope case");
+		    error("$src:$.: out-of-scope coverage case");
+		}
+	    }
+	}
+	$s->close();
+    }
+
+    my %wanted_cases = %tc_cases;
+    foreach my $case (sort keys %seen_cases)
+    {
+	my $wanted = 1;
+	my $whybad = undef;
+	if (exists $wanted_cases{$case})
+	{
+	    delete $wanted_cases{$case};
+	}
+	else
+	{
+	    &QTC::TC("testdriver", "driver unregistered coverage case");
+	    $wanted = 0;
+	    $whybad = "unregistered";
+	}
+	if (scalar(@{$seen_cases{$case}}) > $wanted)
+	{
+	    $whybad = $whybad || "duplicate";
+	    foreach my $d (@{$seen_cases{$case}})
+	    {
+		my ($file, $lineno) = @$d;
+		&QTC::TC("testdriver", "driver coverage error in src",
+			 ($whybad eq 'unregistered' ? 0 :
+			  $whybad eq 'duplicate' ? 1 :
+			  9999));
+		error("$file:$lineno: $whybad coverage case \"$case\"");
+	    }
+	}
+    }
+    foreach my $case (sort keys %wanted_cases)
+    {
+	&QTC::TC("testdriver", "driver unseen coverage case");
+	error("$whoami: coverage case \"$case\" was not seen");
+    }
+
+    fatal("errors detected; exiting") if $errors;
+
+    $tc_log = "$cwd/$tc_scope.cov_out";
+    if ($^O eq 'cygwin')
+    {
+	chop(my $f = `cygpath --windows $tc_log`);
+	$tc_winlog = $f;
+    }
+    unlink $tc_log;
+    print_and_log("Test coverage active in scope $tc_scope\n");
+}
+
+sub tc_do_final_checks
+{
+    return unless (defined $tc_log);
+
+    my %seen_cases = ();
+    my $tc = new IO::File("<$tc_log");
+    if ($tc)
+    {
+	binmode $tc;
+	while (<$tc>)
+	{
+	    s/\r?\n$//s;
+	    next if m/^\#/;
+	    next if m/^\s*$/;
+	    if (m/^(.+) (\d+)$/)
+	    {
+		$seen_cases{$1}{$2} = 1;
+	    }
+	}
+	$tc->close();
+    }
+
+    my $testlog = open_log();
+
+    $testlog->print("\nTest coverage results:\n");
+
+    my @problems = ();
+    foreach my $c (sort keys %tc_cases)
+    {
+	my ($case, $n) = ($c, $tc_cases{$c});
+	for (my $i = 0; $i <= $n; ++$i)
+	{
+	    if (exists $seen_cases{$c}{$i})
+	    {
+		delete $seen_cases{$c}{$i};
+	    }
+	    else
+	    {
+		&QTC::TC("testdriver", "driver missing coverage case");
+		push(@problems, "missing: $c $i");
+	    }
+	}
+    }
+    foreach my $c (sort keys %seen_cases)
+    {
+	foreach my $n (sort { $a <=> $b } (keys %{$seen_cases{$c}}))
+	{
+	    &QTC::TC("testdriver", "driver extra coverage case");
+	    push(@problems, "extra: $c $n");
+	}
+    }
+
+    if (@problems)
+    {
+	my $testxml = open_xml();
+	$testxml->print(" <coverage-errors count=\"" .
+			scalar(@problems) . "\">\n");
+	foreach my $p (@problems)
+	{
+	    $testlog->print("$p\n");
+	    $testxml->print("  <coverage-error case=\"$p\"/>\n");
+	}
+	$testxml->print(" </coverage-errors>\n");
+	$testxml->close();
+	$testlog->print("coverage errors: " . scalar(@problems) . "\n");
+    }
+    my $passed = (@problems == 0);
+    $testlog->print("\nCoverage analysis: ", ($passed ? 'PASSED' : 'FAILED'),
+		    "\n");
+    $testlog->close();
+
+    print "\n";
+    print_and_pad("Coverage analysis");
+    if ($passed)
+    {
+	print_results(pass(), pass());
+	my $passlog = $tc_log;
+	$passlog =~ s/(\.[^\.]+)$/-passed$1/;
+	copy($tc_log, $passlog);
+    }
+    else
+    {
+	$coverage_okay = 0;
+	print_results(fail(), pass());
+    }
+}
+
+sub open_binary
+{
+    my $file = shift;
+    my $fh = new IO::File(">>$file") or fatal("can't open $file: $!");
+    binmode $fh;
+    $fh;
+}
+
+sub open_log
+{
+    open_binary($testlogfile);
+}
+
+sub open_xml
+{
+    open_binary($testxmlfile);
+}
+
+sub print_and_log
+{
+    my $fh = open_log();
+    print @_;
+    print $fh @_;
+    $fh->close();
+}
+
+sub print_xml
+{
+    my $fh = open_xml();
+    print $fh @_;
+    $fh->close();
+}
+
+sub print_and_pad
+{
+    TestDriver::print_and_pad(@_);
+}
+
+sub print_results
+{
+    TestDriver::print_results(@_);
+}
+
+sub pass
+{
+    TestDriver->PASS;
+}
+
+sub fail
+{
+    TestDriver->FAIL;
+}
+
+sub error
+{
+    my $msg = shift;
+    warn $msg, "\n";
+    ++$errors;
+}
+
+sub fatal
+{
+    my $msg = shift;
+    warn "$whoami: $msg\n";
+    exit 2;
+}
+
+sub usage
+{
+    warn "
+Usage: $whoami --print-path
+
+Prints full path to ${whoami}'s installation directory and exits.
+
+ - OR -
+
+Usage: $whoami options
+
+Options include:
+
+  -datadir datadir
+  -bindirs bindir[:bindir...]
+  [ -covdir [coverage-dir] ]
+  [ -stdout-tty=[01] ]
+
+Subsidiary test programs are run with the -bindirs argument (a
+colon-separated list of directories, which may be relative but will be
+internally converted to absolute) prepended to the path and with the
+-datadir argument set as the current working directory.
+
+By default, this program runs datadir/*.test as subsidiary test
+suites.  If the TESTS environment variable is set, it is taken to be a
+space-separated list of test suite names.  For each name n,
+datadir/n.test is run.
+
+Test coverage support is built in.  If a file whose name matches
+*.testcov in the coverage directory (which defaults to \".\") that is
+a valid test coverage file, the full path to the file into which test
+coverage results are written will be placed in the TC_FILENAME
+environment variable.  (If running under cygwin, the Windows path will
+be in TC_WIN_FILENAME.)  The test coverage scope, which is equal to
+the part of the testcov file name excluding the extension, is placed
+in the TC_SCOPE environment variable.
+
+If the -stdout-tty option is passed, its value overrides ${whoami}'s
+determination of whether standard output is a terminal.  This can be
+useful for cases in which another program is invoking ${whoami} and
+passing its output through a pipe to a terminal.
+
+";
+    exit 2;
+
+}
diff --git a/qtest/module/TestDriver.pm b/qtest/module/TestDriver.pm
new file mode 100644
index 00000000..6e1fa313
--- /dev/null
+++ b/qtest/module/TestDriver.pm
@@ -0,0 +1,1566 @@
+# -*- perl -*-
+#
+# This file is part of qtest.
+#
+# Copyright 1993-2007, Jay Berkenbilt
+#
+# QTest is distributed under the terms of version 2.0 of the Artistic
+# license which may be found in the source distribution.
+#
+
+# Search for "PUBLIC METHODS" to find the public methods and
+# documentation on how to use them.
+
+require 5.008;
+use strict;
+
+package TestDriver::PidKiller;
+
+use vars qw($f_pid);
+$f_pid = 'pid';
+
+sub new
+{
+    my $class = shift;
+    my $rep = +{+__PACKAGE__ => {} };
+    $rep->{+__PACKAGE__}{$f_pid} = shift;
+    bless $rep, $class;
+}
+
+sub DESTROY
+{
+    my $rep = shift;
+    my $pid = $rep->{+__PACKAGE__}{$f_pid};
+    defined($$pid) && $$pid && kill 15, $$pid;
+}
+
+package TestDriver::TmpFileDeleter;
+
+use vars qw($f_files);
+$f_files = 'files';
+
+sub new
+{
+    my $class = shift;
+    my $rep = +{+__PACKAGE__ => {} };
+    $rep->{+__PACKAGE__}{$f_files} = shift;
+    bless $rep, $class;
+}
+
+sub DESTROY
+{
+    local $?;
+    my $rep = shift;
+    my $files = ($rep->{+__PACKAGE__}{$f_files});
+    map { TestDriver::rmrf($_) } @$files;
+}
+
+package TestDriver;
+
+use IO::Handle;
+use IO::File;
+use IO::Socket;
+use IO::Select;
+use POSIX ':sys_wait_h';
+use File::Copy;
+use File::Find;
+use Carp;
+use Cwd;
+require QTC;
+
+# Constants
+
+# Possible test case outcomes
+use constant PASS => 'PASS';
+use constant FAIL => 'FAIL';
+
+# Input/Output keys
+use constant STRING => 'STRING';
+use constant FILE => 'FILE';
+use constant COMMAND => 'COMMAND';
+use constant FILTER => 'FILTER';
+use constant REGEXP => 'REGEXP';
+use constant EXIT_STATUS => 'EXIT_STATUS';
+use constant THREAD_DATA => 'THREAD_DATA';
+use constant TD_THREADS => 'TD_THREADS';
+use constant TD_SEQGROUPS => 'TD_SEQGROUPS';
+
+# Flags
+use constant NORMALIZE_NEWLINES =>   1 << 0;
+use constant NORMALIZE_WHITESPACE => 1 << 1;
+use constant EXPECT_FAILURE =>       1 << 2;
+
+# Field names
+use vars qw($f_socket $f_origdir $f_tempdir $f_testlog $f_testxml $f_suitename);
+$f_socket = 'socket';
+$f_origdir = 'origdir';
+$f_tempdir = 'tempdir';
+$f_testlog = 'testlog';
+$f_testxml = 'testxml';
+$f_suitename = 'suitename';
+
+use vars qw($f_passes $f_fails $f_xpasses $f_xfails $f_testnum);
+$f_passes = 'passes';		# expected passes
+$f_fails = 'fails';		# unexpected failures
+$f_xpasses = 'xpasses';		# unexpected passes
+$f_xfails = 'xfails';		# expected failures
+$f_testnum = 'testnum';
+
+# Static Variables
+
+# QTEST_MARGIN sets the number of spaces to after PASSED or FAILED and
+# before the rightmost column of the screen.
+my $margin = $ENV{'QTEST_MARGIN'} || 8;
+$margin += $ENV{'QTEST_EXTRA_MARGIN'} || 0;
+
+my $ncols = 80;
+
+my $color_reset = "";
+my $color_green = "";
+my $color_yellow = "";
+my $color_red = "";
+my $color_magenta = "";
+my $color_emph = "";
+
+sub get_tty_features
+{
+    my $got_size = 0;
+    eval
+    {
+	require Term::ReadKey;
+	($ncols, undef, undef, undef) = Term::ReadKey::GetTerminalSize();
+	$got_size = 1;
+    };
+    if (! $got_size)
+    {
+	eval
+	{
+	    # Get screen columns if possible
+	    no strict;
+	    local $^W = 0;
+	    local *X;
+	    require 'sys/ioctl.ph';
+	    if ((defined &TIOCGWINSZ) && open(X, "+</dev/tty"))
+	    {
+		my $winsize = "";
+		if (ioctl(X, &TIOCGWINSZ, $winsize))
+		{
+		    (undef, $ncols) = unpack('S4', $winsize);
+		    $got_size = 1;
+		}
+		close(X);
+	    }
+	};
+    }
+    eval
+    {
+	require Term::ANSIColor;
+	$color_reset = Term::ANSIColor::RESET();
+	$color_green = Term::ANSIColor::GREEN();
+	$color_yellow = Term::ANSIColor::YELLOW();
+	$color_red = Term::ANSIColor::RED();
+	$color_magenta = Term::ANSIColor::MAGENTA();
+	$color_emph = Term::ANSIColor::color('bold blue on_black');
+    };
+}
+
+# Static Methods
+
+sub print_and_pad
+{
+    my $str = shift;
+    my $spaces = $ncols - 10 - length($str) - $margin;
+    $spaces = 0 if $spaces < 0;
+    print $str . (' ' x $spaces) . ' ... ';
+}
+
+sub print_results
+{
+    my ($outcome, $exp_outcome) = @_;
+
+    my $color = "";
+    my $outcome_text;
+    if ($outcome eq $exp_outcome)
+    {
+	if ($outcome eq PASS)
+	{
+	    &QTC::TC("testdriver", "TestDriver expected pass");
+	    $color = $color_green;
+	    $outcome_text = "PASSED";
+	}
+	else
+	{
+	    &QTC::TC("testdriver", "TestDriver expected fail");
+	    $color = $color_yellow;
+	    # " (exp)" is fewer characters than the default margin
+	    # which keeps this from wrapping lines with default
+	    # settings.
+	    $outcome_text = "FAILED (exp)";
+	}
+    }
+    else
+    {
+	if ($outcome eq PASS)
+	{
+	    &QTC::TC("testdriver", "TestDriver unexpected pass");
+	    $color = $color_magenta;
+	    $outcome_text = "PASSED-UNEXP";
+	}
+	else
+	{
+	    &QTC::TC("testdriver", "TestDriver unexpected fail");
+	    $color = $color_red;
+	    $outcome_text = "FAILED";
+	}
+    }
+
+    print $color, $outcome_text, $color_reset, "\n";
+    $outcome_text;
+}
+
+# Normal Methods
+
+sub new
+{
+    my $class = shift;
+    my $rep = +{+__PACKAGE__ => {} };
+
+    if (@_ != 1)
+    {
+	croak "Usage: ", __PACKAGE__, "->new(\"test-suite name\")\n";
+    }
+    my $suitename = shift;
+
+    if (! ((@ARGV == 11) &&
+	   (($ARGV[0] eq '-fd') || ($ARGV[0] eq '-port')) &&
+	   ($ARGV[2] eq '-origdir') &&
+	   ($ARGV[4] eq '-tempdir') &&
+	   ($ARGV[6] eq '-testlog') &&
+	   ($ARGV[8] eq '-testxml') &&
+	   ($ARGV[10] =~ m/^-stdout-tty=([01])$/) &&
+	   (-d $ARGV[5])))
+    {
+	die +__PACKAGE__, ": improper invocation of test driver $0\n";
+    }
+    my $fd = ($ARGV[0] eq '-fd') ? $ARGV[1] : undef;
+    my $port = ($ARGV[0] eq '-port') ? $ARGV[1] : undef;
+    my $origdir = $ARGV[3];
+    my $tempdir = $ARGV[5];
+    my $testlogfile = $ARGV[7];
+    my $testxmlfile = $ARGV[9];
+    my $testlog = new IO::File(">>$testlogfile");
+    binmode $testlog;
+    my $testxml = new IO::File(">>$testxmlfile");
+    binmode $testxml;
+    $ARGV[10] =~ m/=([01])/ or die +__PACKAGE__, ": INTERNAL ERROR in ARGV[10]";
+    my $stdout_is_tty = $1;
+    if ($stdout_is_tty)
+    {
+	get_tty_features();
+    }
+
+    my $socket;
+    if (defined $fd)
+    {
+	$socket = new IO::Handle;
+	if (! $socket->fdopen($fd, "w+"))
+	{
+	    warn +__PACKAGE__, ": unable to open file descriptor $fd.\n";
+	    warn +__PACKAGE__, " must be created from a program invoked by" .
+		" the test driver system\n";
+	    die +__PACKAGE__, ": initialization failed";
+	}
+    }
+    else
+    {
+	$socket = IO::Socket::INET->new(
+	    PeerAddr => '127.0.0.1', PeerPort => $port) or
+	    die "unable to connect to port $port: $!\n";
+    }
+    $socket->autoflush();
+    binmode $socket;
+
+    # Do some setup that would ordinarily be reserved for a main
+    # program.  We want test suites to behave in a certain way so tha
+    # the overall system works as desired.
+
+    # Killing the driver should cause to to exit.  Without this, it
+    # may cause whatever subsidiary program is being run to exit and
+    # the driver to continue to the next test case.
+    $SIG{'INT'} = $SIG{'HUP'} = $SIG{'TERM'} = $SIG{'QUIT'} = sub { exit 2 };
+
+    # Unbuffer our output.
+    $| = 1;
+
+    $rep->{+__PACKAGE__}{$f_socket} = $socket;
+    $rep->{+__PACKAGE__}{$f_origdir} = $origdir;
+    $rep->{+__PACKAGE__}{$f_tempdir} = $tempdir;
+    $rep->{+__PACKAGE__}{$f_testlog} = $testlog;
+    $rep->{+__PACKAGE__}{$f_testxml} = $testxml;
+    $rep->{+__PACKAGE__}{$f_suitename} = $suitename;
+    $rep->{+__PACKAGE__}{$f_passes} = 0;
+    $rep->{+__PACKAGE__}{$f_fails} = 0;
+    $rep->{+__PACKAGE__}{$f_xpasses} = 0;
+    $rep->{+__PACKAGE__}{$f_xfails} = 0;
+    $rep->{+__PACKAGE__}{$f_testnum} = 1;
+
+    # Do protocol handshaking with the test driver system
+    my $init = scalar(<$socket>);
+    if ($init !~ m/^TEST_DRIVER 1$/)
+    {
+	die +__PACKAGE__, ": incorrect protocol with test driver system\n";
+    }
+    $socket->print("TEST_DRIVER_CLIENT 1\n");
+
+    bless $rep, $class;
+}
+
+sub _socket
+{
+    my $rep = shift;
+    $rep->{+__PACKAGE__}{$f_socket};
+}
+
+sub _tempdir
+{
+    my $rep = shift;
+    $rep->{+__PACKAGE__}{$f_tempdir};
+}
+
+sub _testlog
+{
+    my $rep = shift;
+    $rep->{+__PACKAGE__}{$f_testlog};
+}
+
+sub _testxml
+{
+    my $rep = shift;
+    $rep->{+__PACKAGE__}{$f_testxml};
+}
+
+sub _suitename
+{
+    my $rep = shift;
+    $rep->{+__PACKAGE__}{$f_suitename};
+}
+
+sub _testnum
+{
+    my $rep = shift;
+    $rep->{+__PACKAGE__}{$f_testnum} = $_[0] if @_;
+    $rep->{+__PACKAGE__}{$f_testnum};
+}
+
+# PUBLIC METHODS
+
+# Usage: report(n)
+# Specify the number of tests that are expected to have been run.
+# Please note: the purpose of reporting the number of test cases with
+# "report" is as an extra check to make sure that the test suite
+# itself didn't have a logic error that caused some test cases to be
+# skipped.  The argument to "report" should therefore be a hard-coded
+# number or a number computed only from static features in the test
+# suite.  It should not be a number that is counted up during the
+# process of running the test suite.  Computing this number as a side
+# effect of running test cases would defeat the purpose of the number.
+# For example, if the test suite consists of an array of test cases,
+# and the test suite code iterates through that loop and calls
+# "runtest" twice for each element, it would be reasonable to pass an
+# expression that includes the size of the array as an argument to
+# "report", but it would not be appropriate to have a variable called
+# "$ntests" that is incremented each time "runtest" is called and then
+# passed to "report".
+sub report
+{
+    my $rep = shift;
+    croak "Usage: ", __PACKAGE__, "->report(num-tests-expected)\n"
+	unless @_ && $_[0] =~ m/^\d+$/;
+
+    # Message to test driver system:
+    # n-expected-tests passes fails unexpected-passes expected-fails
+
+    my @vals = (shift);
+    push(@vals, map { $rep->{+__PACKAGE__}{$_} } ($f_passes, $f_fails,
+						  $f_xpasses, $f_xfails));
+    my $socket = $rep->_socket();
+    $socket->print(join(' ', @vals)), "\n";
+}
+
+# Usage: notify(string)
+# Prints the string followed by a newline to standard output of the
+# test suite.
+sub notify
+{
+    my $rep = shift;
+    my $msg = shift;
+    &QTC::TC("testdriver", "TestDriver notify");
+    print $msg, "\n";
+}
+
+# Usage: emphasize(string)
+# Prints the string followed by a newline to standard output of the
+# test suite.  The string is printed with emphasis if the terminal
+# supports color.
+sub emphasize
+{
+    my $rep = shift;
+    my $msg = shift;
+    &QTC::TC("testdriver", "TestDriver emphasize");
+    print $color_emph, $msg, $color_reset, "\n";
+}
+
+# Usage: prompt(msg, env, default)
+# If the environment variable "env" is set, its value is returned.
+# Otherwise, if STDIN is a tty, the user is prompted for an answer
+# using msg as the prompt, or if STDIN is not a tty, the value
+# specified in "default" is returned.  Note that careless use of
+# prompt in test suites may make the test suites unable to be run in
+# batch mode.
+sub prompt
+{
+    my $rep = shift;
+    my ($msg, $env, $default) = @_;
+    &QTC::TC("testdriver", "TestDriver prompt");
+    my $answer = $ENV{$env};
+    if (defined $answer)
+    {
+	print "$msg\n";
+	print "[Question answered from environment variable \$$env: $answer]\n";
+    }
+    else
+    {
+	print "To avoid question, place answer in" .
+	    " environment variable \$$env\n";
+	if (-t STDIN)
+	{
+	    print "$msg ";
+	    chop($answer = <STDIN>);
+	    if ($answer eq '')
+	    {
+		print "[Using default answer for question: $default]\n";
+		$answer = $default;
+	    }
+	}
+	else
+	{
+	    print "$msg\n";
+	    print "[Using default answer for question: $default]\n";
+	    $answer = $default;
+	}
+    }
+    $answer;
+}
+
+# Usage: get_start_dir()
+# Returns the name of the directory from which the test driver was
+# originally invoked.  This can be useful for test suites that are
+# designed to be run from read-only areas or from multiple locations
+# simultaneously: they can get the original invocation directory and
+# use it as a place to write temporary files.
+sub get_start_dir
+{
+    my $rep = shift;
+    $rep->{+__PACKAGE__}{$f_origdir};
+}
+
+# Usage: runtest description input output [ flags ]
+# Returns true iff test passes; i.e., input matches output
+
+# Parameters:
+
+#   description: a short textual description of the test case
+
+#   input: a hash reference that defines the input to the test case
+#   input keys and associated values:
+
+#      STRING: a string that is used verbatim as the test input
+
+#      FILE: a file whose contents are used as the test input
+
+#      COMMAND: an array reference containing a command and arguments
+#      or a string representing the command.  This is passed to exec,
+#      so the rules that exec uses to determine whether to pass this
+#      to a shell are followed.  The command is run with STDIN set to
+#      /dev/null, STDOUT redirected to an internal file, and STDERR
+#      copied to STDOUT.
+
+#      Note that exactly one of STRING, FILE, or COMMAND must appear.
+
+#      FILTER: if specified, it is a program that is run on the test
+#      input specified above to generate the true test input.
+
+#   output: a hash reference that defines the expected output of the
+#   test case
+
+#      STRING: a string that contains the expected test output
+
+#      FILE: a file that contains the expected test output
+
+#      REGEXP: a regular expression that must match the test output
+
+#      Note that exactly one of STRING, FILE, or REGEXP must appear.
+
+#      EXIT_STATUS: the exit status of the command.  Required iff the
+#      intput is specified by COMMAND.  A value of undef means that we
+#      don't care about the exit status of a command.  An integer
+#      value is the ordinary exit status of a command.  A string of
+#      the form SIG:n indicates that the program has exited with
+#      signal n.
+
+#      THREAD_DATA: If specified, the test output is expected to
+#      contain multithreaded output with output lines marked by thread
+#      and sequence group identifiers.  The value must be a hash that
+#      contains required key TD_THREADS and optional key TD_SEQGROUPS.
+#      The value of each key is an array reference containing a list
+#      of threads or sequence groups as appropriate.  When THREAD_DATA
+#      is specified, the single call to runtest actually generates t +
+#      s + 3 tests where "t" is the number of threads and "s" is the
+#      number of sequence groups specified.  See the documentation for
+#      full details on how multithreaded output is handled by the test
+#      driver.
+
+#   flags: additional flags to control the test case; should be
+#   logically orred together (e.g. NORMALIZE_WHITESPACE | EXPECT_FAILURE)
+
+#      NORMALIZE_NEWLINES: If specified, all newlines or carriage
+#      return/newline combinations in the input are translated to
+#      straight UNIX-style newlines.  This is done before writing
+#      through any filter.  Newlines are also normalized in the
+#      expected output.
+
+#      NORMALIZE_WHITESPACE: If specified, all carriage returns are
+#      removed, and all strings of one or more space or tab characters
+#      are replaced by a single space character in the input.  This is
+#      done before writing through any filter.  The expected output
+#      must be normalized in this way as well in order for the test to
+#      pass.
+
+#      EXPECT_FAILURE: If specified, the test case is expected to
+#      fail.  In this case, a test case failure will not generate
+#      verbose output or cause overall test suite failure, and a pass
+#      will generate test suite failure.  This should be used for
+#      place-holder test cases that exercise a known bug that cannot
+#      yet be fixed.
+
+sub runtest
+{
+    my $rep = shift;
+
+    if (! ((@_ == 3) || (@_ == 4)))
+    {
+	croak +("Usage: ", +__PACKAGE__,
+		"->runtest(description, input, output[, flags])\n");
+    }
+
+    my ($description, $input, $output, $flags) = @_;
+    $flags = 0 unless defined $flags;
+
+    my $tempdir = $rep->_tempdir();
+
+    if (ref($description) ne '')
+    {
+	&QTC::TC("testdriver", "TestDriver description not string");
+	croak +__PACKAGE__, "->runtest: description must be a string\n";
+    }
+    if (ref($input) ne 'HASH')
+    {
+	&QTC::TC("testdriver", "TestDriver input not hash");
+	croak +__PACKAGE__, "->runtest: input must be a hash reference\n";
+    }
+    if (ref($output) ne 'HASH')
+    {
+	&QTC::TC("testdriver", "TestDriver output not hash");
+	croak +__PACKAGE__, "->runtest: output must be a hash reference\n";
+    }
+    if ((ref($flags) ne '') || ($flags !~ m/^\d+$/))
+    {
+	&QTC::TC("testdriver", "TestDriver flags not integer");
+	croak +__PACKAGE__, "->runtest: flags must be an integer\n";
+    }
+
+    my ($extra_in_keys, $in_string, $in_file, $in_command, $in_filter) =
+	check_hash_keys($input, $rep->STRING,
+			$rep->FILE, $rep->COMMAND, $rep->FILTER);
+    if ($extra_in_keys)
+    {
+	&QTC::TC("testdriver", "TestDriver extraneous input keys");
+	croak +(+__PACKAGE__,
+		"->runtest: extraneous keys in intput hash: $extra_in_keys\n");
+    }
+    my ($extra_out_keys, $out_string, $out_file, $out_regexp,
+	$out_exit_status, $thread_data) =
+	    check_hash_keys($output, $rep->STRING,
+			    $rep->FILE, $rep->REGEXP, $rep->EXIT_STATUS,
+			    $rep->THREAD_DATA);
+    if ($extra_out_keys)
+    {
+	&QTC::TC("testdriver", "TestDriver extraneous output keys");
+	croak +(+__PACKAGE__,
+		"->runtest: extraneous keys in output hash: $extra_out_keys\n");
+    }
+
+    if ((((defined $in_string) ? 1 : 0) +
+	 ((defined $in_file) ? 1 : 0) +
+	 ((defined $in_command) ? 1 : 0)) != 1)
+    {
+	&QTC::TC("testdriver", "TestDriver invalid input");
+	croak +__PACKAGE__, "->runtest: exactly one of" .
+	    " STRING, FILE, or COMMAND must be present for input\n";
+    }
+    if ((((defined $out_string) ? 1 : 0) +
+	 ((defined $out_file) ? 1 : 0) +
+	 ((defined $out_regexp) ? 1 : 0)) != 1)
+    {
+	&QTC::TC("testdriver", "TestDriver invalid output");
+	croak +__PACKAGE__, "->runtest: exactly one of" .
+	    " STRING, FILE, or REGEXP must be present for output\n";
+    }
+    if ((defined $in_command) != (exists $output->{$rep->EXIT_STATUS}))
+    {
+	&QTC::TC("testdriver", "TestDriver invalid status");
+	croak +__PACKAGE__, "->runtest: input COMMAND and output EXIT_STATUS"
+	    . " must either both appear both not appear\n";
+    }
+
+    my ($threads, $seqgroups) = (undef, undef);
+    if (defined $thread_data)
+    {
+	if (ref($thread_data) ne 'HASH')
+	{
+	    &QTC::TC("testdriver", "TestDriver thread_data not hash");
+	    croak +__PACKAGE__, "->runtest: THREAD_DATA" .
+		" must be a hash reference\n";
+	}
+	my $extra_thread_keys;
+	($extra_thread_keys, $threads, $seqgroups) =
+	    check_hash_keys($thread_data, $rep->TD_THREADS, $rep->TD_SEQGROUPS);
+	if ($extra_thread_keys)
+	{
+	    &QTC::TC("testdriver", "TestDriver extraneous thread_data keys");
+	    croak +(+__PACKAGE__,
+		    "->runtest: extraneous keys in THREAD_DATA hash:" .
+		    " $extra_thread_keys\n");
+	}
+	if (! defined $threads)
+	{
+	    &QTC::TC("testdriver", "TestDriver thread_data no threads");
+	    croak +__PACKAGE__, "->runtest: THREAD_DATA" .
+		" must contain TD_THREADS\n";
+	}
+	elsif (ref($threads) ne 'ARRAY')
+	{
+	    &QTC::TC("testdriver", "TestDriver threads not array ref");
+	    croak +__PACKAGE__, "->runtest: TD_THREADS" .
+		" must be an array reference\n";
+	}
+	if ((defined $seqgroups) && (ref($seqgroups) ne 'ARRAY'))
+	{
+	    &QTC::TC("testdriver", "TestDriver seqgroups not array ref");
+	    croak +__PACKAGE__, "->runtest: TD_SEQGROUPS" .
+		" must be an array reference\n";
+	}
+    }
+
+    # testnum is incremented by print_testid
+    my $testnum = $rep->_testnum();
+    my $category = $rep->_suitename();
+    $rep->print_testid($description);
+
+    # Open a file handle to read the raw (unfiltered) test input
+    my $pid = undef;
+    my $pid_killer = new TestDriver::PidKiller(\$pid);
+    my $in = new IO::Handle;
+    if (defined $in_string)
+    {
+	&QTC::TC("testdriver", "TestDriver input string");
+	open($in, '<', \$in_string) or
+	    die +(+__PACKAGE__,
+		  "->runtest: unable to read from input string: $!\n");
+    }
+    elsif (defined $in_file)
+    {
+	&QTC::TC("testdriver", "TestDriver input file");
+	open($in, '<', $in_file) or
+	    croak +(+__PACKAGE__,
+		    "->runtest: unable to read from input file $in_file: $!\n");
+    }
+    elsif (defined $in_command)
+    {
+	$pid = open($in, "-|");
+	croak +__PACKAGE__, "->runtest: fork failed: $!\n" unless defined $pid;
+	if ($pid == 0)
+	{
+	    # child
+	    open(STDERR, ">&STDOUT");
+	    open(STDIN, '<', \ "");
+	    if (ref($in_command) eq 'ARRAY')
+	    {
+		&QTC::TC("testdriver", "TestDriver input command array");
+		exec @$in_command or
+		    croak+(+__PACKAGE__,
+			   "->runtest: unable to run command ",
+			   join(' ', @$in_command), "\n");
+	    }
+	    else
+	    {
+		&QTC::TC("testdriver", "TestDriver input command string");
+		exec $in_command or
+		    croak+(+__PACKAGE__,
+			   "->runtest: unable to run command ",
+			   $in_command, "\n");
+	    }
+	}
+    }
+    else
+    {
+	die +__PACKAGE__, ": INTERNAL ERROR: invalid test input";
+    }
+    binmode $in;
+
+    # Open file handle into which to write the actual output
+    my $actual = new IO::File;
+    my $actual_file = "$tempdir/actual";
+    if (defined $in_filter)
+    {
+	&QTC::TC("testdriver", "TestDriver filter defined");
+	# Write through filter to actual file
+	open($actual, "| $in_filter > $actual_file") or
+	    croak +(+__PACKAGE__, ": pipe to filter $in_filter failed: $!\n");
+	binmode $actual;
+    }
+    else
+    {
+	&QTC::TC("testdriver", "TestDriver filter not defined");
+	open($actual, ">$actual_file") or
+	    die +(+__PACKAGE__, ": write to $actual_file failed: $!\n");
+	binmode $actual;
+    }
+
+    # Write from input to actual output, normalizing spaces and
+    # newlines if needed
+    my $exit_status = undef;
+    while (1)
+    {
+	my ($line, $status) = read_line($in, $pid);
+	$exit_status = $status if defined $status;
+	last unless defined $line;
+	if ($flags & $rep->NORMALIZE_WHITESPACE)
+	{
+	    &QTC::TC("testdriver", "TestDriver normalize whitespace");
+	    $line =~ s/[ \t]+/ /g;
+	}
+	else
+	{
+	    &QTC::TC("testdriver", "TestDriver no normalize whitespace");
+	}
+	if ($flags & $rep->NORMALIZE_NEWLINES)
+	{
+	    &QTC::TC("testdriver", "TestDriver normalize newlines");
+	    $line =~ s/\r$//;
+	}
+	else
+	{
+	    &QTC::TC("testdriver", "TestDriver no normalize newlines");
+	}
+	$actual->print($line);
+	$actual->flush();
+	last if defined $exit_status;
+    }
+    $in->close();
+    if (defined $in_command)
+    {
+	if (! defined $exit_status)
+	{
+	    $exit_status = $?;
+	}
+	if (($exit_status > 0) && ($exit_status < 256))
+	{
+	    &QTC::TC("testdriver", "TestDriver exit status signal");
+	    $exit_status &= 127; # clear core dump flag
+	    $exit_status = "SIG:$exit_status";
+	}
+	else
+	{
+	    &QTC::TC("testdriver", "TestDriver exit status number");
+	    $exit_status >>= 8;
+	}
+    }
+    $? = 0;
+    $actual->close();
+    $pid = undef;
+    if ($?)
+    {
+	die +(+__PACKAGE__,
+	      "->runtest: failure closing actual output; status = $?\n");
+    }
+
+    # Compare exit statuses.  This expression is always true when the
+    # input was not from a command.
+    my $status_match = ((! defined $out_exit_status) ||
+			((defined $exit_status) &&
+			 ($exit_status eq $out_exit_status)));
+
+    # Compare actual output with expected output.
+    my $expected_file = undef;
+    my $output_match = undef;
+    if (defined $out_string)
+    {
+	&QTC::TC("testdriver", "TestDriver output string");
+	# Write output string to a file so we can run diff
+	$expected_file = "$tempdir/expected";
+	my $e = new IO::File;
+	open($e, ">$expected_file") or
+	    die +(__PACKAGE__,
+		  "->runtest: unable to write to $expected_file: $!\n");
+	binmode $e;
+	$e->print($out_string);
+	$e->close();
+    }
+    elsif (defined $out_file)
+    {
+	&QTC::TC("testdriver", "TestDriver output file");
+	if ($flags & $rep->NORMALIZE_NEWLINES)
+	{
+	    # Normalize newlines in expected output file
+	    $expected_file = "$tempdir/expected";
+	    unlink $expected_file;
+	    my $in = new IO::File;
+	    if (open($in, "<$out_file"))
+	    {
+		binmode $in;
+		my $e = new IO::File;
+		open($e, ">$expected_file") or
+		    die +(__PACKAGE__,
+			  "->runtest: unable to write to $expected_file: $!\n");
+		binmode $e;
+		while (<$in>)
+		{
+		    s/\r?$//;
+		    $e->print($_);
+		}
+		$e->close();
+		$in->close();
+	    }
+	}
+	else
+	{
+	    $expected_file = $out_file;
+	}
+    }
+    elsif (defined $out_regexp)
+    {
+	&QTC::TC("testdriver", "TestDriver output regexp");
+	# No expected file; do regexp test to determine whether output
+	# matches
+	$actual = new IO::File;
+	open($actual, "<$actual_file") or
+	    die +(__PACKAGE__,
+		  "->runtest: unable to read $actual_file: $!\n");
+	binmode $actual;
+	local $/ = undef;
+	my $actual_output = <$actual>;
+	$actual->close();
+	$output_match = ($actual_output =~ m/$out_regexp/);
+    }
+    else
+    {
+	die +__PACKAGE__, ": INTERNAL ERROR: invalid test output";
+    }
+
+    my $output_diff = undef;
+    if (! defined $output_match)
+    {
+	if (! defined $expected_file)
+	{
+	    die +__PACKAGE__, ": INTERNAL ERROR: expected_file not defined";
+	}
+	if (defined $threads)
+	{
+	    # Real output comparisons are done later.
+	    $output_match = 1;
+	}
+	else
+	{
+	    $output_diff = "$tempdir/difference";
+	    my $r = safe_pipe(['diff', '-a', '-u',
+			       $expected_file, $actual_file],
+			      $output_diff);
+	    $output_match = ($r == 0);
+	}
+    }
+
+    my $outcome = ($output_match && $status_match) ? PASS : FAIL;
+    my $exp_outcome = (($flags & $rep->EXPECT_FAILURE) ? FAIL : PASS);
+    my $outcome_text = print_results($outcome, $exp_outcome);
+    my $passed = $rep->update_counters($outcome, $exp_outcome);
+
+    my $testxml = $rep->_testxml();
+    my $testlog = $rep->_testlog();
+    # $outcome_text is for the human-readable.  We need something
+    # different for the xml file.
+    $testxml->print("  <testcase\n" .
+		    "   testid=\"$category $testnum\"\n" .
+		    "   description=\"$description\"\n" .
+		    "   outcome=\"" .
+		    (($outcome eq PASS)
+		     ? ($passed ? "pass" : "unexpected-pass")
+		     : ($passed ? "expected-fail" : "fail")) .
+		    "\"\n");
+
+    if (($outcome eq FAIL) && ($outcome ne $exp_outcome))
+    {
+	# Test failed and failure was not expected
+
+	$testxml->print("  >\n");
+	$testlog->printf("$category test %d (%s) FAILED\n",
+			 $testnum, $description);
+	my $cwd = getcwd();
+	$testlog->print("cwd: $cwd\n");
+	$testxml->print("   <cwd>$cwd</cwd>\n");
+	my $cmd = $in_command;
+	if ((defined $cmd) && (ref($cmd) eq 'ARRAY'))
+	{
+	    $cmd = join(' ', @$cmd);
+	}
+	if (defined $cmd)
+	{
+	    $testlog->print("command: $cmd\n");
+	    $testxml->print("   <command>$cmd</command>\n");
+	}
+	if (defined $out_file)
+	{
+	    # Use $out_file, not $expected_file -- we are only
+	    # interested in dispaying this information if the user's
+	    # real output was original in a file.
+	    $testlog->print("expected output in $out_file\n");
+	    $testxml->print(
+		"   <expected-output-file>$out_file</expected-output-file>\n");
+	}
+
+	# It would be nice if we could filter out internal calls for
+	# times when runtest is called inside of the module for
+	# multithreaded testing.
+	$testlog->print(Carp::longmess());
+
+	$testxml->print("   <stacktrace>test failure" .
+			Carp::longmess() .
+			"</stacktrace>\n");
+
+	if (! $status_match)
+	{
+	    &QTC::TC("testdriver", "TestDriver status mismatch");
+	    $testlog->printf("\tExpected status: %s\n", $out_exit_status);
+	    $testlog->printf("\tActual   status: %s\n", $exit_status);
+	    $testxml->print(
+		"   <expected-status>$out_exit_status</expected-status>\n");
+	    $testxml->print(
+		"   <actual-status>$exit_status</actual-status>\n");
+	}
+	if (! $output_match)
+	{
+	    &QTC::TC("testdriver", "TestDriver output mismatch");
+	    $testlog->print("--> BEGIN EXPECTED OUTPUT <--\n");
+	    $testxml->print("   <expected-output>");
+	    if (defined $expected_file)
+	    {
+		write_file_to_fh($expected_file, $testlog);
+		xml_write_file_to_fh($expected_file, $testxml);
+	    }
+	    elsif (defined $out_regexp)
+	    {
+		$testlog->print("regexp: " . $out_regexp);
+		if ($out_regexp !~ m/\n$/s)
+		{
+		    $testlog->print("\n");
+		}
+		$testxml->print("regexp: " . $out_regexp);
+	    }
+	    else
+	    {
+		die +(+__PACKAGE__,
+		      "->runtest: INTERNAL ERROR: no expected output\n");
+	    }
+	    $testlog->print("--> END EXPECTED OUTPUT <--\n" .
+			    "--> BEGIN ACTUAL OUTPUT <--\n");
+	    $testxml->print("</expected-output>\n" .
+			    "   <actual-output>");
+	    write_file_to_fh($actual_file, $testlog);
+	    xml_write_file_to_fh($actual_file, $testxml);
+	    $testlog->print("--> END ACTUAL OUTPUT <--\n");
+	    $testxml->print("</actual-output>\n");
+	    if (defined $output_diff)
+	    {
+		&QTC::TC("testdriver", "TestDriver display diff");
+		$testlog->print("--> DIFF EXPECTED ACTUAL <--\n");
+		$testxml->print("   <diff-output>");
+		write_file_to_fh($output_diff, $testlog);
+		xml_write_file_to_fh($output_diff, $testxml);
+		$testlog->print("--> END DIFFERENCES <--\n");
+		$testxml->print("</diff-output>\n");
+	    }
+	    else
+	    {
+		&QTC::TC("testdriver", "TestDriver display no diff");
+	    }
+	}
+	$testxml->print("  </testcase>\n");
+    }
+    else
+    {
+	$testxml->print("  />\n");
+    }
+
+    if (defined $threads)
+    {
+	if (! defined $expected_file)
+	{
+	    &QTC::TC("testdriver", "TestDriver thread data but no exp output");
+	    croak +(+__PACKAGE__,
+		    "->runtest: thread data invalid".
+		    " without fixed test output\n");
+	}
+
+	my $thread_expected = "$tempdir/thread-expected";
+	my $thread_actual = "$tempdir/thread-actual";
+	copy($actual_file, $thread_actual);
+	filter_seqgroups($expected_file, $thread_expected);
+
+	$passed =
+	    $rep->analyze_thread_data($description,
+				      $expected_file, $actual_file,
+				      $threads, $seqgroups)
+	    && $passed;
+
+	if ($passed)
+	{
+	    $rep->runtest($description . ": all subcases passed",
+			  {$rep->STRING => ""},
+			  {$rep->STRING => ""});
+	}
+	else
+	{
+	    $rep->runtest($description . ": original output",
+			  {$rep->FILE => $thread_actual},
+			  {$rep->FILE => $thread_expected});
+	}
+
+	unlink $thread_expected, $thread_actual;
+    }
+
+    $passed;
+}
+
+sub read_line
+{
+    my ($fh, $pid) = @_;
+    my $line = undef;
+    my $status = undef;
+
+    if (defined $pid)
+    {
+	# It doesn't work to just call <$fh> in this case.  For some
+	# unknown reason, some programs occasionally exit and cause an
+	# interrupted system call return from read which perl just
+	# ignores, making the call to <$fh> hang.  To protect
+	# ourselves, we explicitly check for the program having exited
+	# periodically if read hasn't returned anything.
+
+	while (1)
+	{
+	    my $s = new IO::Select();
+	    $s->add($fh);
+	    my @ready = $s->can_read(1);
+	    if (@ready == 0)
+	    {
+		if (waitpid($pid, WNOHANG) > 0)
+		{
+		    $status = $?;
+		    last;
+		}
+		next;
+	    }
+	    else
+	    {
+		my $buf = "";
+		my $status = sysread($fh, $buf, 1);
+		if ((defined $status) && ($status == 1))
+		{
+		    $line = "" unless defined $line;
+		    $line .= $buf;
+		    last if $buf eq "\n";
+		}
+		else
+		{
+		    last;
+		}
+	    }
+	}
+    }
+    else
+    {
+	$line = <$fh>;
+    }
+    ($line, $status);
+}
+
+sub write_file_to_fh
+{
+    my ($file, $out) = @_;
+    my $in = new IO::File("<$file");
+    if (defined $in)
+    {
+	binmode $in;
+	my $ended_with_newline = 1;
+	while (<$in>)
+	{
+	    $out->print($_);
+	    $ended_with_newline = m/\n$/s;
+	}
+	if (! $ended_with_newline)
+	{
+	    $out->print("[no newline at end of data]\n");
+	}
+	$in->close();
+    }
+    else
+    {
+	$out->print("[unable to open $file: $!]\n");
+    }
+}
+
+sub xml_write_file_to_fh
+{
+    my ($file, $out) = @_;
+    my $in = new IO::File("<$file");
+    if (defined $in)
+    {
+	binmode $in;
+	while (defined ($_ = <$in>))
+	{
+	    s/\&/\&amp;/g;
+	    s/</&lt;/g;
+	    s/>/&gt;/g;
+	    s/([\000-\011\013-\037\177-\377])/sprintf("&#x%02x;", ord($1))/ge;
+	    $out->print($_);
+	}
+	$in->close();
+    }
+    else
+    {
+	$out->print("[unable to open $file: $!]");
+    }
+}
+
+sub check_hash_keys
+{
+    my ($hash, @keys) = @_;
+    my %actual_keys = ();
+    foreach my $k (keys %$hash)
+    {
+	$actual_keys{$k} = 1;
+    }
+    foreach my $k (@keys)
+    {
+	delete $actual_keys{$k};
+    }
+    my $extra_keys = join(', ', sort (keys %actual_keys));
+    ($extra_keys, (map { $hash->{$_} } @keys));
+}
+
+sub print_testid
+{
+    my $rep = shift;
+    my ($description) = @_;
+
+    my $testnum = $rep->_testnum();
+    my $category = $rep->_suitename();
+    print_and_pad(sprintf("$category %2d (%s)", $testnum, $description));
+    my $tc_filename = $ENV{'TC_FILENAME'} || "";
+    if ($tc_filename && open(F, ">>$tc_filename"))
+    {
+	printf F "# $category %2d (%s)\n", $testnum, $description;
+	close(F);
+    }
+    $rep->_testnum(++$testnum);
+}
+
+sub update_counters
+{
+    my $rep = shift;
+    my ($outcome, $exp_outcome) = @_;
+
+    (($outcome eq PASS) && ($exp_outcome eq PASS)) &&
+	$rep->{+__PACKAGE__}{$f_passes}++;
+    (($outcome eq PASS) && ($exp_outcome eq FAIL)) &&
+	$rep->{+__PACKAGE__}{$f_xpasses}++;
+    (($outcome eq FAIL) && ($exp_outcome eq PASS)) &&
+	$rep->{+__PACKAGE__}{$f_fails}++;
+    (($outcome eq FAIL) && ($exp_outcome eq FAIL)) &&
+	$rep->{+__PACKAGE__}{$f_xfails}++;
+
+    ($outcome eq PASS);
+}
+
+sub analyze_thread_data
+{
+    my $rep = shift;
+    my ($description, $expected, $actual,
+	$expected_threads, $expected_seqgroups) = @_;
+
+    my $tempdir = $rep->_tempdir();
+
+    my %actual_threads = ();
+    my %actual_seqgroups = ();
+    my @errors = ();
+
+    $rep->thread_cleanup();
+    $rep->split_combined($expected);
+    $rep->analyze_threaded_output
+	($actual, \%actual_threads, \%actual_seqgroups, \@errors);
+
+    # Make sure we saw the right threads and sequences
+
+    my $desired = "threads:\n";
+    $desired .= join('', map { "  $_\n" } (sort @$expected_threads));
+    $desired .= "sequence groups:\n";
+    if (defined $expected_seqgroups)
+    {
+	$desired .= join('', map { "  $_\n" } (sort @$expected_seqgroups));
+    }
+
+    my $observed = "threads:\n";
+    $observed .= join('', map { "  $_\n" } (sort keys %actual_threads));
+    $observed .= "sequence groups:\n";
+    $observed .= join('', map { "  $_\n" } (sort keys %actual_seqgroups));
+
+    if (@errors)
+    {
+	$observed .= join('', @errors);
+    }
+
+    my $passed =
+	$rep->runtest("$description: multithreaded data",
+		      {$rep->STRING => $observed},
+		      {$rep->STRING => $desired});
+
+
+    foreach my $th (@{$expected_threads})
+    {
+	create_if_missing("$tempdir/$th.thread-actual",
+			  "[no actual output]\n");
+	filter_seqgroups("$tempdir/$th.thread-expected",
+			 "$tempdir/$th.thread-filtered");
+	$passed =
+	    $rep->runtest($description . ": thread $th",
+			  {$rep->FILE => "$tempdir/$th.thread-actual"},
+			  {$rep->FILE => "$tempdir/$th.thread-filtered"})
+	    && $passed;
+    }
+    if (defined $expected_seqgroups)
+    {
+	foreach my $sg (@{$expected_seqgroups})
+	{
+	    create_if_missing("$tempdir/$sg.seq-actual",
+			      "[no actual output]\n");
+	    $passed =
+		$rep->runtest($description . ": seqgroup $sg",
+			      {$rep->FILE => "$tempdir/$sg.seq-actual"},
+			      {$rep->FILE => "$tempdir/$sg.seq-expected"})
+		&& $passed;
+	}
+    }
+
+    $rep->thread_cleanup();
+
+    $passed;
+}
+
+sub analyze_threaded_output
+{
+    my $rep = shift;
+    my ($file, $threads, $seqgroups, $errors) = @_;
+    my $sequence_checking = 1;
+    open(F, "<$file") or die +__PACKAGE__, ": can't open $file: $!\n";
+    my $cur_thread = undef;
+    while (<F>)
+    {
+	if (m/^(\[\[(.+?)\]\]:)/)
+	{
+	    my $tag = $1;
+	    my $thread = $2;
+	    my $rest = $';	#' [unconfuse emacs font lock mode]
+
+	    $rep->handle_line($file, $., $tag, $thread, $rest,
+			      \$sequence_checking, $threads, $seqgroups,
+			      $errors);
+
+	    $cur_thread = $thread;
+	}
+	else
+	{
+	    $rep->handle_line($file, $., "", $cur_thread, $_,
+			      \$sequence_checking, $threads, $seqgroups,
+			      $errors);
+	}
+    }
+    close(F);
+}
+
+sub handle_line
+{
+    my $rep = shift;
+    my ($file, $lineno, $tag, $thread, $rest,
+	$sequence_checking, $threads, $seqgroups, $errors) = @_;
+
+    my $tempdir = $rep->_tempdir();
+
+    if (! exists $threads->{$thread})
+    {
+	my $fh = new IO::File("<$tempdir/$thread.thread-expected");
+	if (! $fh)
+	{
+	    &QTC::TC("testdriver", "TestDriver no input file for thread");
+	    $fh = undef;
+	    $$sequence_checking = 0;
+	    push(@$errors,
+		 "$file:$.: no input file for thread $thread; " .
+		 "sequence checking abandoned\n");
+	}
+	$threads->{$thread} = $fh;
+    }
+    my $known = defined($threads->{$thread});
+
+    my $seqs = "";
+    if ($$sequence_checking)
+    {
+	my $fh = $threads->{$thread};
+	my $next_input_line = scalar(<$fh>);
+	if (! defined $next_input_line)
+	{
+	    $next_input_line = "[EOF]\n";
+	}
+	$seqs = $rep->strip_seqs(\$next_input_line);
+	if ($next_input_line eq $rest)
+	{
+	    if ($seqs ne "")
+	    {
+		$rep->handle_seqs($seqs, $tag . $rest, $seqgroups);
+	    }
+	}
+	else
+	{
+	    &QTC::TC("testdriver", "TestDriver thread mismatch");
+	    $$sequence_checking = 0;
+	    push(@$errors,
+		 "$file:$.: thread $thread mismatch; " .
+		 "sequencing checking abandoned\n" .
+		 "actual $rest" .
+		 "expected $next_input_line");
+	}
+    }
+    output_line("$tempdir/$thread.thread-actual", $rest);
+    if (! $known)
+    {
+	&QTC::TC("testdriver", "TestDriver output from unknown thread");
+	push(@$errors, "[[$thread]]:$rest");
+    }
+}
+
+sub strip_seqs
+{
+    my $rep = shift;
+    my $linep = shift;
+    my $seqs = "";
+    if ($$linep =~ s/^\(\(.*?\)\)//)
+    {
+	$seqs = $&;
+    }
+    $seqs;
+}
+
+sub handle_seqs
+{
+    my $rep = shift;
+    my ($seqs, $line, $seqgroups) = @_;
+    my $tempdir = $rep->_tempdir();
+    $seqs =~ s/^\(\((.*?)\)\)/$1/;
+    foreach my $seq (split(',', $seqs))
+    {
+	$seqgroups->{$seq} = 1;
+	output_line("$tempdir/$seq.seq-actual", $line);
+    }
+}
+
+sub filter_seqgroups
+{
+    my ($infile, $outfile) = @_;
+    open(F, "<$infile") or
+	die +__PACKAGE__, ": can't open $infile: $!\n";
+    binmode F;
+    open(O, ">$outfile") or
+	die +__PACKAGE__, ": can't create $outfile: $!\n";
+    binmode O;
+    while (<F>)
+    {
+	s/^((?:\[\[.+?\]\]:)?)\(\(.+?\)\)/$1/;
+	print O;
+    }
+    close(O);
+    close(F);
+}
+
+sub output_line
+{
+    my ($file, $line) = @_;
+    open(O, ">>$file") or die +__PACKAGE__, ": can't open $file: $!\n";
+    print O $line or die +__PACKAGE__, ": can't append to $file: $!\n";
+    close(O) or die +__PACKAGE__, ": close $file failed: $!\n";
+}
+
+sub create_if_missing
+{
+    my ($file, $line) = @_;
+    if (! -e $file)
+    {
+	open(O, ">$file") or die +__PACKAGE__, ": can't create $file: $!\n";
+	print O $line;
+	close(O);
+    }
+}
+
+sub split_combined
+{
+    my $rep = shift;
+    my $combined = shift;
+    my $tempdir = $rep->_tempdir();
+
+    open(C, "<$combined") or die +__PACKAGE__, ": can't open $combined: $!\n";
+    my %files = ();
+    my $last_thread_fh = undef;
+    while (<C>)
+    {
+	my $thread_fh = $last_thread_fh;
+	my $thread_out = undef;
+	if (m/^(\[\[(.+?)\]\]:)(\(\((.+?)\)\))?(.*\n?)$/)
+	{
+	    my $thread_full = $1;
+	    my $thread = $2;
+	    my $seq_full = $3;
+	    my $seq = $4;
+	    my $rest = $5;
+	    my $seq_out = undef;
+	    $thread_out = $rest;
+
+	    my @seq_files = ();
+	    my $thread_file = "$tempdir/$thread.thread-expected";
+	    if (defined $seq_full)
+	    {
+		$thread_out = $seq_full . $thread_out;
+		$seq_out = $thread_full . $rest;
+		foreach my $s (split(/,/, $seq))
+		{
+		    my $f = "$tempdir/$s.seq-expected";
+		    my $fh = cache_open(\%files, $f);
+		    $fh->print($seq_out);
+		}
+	    }
+
+	    $thread_fh = cache_open(\%files, $thread_file);
+	}
+	else
+	{
+	    $thread_out = $_;
+	}
+	if ((defined $thread_out) && (! defined $thread_fh))
+	{
+	    die +__PACKAGE__, ": no place to put output lines\n";
+	}
+	$thread_fh->print($thread_out) if defined $thread_out;
+	$last_thread_fh = $thread_fh;
+    }
+    close(C);
+    map { $_->close() } (values %files);
+}
+
+sub cache_open
+{
+    my ($cache, $file) = @_;
+    if (! defined $file)
+    {
+	return undef;
+    }
+    if (! exists $cache->{$file})
+    {
+	unlink $file;
+	my $fh = new IO::File(">$file") or
+	    die +__PACKAGE__, ": can't open $file: $!\n";
+	$cache->{$file} = $fh;
+    }
+    $cache->{$file};
+}
+
+sub thread_cleanup
+{
+    my $rep = shift;
+    my $dir = $rep->_tempdir();
+    my @files = +(grep { m/\.(thread|seq)-(actual|expected|filtered)$/ }
+		  (glob("$dir/*")));
+    if (@files)
+    {
+	unlink @files;
+    }
+}
+
+sub rmrf
+{
+    my $path = shift;
+    return unless -e $path;
+    my $wanted = sub
+    {
+	if ((-d $_) && (! -l $_))
+	{
+	    rmdir $_ or die "rmdir $_ failed: $!\n";
+	}
+	else
+	{
+	    unlink $_ or die "unlink $_ failed: $!\n";
+	}
+    };
+    finddepth({wanted => $wanted, no_chdir => 1}, $path);
+}
+
+sub safe_pipe
+{
+    my ($cmd, $outfile) = @_;
+    my $pid = open(C, "-|");
+    my $result = 0;
+
+    if ($pid)
+    {
+	# parent
+	my $out = new IO::File(">$outfile") or
+	    die +__PACKAGE__, ": can't open $outfile: $!\n";
+	binmode C;
+	while (<C>)
+	{
+	    $out->print($_);
+	}
+	close(C);
+	$result = $?;
+	$out->close();
+    }
+    else
+    {
+	# child
+	open(STDERR, ">&STDOUT");
+	exec(@$cmd) || die +__PACKAGE__, ": $cmd->[0] failed: $!\n";
+    }
+
+    $result;
+}
+1;
+
+#
+# END OF TestDriver
+#