#!/usr/bin/perl
#
# NAME
#   Test - run a suite of tests
#
# SYNOPSIS
#   Test
#
# KEYWORDS
#   regression test
#  
# DESCRIPTION
#   This is a test generator script. It expects to find a subdirectory
#   "test" which has several subdirectories:
#     test/prog     programs to run.
#     test/check    programs to test output for validity.
#     test/stdin    programs' standard input, if any.
#     test/stdout   programs' standard output, if any.
#     test/stderr   programs' standard error output, if any.
#     test/out      receives programs' standard output.
#     test/err      receives programs' error output.
#
#   The  Test  script  runs  through  the   test/prog   directory   in
#   alphabetical  order,  and  executes every file whose name does not
#   start with a dot ('.').  Test reports the success  or  failure  of
#   each such program on its standard output.
#
#   Success or failure can be based on the program's exit  status,  or
#   on  comparing the program's output with known "correct" output, or
#   by providing a check program to validate the output.
#
#   If  it  is  important that tests be done in a special order, their
#   names should indicate the order.  The suggested convention  is  to
#   make  initial,  low-level  tests  have  names  like  test/prog/00,
#   test/prog/01, and so on.  After these have been run,  higher-level
#   tests  are  usually  independent of each other, so the name should
#   generally start with a "package" name,  such  as  test/prog/xyz00,
#   test/prog/xyz01, and so on.
#
#   If  there  is  a  test/stdin/foo file, the test/prog/foo program's
#   standard input will come from that file; otherwise it will be left
#   at the control terminal.  Thus test programs may interact with the
#   user in the normal fashion, or may have packaged input.
#
#   If the file test/stdout/xxx exists, then test/prog/xxx will be run
#   with its standard output redirected to test/out/xxx; otherwise its
#   standard  output  will go to the terminal.  Similarly, if the file
#   test/stderr/xxx exists, then test/prog/xxx will be  run  with  its
#   error  output  redirected  to  test/err/xxx;  otherwise  its error
#   output will go to the terminal.
#
#   If a program has a corresponding file in the test/check directory,
#   it will be run to check the program's output. Thus if the programs
#   test/prog/foo  and  test/check/foo  both  exists,  we  first   run
#   test/prog/foo,  and when it finishes, we run test/check/foo, which
#   should do whatever is needed to verify that test/prog/foo did what
#   it  was  supposed  to do.  Typically it looks for test/out/foo and
#   test/err/foo, and verify their contents, though all sorts of other
#   checks  are  possible,  such as looking around for expected output
#   files or database entries. Thus, if test/check/foo exists, it is a
#   good  idea  to create test/stdout/foo and test/stderr/foo, even if
#   they are null, so that test/check/foo can look at the output.   If
#   test/check/foo  returns  a  zero  status,  the  test is considered
#   successful; if not, the test is reported as having failed. In this
#   case, we ignore the exit status of test/prog/foo.
#
#   If  there is no test/check/foo, we use test/prog/foo's exit status
#   as an indication of success or failure.  If  the  exit  status  is
#   nonzero,  we  report the test as failed.  Otherwise we examine the
#   output files as follows.
#
#   We compare test/stdout/foo with test/out/foo, and  test/stderr/foo
#   with test/err/foo, if they exist.  If they differ, we include that
#   fact in the report, and consider the test  to  have  failed.   You
#   should  examine  the test/out and test/err files in such cases, to
#   determine the problem.
#
#   If neither test/stdout/foo nor test/stderr/foo exists, then we use
#   the  exit status of test/prog/foo as the sole indicator of success
#   or failure.
#
#   There should be a test/check/Generic included, which looks for the
#   test/stdout  and  test/stderr  files,  and if they exist, puts the
#   test/out and test/err files  into  a  canonical  form  (mostly  by
#   wiping  out  things  that look like dates and times), and compares
#   the results. This is a useful sort of check routine that works for
#   many  tests,  and is useful as a prototype for other more detailed
#   check programs.
#
#   First written by John Chambers 1990/9/17.  Modified  somewhat  for
#   assorted  projects  for assorted employers since then, and emailed
#   to assorted people on the Net who expressed an interest.
#
# AUTHOR
#   Copyright (C) 1990 by John Chambers.  This script is  made  freely
#   available  to the public.  You may use it for your own testing and
#   distribute it with your software, as long as you  give  me  credit
#   (and give credit to anyone who makes changes or improvements).
# 
#   Send comments or suggestions to:
#     To: <jc%minya.uucp@trillian.mit.edu>
#     To: <jc%minya.bcs.org>
#     To: <jmc0@gte.com>

