#! /usr/bin/perl -w

# Run scribe.perl regression tests.
#
# Author: David Booth
#
# Usage:
# 	perl regtest.perl [-a] [-n] [inputTestFile...]
#
# To use regtest.perl:
# 1. Edit okdiffs.perl to clear it to a virgin state, to avoid 
# inappropriately suppressing differences.
# 2. Run regtest.perl with no args and note any tests that fail.  A test
# that fails may either indicate a new bug in scribe.perl, or it
# may indicate a legitimate change in the output.
# 3. For legitimate differences that have global effects (making it
# hard to see illegitimate differences), tweak okdiffs.perl as 
# needed to suppress them.
# 4. When all differences have been verified as legitimate, use 
# the -a option to accept the new output as correct, which
# will cause it to be used as the known-correct output next time.
#
# Options:
# 	-a	Accept new version as correct even though it differs from old.
# 		This causes the -out.htm file to be renamed to -prevout.htm
# 		(as a backup) and the -new.htm file to be renamed to -out.htm.
#
# 	-n	New version becomes old version (when no old version exists)
#
# Default inputTestFiles are *-in.* in the test-cases directory.
#
# Test filenames must be of the form:
# 	*-in.*		Input test file
# 	*-out.htm	Correct output file
# 	*-new.htm	New output file (generated by regtest.perl)
#	*-diffs.txt	Diffs between *-out.htm and *-new.htm (generated)
#	*-stderr.txt	New stderr file (generated; not currently used)
# Other file:
# 	*-prevout.htm	Previous correct output file.  Created by -a option.
#
# For each inputTestFile such as *-in.* there should be a
# corresponding -out.htm file with the correct (desired) scribe.perl
# output for *-in.*.  Corresponding -new.htm 
# and -stderr.txt files are generated, and a -diffs.txt file is 
# generated if there are important differences between -new.htm
# and -out.htm.  
#
# Any files called junk* are ignored.
#
# Diffs are also piped through okdiffs.perl, which can and should be
# customized to filter out ignorable diffs for the changes to
# scribe.perl that you are currently making.  It should be a no-op
# if the program changes that you are making to scribe.perl should not 
# change the output at all.
#
# Note also that certain differences are routinely ignored, such
# as those involving version numbers and dates.  Search for "diff "
# and see the $ignore pattern to see what is always ignored.

use Getopt::Std;
my %opts;
getopts('an', \%opts);

my @files = @ARGV;
@files = <test-cases/*-in.*> if !@files;	# Default to all
# Change *-diffs.txt etc. to *-in.txt:
@files = map { 
	s/\-(out|new|diffs|stderr)\.([^\.]+)/\-in\.$2/; 
	# Try different extensions if necessary:
	s/\.txt\Z/\.htm/ if !-e;
	s/\.htm\Z/\.html/ if !-e;
	s/\.html\Z/\.rdf/ if !-e;
	s/\.rdf\Z/\.txt/ if !-e; 	# Give up and default back to .txt
	$_ 
	} @files;
# die "files: @files\n";

# Now process them
my $nNew = 0;
my $nPass = 0;
my $nFail = 0;
foreach my $fIn (@files)
	{
	# warn "NEXTTTTT: $fIn\n";
	next if $fIn =~ m/\Ajunk/i;
	next if $fIn =~ m/\A\-/;
	my ($fBase) = &BaseNames($fIn);
	# warn "fIn: $fIn  fBase: $fBase\n";
	my $fOutOld = "$fBase\-out\.htm";
	my $fOutNew = "$fBase\-new\.htm";
	my $fDiffs = "$fBase\-diffs\.txt";
	my $fStderr = "$fBase\-stderr\.txt";
	die if $fOutOld eq $fIn;
	if (!-e $fIn)
		{
		warn "ERROR: File not found: $fIn\n";
		next;
		}
	my $scribePerl = "../scribe.perl";
	my $scribeOptions = "-embedDiagnostics";
	my $cmd = "$scribePerl $scribeOptions $fIn 1> $fOutNew 2> $fStderr";
	# warn "$cmd\n";
	my $result = `$cmd`;
	chomp $result;
	die "$result\n" if $result;
	if (-e $fOutOld)
		{
		my $ignore = "-I '\\(\\\$Date\\:\\|\\Revision\\:\\|\\~checkout\\|version\\|\\(\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|Oct\\|Nov\\|Dec\\)\\ 2005\\)\\)'";
		$cmd = "diff $ignore $fOutOld $fOutNew |perl okdiffs.perl > $fDiffs";
		# warn "$cmd\n";
		my $diffDiag = `$cmd`;
		chomp($diffDiag);
		die "$diffDiag\n" if $diffDiag;
		if (-z $fDiffs) 
			{ 
			$nPass++;
			# warn "\nPass $fOutNew\n"; 
			print STDERR "."; 
			unlink $fDiffs || warn "  Could not unlink empty $fDiffs\n";
			unlink $fOutNew || warn "  Could not unlink unneeded $fOutNew\n";
			}
		else 	{ 
			$nFail++;
			warn "\nFAIL $fOutNew\n"; 
			if ($opts{'a'}) # accept diffs?
				{
				my $fPreviousOut = "$fBase\-prevout.htm";
				warn "  Renaming $fOutNew to $fOutOld\n";
				# (unlink($fOutOld) && rename($fOutNew, $fOutOld)) || warn "  Could not rename $fOutNew to $fOutOld\n";
				(rename($fOutOld, $fPreviousOut) && rename($fOutNew, $fOutOld)) || warn "  Could not rename $fOutNew to $fOutOld\n";
				unlink($fDiffs) || warn "  Could not unlink $fDiffs\n";
				}
			}
		}
	else	{
		$nNew++;
		warn "\nNew  $fOutNew\n";
		if ($opts{'n'}) # accept new?
			{
			warn "  Renaming $fOutNew to $fOutOld\n";
			(rename($fOutNew, $fOutOld)) || warn "  Could not rename $fOutNew to $fOutOld\n";
			}
		}
	}
warn "\n$nPass Pass\n";
warn "$nFail FAIL!!!\n" if $nFail;
warn "$nNew New\n" if $nFail;


################# BaseNames ###################
sub BaseNames
{
# Get the base names of the files
my %uniqFiles = ();
my @baseFiles = ();
foreach my $fRaw (@_)
	{
	my $fBase = $fRaw;
	$fBase =~ s/\.txt\Z//;
	$fBase =~ s/\.htm\Z//;
	$fBase =~ s/\-in\Z//;
	$fBase =~ s/\-out\Z//;
	$fBase =~ s/\-new\Z//;
	$fBase =~ s/\-diffs\Z//;
	$fBase =~ s/\-stderr\Z//;
	if (!exists($uniqFiles{$fBase}))
		{
		$uniqFiles{$fBase} = $fRaw;
		push(@baseFiles, $fBase);
		}
	}
return(@baseFiles);
}