Add these to the repository, but don't do anything with them; they

need perl (at least for now).

1 files changed, 813 insertions, 0 deletions

diff --git a/bin/ksh/tests/th b/bin/ksh/tests/th
new file mode 100644
index 00000000000..496058ccd4e
--- /dev/null
+++ b/bin/ksh/tests/th
@@ -0,0 +1,813 @@
+#!/usr/local/bin/perl
+
+#
+# Test harness for pdksh tests.
+#
+# Example test:
+#		name: a-test
+#		description:
+#			a test to show how tests are done
+#		arguments: !-x!-f!
+#		stdin:
+#			echo -n *
+#			false
+#		expected-stdout: !
+#			*
+#		expected-stderr:
+#			+ echo -n *
+#			+ false
+#		expected-exit: 1
+#		---
+#	This runs the test-program (eg, pdksh) with the arguments -x and -f,
+#	standard input is a file containing "echo hi*\nfalse\n".  The program
+#	is expected to produce "hi*" (no trailing newline) on standard output,
+#	"+ echo hi*\n+false\n" on standard error, and an exit code of 1.
+#
+#
+# Format of test files:
+#   - blank lines and lines starting with # are ignored
+#   - a test file contains a series of tests
+#   - a test is a series of tag:value pairs ended with a "---" line
+#     (leading/trailing spaces are stripped from the first line of value)
+#   - test tags are:
+#	Tag			  Flag	Description
+#	-----			  ----	-----------
+#	name			    r	The name of the test; should be unique
+#	description		    m	What test does
+#	arguments		    M	Arguments to pass to the program;
+#					default is no arguments.
+#	script			    m	Value is written to a file which
+#					is passed as an argument to the program
+#					(after the arguments arguments)
+#	stdin			    m	Value is written to a file which is
+#					used as standard-input for the program;
+#					default is to use /dev/null.
+#	perl-setup		    m	Value is a perl script which is executed
+#					just before the test is run.  Try to
+#					avoid using this...
+#	perl-cleanup		    m	Value is a perl script which is executed
+#					just after the test is run.  Try to
+#					avoid using this...
+#	env-setup		    M	Value is a list of NAME=VALUE elements
+#					which are put in the environment before
+#					the test is run.  If the =VALUE is
+#					missing, NAME is removed from the
+#					environment.  Programs are run with
+#					the following minimal environment:
+#					    USER, LOGNAME, HOME, PATH, SHELL
+#					(values taken from the environment of
+#					the test harness).
+#	time-limit		    	Time limit - the program is sent a
+#					SIGKILL N seconds.  Default is no
+#					limit.
+#	expected-fail		    	`yes' if the test is expected to fail.
+#	expected-exit		    	expected exit code.  Can be a number,
+#					or a C expression using the variables
+#					e, s and w (exit code, termination
+#					signal, and status code).
+#	expected-stdout		    m	What the test should generate on stdout;
+#					default is to expect no output.
+#	expected-stdout-pattern	    m	A perl pattern which matches the
+#					expected output.
+#	expected-stderr		    m	What the test should generate on stderr;
+#					default is to expect no output.
+#	expected-stderr-pattern	    m	A perl pattern which matches the
+#					expected standard error.
+# Flag meanings:
+#	r	tag is required (eg, a test must have a name tag).
+#	m	value can be multiple lines.  Lines must be prefixed with
+#		a tab.  If the value part of the initial tag:value line is
+#			- empty: the initial blank line is stripped.
+#			- a lone !: the last newline in the value is stripped;
+#	M	value can be multiple lines (prefixed by a tab) and consists
+#		of multiple fields, delimited by a field seperator character.
+#		The value must start and end with the f-s-c.
+#
+
+require 'signal.ph';
+require 'errno.ph';
+require 'getopts.pl';
+
+($prog = $0) =~ s#.*/##;
+
+$Usage = <<EOF ;
+Usage: $prog [-s test-set] [-p prog] [-v] test-name ...
+	-p p	Use p as the program to test
+	-s s	Read tests from file s; if s is a directory, it is recursively
+		scaned for test files (which end in .t).
+	-t t	Use t as default time limit for tests (default is unlimited)
+	-v	Verbose mode: print reason test failed.
+    test-name(s) specifies the name of the test(s) to run; if none are
+    specified, all tests are run.
+EOF
+
+#
+# r - required
+# m - can be multi-line
+# M - multi-line, but without trailing newline
+#
+%test_fields = (
+	    'name',			'r',
+	    'description',		'm',
+	    'arguments',		'M',
+	    'script',			'm',
+	    'stdin',			'm',
+	    'perl-setup',		'm',
+	    'perl-cleanup',		'm',
+	    'env-setup',		'M',
+	    'time-limit',		'',
+	    'expected-fail',		'',
+	    'expected-exit',		'',
+	    'expected-stdout',		'm',
+	    'expected-stdout-pattern',	'm',
+	    'expected-stderr',		'm',
+	    'expected-stderr-pattern',	'm',
+	);
+# Filled in by read_test()
+%internal_test_fields = (
+	    ':full-name', 1,		# file:name
+	    ':long-name', 1,		# dir/file:lineno:name
+	);
+
+$temps = "/tmp/rts$$";
+$tempi = "/tmp/rti$$";
+$tempo = "/tmp/rto$$";
+$tempe = "/tmp/rte$$";
+$tempdir = "/tmp/rtd$$";
+
+$nfailed = 0;
+$nxfailed = 0;
+$npassed = 0;
+$nxpassed = 0;
+
+%known_tests = ();
+
+if (!&Getopts('p:s:t:v')) {
+    print STDERR $Usage;
+    exit 1;
+}
+
+die "$prog: no program specified (use -p)\n" if !defined $opt_p;
+die "$prog: no test set specified (use -s)\n" if !defined $opt_s;
+$test_prog = $opt_p;
+$verbose = defined $opt_v && $opt_v;
+$test_set = $opt_s;
+if (defined $opt_t) {
+    die "$prog: bad -t argument (should be number > 0): $opt_t\n"
+	if $opt_t !~ /^\d+$/ || $opt_t <= 0;
+    $default_time_limit = $opt_t;
+}
+
+# Note which tests are to be run.
+%do_test = ();
+grep($do_test{$_} = 1, @ARGV);
+$all_tests = @ARGV == 0;
+
+# Set up a very minimal environment
+%new_env = ();
+foreach $env (('USER', 'LOGNAME', 'HOME', 'PATH', 'SHELL')) {
+    $new_env{$env} = $ENV{$env} if defined $ENV{$env};
+}
+%old_env = %ENV;
+%ENV = %new_env;
+
+die "$prog: couldn't make directory $tempdir - $!\n" if !mkdir($tempdir, 0777);
+
+chop($pwd = `pwd 2> /dev/null`);
+die "$prog: couldn't get current working directory\n" if $pwd eq '';
+die "$prog: couldn't cd to $pwd - $!\n" if !chdir($pwd);
+
+$test_prog = "$pwd/$test_prog" if substr($test_prog, 0, 1) ne '/';
+die "$prog: $test_prog is not executable - bye\n" if ! -x $test_prog;
+
+@trap_sigs = ('TERM', 'QUIT', 'INT', 'PIPE', 'HUP');
+@SIG{@trap_sigs} = ('cleanup_exit') x @trap_sigs;
+$child_kill_ok = 0;
+$SIG{'ALRM'} = 'catch_sigalrm';
+
+$| = 1;
+
+if (-d $test_set) {
+    $file_prefix_skip = length($test_set) + 1;
+    $ret = &process_test_dir($test_set);
+} else {
+    $file_prefix_skip = 0;
+    $ret = &process_test_file($test_set);
+}
+&cleanup_exit() if !defined $ret;
+
+$tot_failed = $nfailed + $nxfailed;
+$tot_passed = $npassed + $nxpassed;
+if ($tot_failed || $tot_passed) {
+    print "Total failed: $tot_failed";
+    print " ($nxfailed unexpected)" if $nxfailed;
+    print " (as expected)" if $nfailed && !$nxfailed;
+    print "\nTotal passed: $tot_passed";
+    print " ($nxpassed unexpected)" if $nxpassed;
+    print "\n";
+}
+
+&cleanup_exit('ok');
+
+sub
+cleanup_exit
+{
+    local($sig, $exitcode) = ('', 1);
+
+    if ($_[0] eq 'ok') {
+	$exitcode = 0;
+    } elsif ($_[0] ne '') {
+	$sig = $_[0];
+    }
+
+    unlink($tempi, $tempo, $tempe, $temps);
+    &scrub_dir($tempdir) if defined $tempdir;
+    rmdir($tempdir) if defined $tempdir;
+
+    if ($sig) {
+	$SIG{$sig} = 'DEFAULT';
+	kill $sig, $$;
+	return;
+    }
+    exit $exitcode;
+}
+
+sub
+catch_sigalrm
+{
+    $SIG{'ALRM'} = 'catch_sigalrm';
+    kill(9, $child_pid) if $child_kill_ok;
+    $child_killed = 1;
+}
+
+sub
+process_test_dir
+{
+    local($dir) = @_;
+    local($ret, $file);
+    local(@todo) = ();
+
+    if (!opendir(DIR, $dir)) {
+	print STDERR "$prog: can't open directory $dir - $!\n";
+	return undef;
+    }
+    while ($file = readdir(DIR)) {
+	push(@todo, $file) if $file =~ /^[^.].*\.t$/;
+    }
+    closedir(DIR);
+
+    foreach $file (@todo) {
+	$file = "$dir/$file";
+	if (-d $file) {
+	    $ret = &process_test_dir($file);
+	} elsif (-f _) {
+	    $ret = &process_test_file($file);
+	}
+	last if !defined $ret;
+    }
+
+    return $ret;
+}
+
+sub
+process_test_file
+{
+    local($file) = @_;
+    local($ret);
+
+    if (!open(IN, $file)) {
+	die "$prog: can't open $file - $!\n";
+	return undef;
+    }
+    while (1) {
+	$ret = &read_test($file, IN, *test);
+	last if !defined $ret || !$ret;
+	next if !$all_tests && !$do_test{$test{'name'}};
+	$ret = &run_test(*test);
+	last if !defined $ret;
+    }
+    close(IN);
+
+    return $ret;
+}
+
+sub
+run_test
+{
+    local(*test) = @_;
+    local($name) = $test{':full-name'};
+
+    #print "Running test $name...\n" if $verbose;
+
+    if (defined $test{'stdin'}) {
+	return undef if !&write_file($tempi, $test{'stdin'});
+	$ifile = $tempi;
+    } else {
+	$ifile = '/dev/null';
+    }
+
+    if (defined $test{'script'}) {
+	return undef if !&write_file($temps, $test{'script'});
+    }
+
+    return undef if !&scrub_dir($tempdir);
+
+    if (!chdir($tempdir)) {
+	print STDERR "$prog: couldn't cd to $tempdir - $!\n";
+	return undef;
+    }
+
+    if (defined $test{'perl-setup'}) {
+	eval $test{'perl-setup'};
+	if ($@ ne '') {
+	    print STDERR "$prog:$test{':long-name'}: error running perl-setup - $@\n";
+	    return undef;
+	}
+    }
+
+    $pid = fork;
+    if (!defined $pid) {
+	print STDERR "$prog: can't fork - $!\n";
+	return undef;
+    }
+    if (!$pid) {
+	@SIG{@trap_sigs} = ('DEFAULT') x @trap_sigs;
+	$SIG{'ALRM'} = 'DEFAULT';
+	if (defined $test{'env-setup'}) {
+	    local($var, $val, $i);
+
+	    foreach $var (split(substr($test{'env-setup'}, 0, 1),
+		$test{'env-setup'}))
+	    {
+		$i = index($var, '=');
+		next if $i == 0 || $var eq '';
+		if ($i < 0) {
+		    delete $ENV{$var};
+		} else {
+		    $ENV{substr($var, 0, $i)} = substr($var, $i + 1);
+		}
+	    }
+	}
+	if (!open(STDIN, "< $ifile")) {
+		print STDERR "$prog: couldn't open $ifile in child - $!\n";
+		kill('TERM', $$);
+	}
+	if (!open(STDOUT, "> $tempo")) {
+		print STDERR "$prog: couldn't open $tempo in child - $!\n";
+		kill('TERM', $$);
+	}
+	if (!open(STDERR, "> $tempe")) {
+		print STDOUT "$prog: couldn't open $tempe in child - $!\n";
+		kill('TERM', $$);
+	}
+	@argv = ($test_prog);
+	if (defined $test{'arguments'}) {
+		push(@argv,
+		     split(substr($test{'arguments'}, 0, 1),
+			   substr($test{'arguments'}, 1)));
+	}
+	push(@argv, $temps) if defined $test{'script'};
+	exec(@argv);
+	print STDERR "$prog: couldn't execute $test_prog - $!\n";
+	kill('TERM', $$);
+	exit(95);
+    }
+    $child_pid = $pid;
+    $child_killed = 0;
+    $child_kill_ok = 1;
+    alarm($test{'time-limit'}) if defined $test{'time-limit'};
+    while (1) {
+	$xpid = waitpid($pid, 0);
+	$child_kill_ok = 0;
+	if ($xpid < 0) {
+	    next if $! == &EINTR;
+	    print STDERR "$prog: error waiting for child - $!\n";
+	    return undef;
+	}
+	last;
+    }
+    $status = $?;
+    alarm(0) if defined $test{'time-limit'};
+
+    $failed = 0;
+    $why = '';
+
+    if ($child_killed) {
+	$failed = 1;
+	$why .= "\ttest timed out (limit of $test{'time-limit'} seconds)\n";
+    }
+
+    $ret = &eval_exit($test{'long-name'}, $status, $test{'expected-exit'});
+    return undef if !defined $ret;
+    if (!$ret) {
+	local($expl);
+
+	$failed = 1;
+	if (($status & 0xff) == 0x7f) {
+	    $expl = "stopped";
+	} elsif (($status & 0xff)) {
+	    $expl = "signal " . ($status & 0x7f);
+	} else {
+	    $expl = "exit-code " . (($status >> 8) & 0xff);
+	}
+	$why .=
+	"\tunexpected exit status $status ($expl), expected $test{'expected-exit'}\n";
+    }
+
+    $tmp = &check_output($test{'long-name'}, $tempo, 'stdout',
+		$test{'expected-stdout'}, $test{'expected-stdout-pattern'});
+    return undef if !defined $tmp;
+    if ($tmp ne '') {
+	$failed = 1;
+	$why .= $tmp;
+    }
+
+    $tmp = &check_output($test{'long-name'}, $tempe, 'stderr',
+		$test{'expected-stderr'}, $test{'expected-stderr-pattern'});
+    return undef if !defined $tmp;
+    if ($tmp ne '') {
+	$failed = 1;
+	$why .= $tmp;
+    }
+
+    if (defined $test{'perl-cleanup'}) {
+	eval $test{'perl-cleanup'};
+	if ($@ ne '') {
+	    print STDERR "$prog:$test{':long-name'}: error running perl-cleanup - $@\n";
+	    return undef;
+	}
+    }
+
+    if (!chdir($pwd)) {
+	print STDERR "$prog: couldn't cd to $pwd - $!\n";
+	return undef;
+    }
+
+    if ($failed) {
+	if (!$test{'expected-fail'}) {
+	    print "FAIL $name\n";
+	    $nxfailed++;
+	} else {
+	    print "fail $name (as expected)\n";
+	    $nfailed++;
+	}
+	$why = "\tDescription"
+		. &wrap_lines($test{'description'}, " (missing)\n")
+		. $why;
+    } elsif ($test{'expected-fail'}) {
+	print "PASS $name (unexpectedly)\n";
+	$nxpassed++;
+    } else {
+	print "pass $name\n";
+	$npassed++;
+    }
+    print $why if $verbose;
+    return 0;
+}
+
+sub
+scrub_dir
+{
+    local($dir) = @_;
+    local(@todo) = ();
+    local($file);
+
+    if (!opendir(DIR, $dir)) {
+	print STDERR "$prog: couldn't open direcotry $dir - $!\n";
+	return undef;
+    }
+    while ($file = readdir(DIR)) {
+	push(@todo, $file) if $file ne '.' && $file ne '..';
+    }
+    closedir(DIR);
+    foreach $file (@todo) {
+	$file = "$dir/$file";
+	if (-d $file) {
+	    return undef if !&scrub_dir($file);
+	    if (!rmdir($file)) {
+		print STDERR "$prog: couldn't rmdir $file - $!\n";
+		return undef;
+	    }
+	} else {
+	    if (!unlink($file)) {
+		print STDERR "$prog: couldn't unlink $file - $!\n";
+		return undef;
+	    }
+	}
+    }
+    return 1;
+}
+
+sub
+write_file
+{
+    local($file, $str) = @_;
+
+    if (!open(TEMP, "> $file")) {
+	print STDERR "$prog: can't open $file - $!\n";
+	return undef;
+    }
+    print TEMP $str;
+    if (!close(TEMP)) {
+	print STDERR "$prog: error writing $file - $!\n";
+	return undef;
+    }
+    return 1;
+}
+
+sub
+check_output
+{
+    local($name, $file, $what, $expect, $expect_pat) = @_;
+    local($got) = '';
+    local($why) = '';
+    local($ret);
+
+    if (!open(TEMP, "< $file")) {
+	print STDERR "$prog:$name($what): couldn't open $file after running program - $!\n";
+	return undef;
+    }
+    while (<TEMP>) {
+	$got .= $_;
+    }
+    close(TEMP);
+    if (defined $expect_pat) {
+	$_ = $got;
+	$ret = eval "$expect_pat";
+	if ($@ ne '') {
+	    print STDERR "$prog:$name($what): error evaluating $what pattern: $expect_pat - $@\n";
+	    return undef;
+	}
+	if (!$ret) {
+	    $why = "\tunexpected $what - wanted pattern";
+	    $why .= &wrap_lines($expect_pat);
+	    $why .= "\tgot";
+	    $why .= &wrap_lines($got);
+	}
+    } else {
+	$expect = '' if !defined $expect;
+	if ($got ne $expect) {
+	    $why .= "\tunexpected $what - " . &first_diff($expect, $got) . "\n";
+	    $why .= "\twanted";
+	    $why .= &wrap_lines($expect);
+	    $why .= "\tgot";
+	    $why .= &wrap_lines($got);
+	}
+    }
+    return $why;
+}
+
+sub
+wrap_lines
+{
+    local($str, $empty) = @_;
+    local($nonl) = substr($str, -1, 1) ne "\n";
+
+    return (defined $empty ? $empty : " nothing\n") if $str eq '';
+    substr($str, 0, 0) = ":\n";
+    $str =~ s/\n/\n\t\t/g;
+    if ($nonl) {
+	$str .= "\n\t[incomplete last line]\n";
+    } else {
+	chop($str);
+	chop($str);
+    }
+    return $str;
+}
+
+sub
+first_diff
+{
+    local($exp, $got) = @_;
+    local($lineno, $char) = (1, 1);
+    local($i, $len);
+    local($ce, $cg);
+
+    $len = length($exp);
+    if ($len != length($got)) {
+	if ($len < length($got)) {
+	    if (substr($got, 0, $len) eq $exp) {
+		return "got too much output";
+	    }
+	} elsif (substr($exp, 0, $len) eq $got) {
+	    return "got too little output";
+	}
+	$len = length($got);
+    }
+    for ($i = 0; $i < $len; $i++) {
+	$ce = substr($exp, $i, 1);
+	$cg = substr($got, $i, 1);
+	last if $ce ne $cg;
+	$char++;
+	if ($ce eq "\n") {
+	    $lineno++;
+	    $char = 1;
+	}
+    }
+    return "first difference: line $lineno, char $char"
+}
+
+sub
+eval_exit
+{
+    local($name, $status, $expect) = @_;
+    local($expr);
+    local($w, $e, $s) = ($status, ($status >> 8) & 0xff, $status & 0x7f);
+
+    $e = -1000 if $status & 0xff;
+    $s = -1000 if $s == 0x7f;
+    if (!defined $expect) {
+	$expr = '$w == 0';
+    } elsif ($expect =~ /^(|-)\d+$/) {
+	$expr = "\$e == $expect";
+    } else {
+	$expr = $expect;
+	$expr =~ s/\b([wse])\b/\$$1/g;
+	$expr =~ s/\b(SIG[A-Z0-9]+)\b/&$1/g;
+    }
+    $w = eval $expr;
+    if ($@ ne '') {
+	print STDERR "$prog:$test{':long-name'}: bad expected-exit expression: $expect ($@)\n";
+	return undef;
+    }
+    return $w;
+}
+
+sub
+read_test
+{
+    local($file, $in, *test) = @_;
+    local($field, $val, $flags, $do_chop, $need_redo, $start_lineno);
+
+    %test = ();
+    while (<$in>) {
+	next if /^\s*$/;
+	next if /^ *#/;
+	last if /^\s*---\s*$/;
+	$start_lineno = $. if !defined $start_lineno;
+	if (!/^([-\w]+):\s*(|\S|\S.*\S)\s*$/) {
+	    print STDERR "$prog:$file:$.: unrecognized line\n";
+	    return undef;
+	}
+	($field, $val) = ($1, $2);
+	if (defined $test{$field}) {
+	    print STDERR "$prog:$file:$.: multiple \"$field\" fields\n";
+	    return undef;
+	}
+	$flags = $test_fields{$field};
+	if (!defined $flags) {
+	    print STDERR "$prog:$file:$.: unrecognized field \"$field\"\n";
+	    return undef;
+	}
+	$do_chop = $flags !~ /m/;
+	$need_redo = 0;
+	if ($val eq '' || $val eq '!') {
+	    if ($flags =~ /[Mm]/) {
+		$do_chop = 1 if $val eq '!';
+		$val = '';
+		while (<$in>) {
+		    last if !/^\t/;
+		    $val .= $';
+		}
+		chop $val if $do_chop;
+		$do_chop = 1;
+		$need_redo = 1;
+	    } elsif ($val eq '') {
+		print STDERR
+		    "$prog:$file:$.: no value given for field \"$field\"\n";
+		return undef;
+	    }
+	}
+	$val .= "\n" if !$do_chop;
+	$test{$field} = $val;
+	redo if $need_redo;
+    }
+    if ($_ eq '') {
+	if (%test) {
+	    print STDERR
+	      "$prog:$file:$start_lineno: end-of-file while reading test\n";
+	    return undef;
+	}
+	return 0;
+    }
+
+    while (($field, $val) = each %test_fields) {
+	if ($val =~ /r/ && !defined $test{$field}) {
+	    print STDERR
+	      "$prog:$file:$start_lineno: required field \"$field\" missing\n";
+	    return undef;
+	}
+    }
+
+    $test{':full-name'} = substr($file, $file_prefix_skip) . ":$test{'name'}";
+    $test{':long-name'} = "$file:$start_lineno:$test{'name'}";
+
+    # Syntax check on specific fields
+    if (defined $test{'expected-fail'}) {
+	if ($test{'expected-fail'} !~ /^(yes|no)$/) {
+	    print STDERR
+	      "$prog:$test{':long-name'}: bad value for expected-fail field\n";
+	    return undef;
+	}
+	$test{'expected-fail'} = $1 eq 'yes';
+    } else {
+	$test{'expected-fail'} = 0;
+    }
+    if (defined $test{'arguments'}) {
+	local($firstc) = substr($test{'arguments'}, 0, 1);
+
+	if (substr($test{'arguments'}, -1, 1) ne $firstc) {
+	    print STDERR "$prog:$test{':long-name'}: arguments field doesn't start and end with the same character\n";
+	    return undef;
+	}
+    }
+    if (defined $test{'env-setup'}) {
+	local($firstc) = substr($test{'env-setup'}, 0, 1);
+
+	if (substr($test{'env-setup'}, -1, 1) ne $firstc) {
+	    print STDERR "$prog:$test{':long-name'}: env-setup field doesn't start and end with the same character\n";
+	    return undef;
+	}
+    }
+    if (defined $test{'expected-exit'}) {
+	local($val) = $test{'expected-exit'};
+
+	if ($val =~ /^(|-)\d+$/) {
+	    if ($val < 0 || $val > 255) {
+		print STDERR "$prog:$test{':long-name'}: expected-exit value $val not in 0..255\n";
+		return undef;
+	    }
+	} elsif ($val !~ /^([\s<>+-=*%\/&|!()]|\b[wse]\b|\bSIG[A-Z0-9]+\b)+$/) {
+	    print STDERR "$prog:$test{':long-name'}: bad expected-exit expression: $val\n";
+	    return undef;
+	}
+    } else {
+	$test{'expected-exit'} = 0;
+    }
+    if (defined $test{'expected-stdout'}
+	&& defined $test{'expected-stdout-pattern'})
+    {
+	print STDERR "$prog:$test{':long-name'}: can't use both expected-stdout and expected-stdout-pattern\n";
+	return undef;
+    }
+    if (defined $test{'expected-stderr'}
+	&& defined $test{'expected-stderr-pattern'})
+    {
+	print STDERR "$prog:$test{':long-name'}: can't use both expected-stderr and expected-stderr-pattern\n";
+	return undef;
+    }
+    if (defined $test{'time-limit'}) {
+	if ($test{'time-limit'} !~ /^\d+$/ || $test{'time-limit'} == 0) {
+	    print STDERR
+	      "$prog:$test{':long-name'}: bad value for time-limit field\n";
+	    return undef;
+	}
+    } elsif (defined $default_time_limit) {
+	$test{'time-limit'} = $default_time_limit;
+    }
+
+    if (defined $known_tests{$test{'name'}}) {
+	print STDERR "$prog:$test{':long-name'}: warning: duplicate test name ${test{'name'}}\n";
+    }
+    $known_tests{$test{'name'}} = 1;
+
+    return 1;
+}
+
+sub
+touch
+{
+    local(@files) = @_;
+    local($file);
+
+    foreach $file (@files) {
+	if (!open(T, "> $file")) {
+	    die "Couldn't touch $file\n";
+	}
+	close(T);
+    }
+    return 1;
+}
+
+sub
+tty_msg
+{
+    local($msg) = @_;
+
+    open(TTY, "> /dev/tty") || return 0;
+    print TTY $msg;
+    close(TTY);
+    return 1;
+}
+
+sub
+never_called_funcs
+{
+	return 0;
+	&tty_msg("hi\n");
+	&touch("/tmp/foo");
+	&never_called_funcs();
+	&catch_sigalrm();
+	$old_env{'foo'} = 'bar';
+	$internal_test_fields{'foo'} = 'bar';
+}