$| = 1;
chop($cwd = `pwd`);
open(F,">Test.failures");
select F; $| = 1; select STDOUT;
$ddd = $ENV{'D_cs'} || $ENV{'D_cscp'};

die "$0: No $pwd/test directory.\n"
	if (! -d "test");
die "$0: No $pwd/test/prog directory.\n"
	if (! -d "test/prog");

if (! -d "test/out") {
	mkdir("test/out",0775)
		|| die "$0: Can't create test/out [$!]\n";
}
if (! -d "test/err") {
	mkdir("test/err",0775)
		|| die "$0: Can't create test/err [$!]\n";
}
if (! -d "test/tmp") {
	mkdir("test/tmp",0777)
		|| die "$0: Can't create test/tmp [$!]\n";
}
($ss,$mm,$hh,$DD,$MM,$YY) = localtime($t0 = time);
$DT = sprintf("%02d:%02d:%02d",$YY,$MM+1,$DD);
$tt = sprintf("%02d:%02d:%02d",$hh,$mm,$ss);
print "Test started $DT $tt\n";

program: 
foreach $p (`ls test/prog`) {
	next if ($p =~ /^\./);	# ls shows hidden files to super-users!
	print "==========================================================\n" if $ddd;
	$p =~ s/\s+$//;
	($ss,$mm,$hh) = localtime($t0 = time);
	$tt = sprintf("%02d:%02d:%02d",$hh,$mm,$ss);
	unless (-x "test/prog/$p") {print "$tt File $p not executable.\n"; next}
	print "$tt Test $p\n";
	if ($child = fork) {	# Parent.
		waitpid($child,0);	# Wait around for it to quit.
		$stat = $?;			# Note its exit status.
		$code = ($stat >>8);
		$sgnl = ($stat & 0xFF);
	} else {				# Child.
		if (-f "test/stdin/$p") {
			open(STDIN,"<test/stdin/$p")
				|| die "$0: Can't read test/stdin/$p [$!]\n";
		}
		if (-f "test/stdout/$p") {
			open(STDOUT,">test/out/$p")
				|| die "$0: Can't write test/out/$p [$!]\n";
		}
		if (-f "test/stderr/$p") {
			open(STDERR,">test/err/$p")
				|| die "$0: Can't write test/err/$p [$!]\n";
		}
		exec "test/prog/$p";
		print STDERR "$0: Can't exec test/prog/$p [$!]\n";
		exit $!;				# Return exec's error code.
	}
	if (-x "test/check/$p") {	# Is there a test/check program?
		($ss,$mm,$hh) = localtime($t1 = time);
		$tt = sprintf("%02d:%02d:%02d",$hh,$mm,$ss);
		$t = $t1 - $t0;
		print "$tt Test $p check ...\n";
		if ($child = fork) {	# Parent.
			waitpid($child,0);
			$stat = $?;
			$code = ($stat >>8);
			$sgnl = ($stat & 0xFF);
		} else {				# Child.
			exec "test/check/$p";
		}
		($ss,$mm,$hh) = localtime($t1 = time);
		$tt = sprintf("%02d:%02d:%02d",$hh,$mm,$ss);
		if ($?) {
			print "$tt Process $child exited with status $stat (code $code signal $sgnl)\n"
		} else {
			print "$tt Test $p succeeded ($t sec).\n";
		}
		next program;
	}
	# No test/check program for this one.
	if (-f "test/stdout/$p") {	# Does it have a test/stdout file?
		$diff = `diff test/out/$p test/stdout/$p >/dev/null`;
		if ($stat = $?) {		# No difference.
			print "Test $p test/out/$p differs from test/stdout/$p\n";
		}
	}
	if (-f "test/stderr/$p") {	# Does it have a test/stderr file?
		$diff = `diff test/err/$p test/stderr/$p >/dev/null`;
		if ($stat = $?) {  		# No difference.
			print "Test $p test/err/$p differs from test/stderr/$p\n";
		}
	}
	($ss,$mm,$hh) = localtime($t1 = time);
	$tt = sprintf("%02d:%02d:%02d",$hh,$mm,$ss);
	$t = $t1 - $t0;
	if ($stat) {
		print   "$tt Test $p failed ($t sec)\n";
		print F "$tt Test $p failed ($t sec)\n";
		exit 1;
	} else {
		print "$tt Test $p succeeded ($t sec)\n";
	}
}