#!/afs/athena/contrib/perl/perl
# $Header: /afs/athena.mit.edu/astaff/project/newtex/src/web2c-5.851d/RCS/triptrapdiff.pl,v 1.1 94/05/19 08:20:30 bert Exp Locker: bert $

# defaults

$th_glue = 0.001;		# discrepancy tolerance glue, in fil's
$th_step = 300;			# tolerance for DVI positions, in 1/65536in

# verbosity control

$showdelta = 1;
$showstats = 1;

# arguments

($fn1 = shift(@ARGV))
    || die __FILE__," (line ",__LINE__,"): Two filename arguments required!\n";
($fn2 = shift(@ARGV))
    || die __FILE__," (line ",__LINE__,"): Two filename arguments required!\n";

open($fn1, $fn1) || die __FILE__," (line ",__LINE__,": Can't open $fn1!\n";
open($fn2, $fn2) || die __FILE__," (line ",__LINE__,": Can't open $fn2!\n";

# main loop

while(1) {
    ($str1,$eof1,$ln1) = &readline($fn1);
    ($str2,$eof2,$ln2) = &readline($fn2);

    if ($eof1 && $eof2) { exit 0; }
    if ($eof1) {
	print "@@ Mismatch: $fn2 is longer than $fn1.\n";
	print "@@ Offending line ($fn2 line $ln2):\n$str2";
	&error(22);
    }
    if ($eof2) {
	print "@@ Mismatch: $fn1 is longer than $fn2.\n";
	print "@@ Offending line ($fn1 line $ln1):\n$str1";
	&error(22);
    }

    $err = &match($str1,$str2);
    if ($err) {
	print "@@ Mismatch: $err.\n";
	print "@@ Offending lines:\n";
	print "   $fn1 line $ln1:\n$str1";
	print "--------\n";
	print "   $fn2 line $ln2:\n$str2";
	&error(22);
    }
}

# compare two lines
sub match {
    local($line1,$line2) = @_;

    # if they're equal, they're equal.
    return undef if ($line1 eq $line2);

    # if both say `glue set', check if the differences are OK.
    if ((@m1 = ($line1 =~ /^\\[hv]box(.*)glue set ([\d.]+)fil/)) &&
	(@m2 = ($line2 =~ /^\\[hv]box(.*)glue set ([\d.]+)fil/))) {
	return 'box dimensions differ' unless ($m1[0] eq $m2[0]);
	$glue = &abs($m1[1]-$m2[1]);
	return 'difference exceeds $th_glue' if ($glue > $th_glue);
	printf "@@ OK glue set: %8.5ffil ($m1[1] vs $m2[1])\n", $glue
	    if $showdelta;
	return undef;
    }

    # positioning commands
    if ((@m1 = ($line1 =~ /^(\d+):\s+(down|y|z|right|w|x)(\d)\s+(\d+)\s*$/)) &&
	(@m2 = ($line2 =~ /^(\d+):\s+(down|y|z|right|w|x)(\d)\s+(\d+)\s*$/))) {
	return 'positions are different' unless ($m1[0] eq $m2[0]);
	return 'commands are different'
	    unless (($m1[1] eq $m2[1]) && ($m1[2] eq $m2[2]));
	$step = &abs($m1[3]-$m2[3]);
	return 'difference exceeds $th_step' if ($step > $th_step);
	printf "@@ OK $m1[1]$m1[2]: $step ($m1[3] vs $m2[3])\n" if $showdelta;
	return undef;
    }

    # usage stats
    if ((@m1 = ($line1 =~ /^\s*(\d+) ([a-z ]+) out of \d+$/)) &&
	(@m2 = ($line2 =~ /^\s*(\d+) ([a-z ]+) out of \d+$/))) {
	return 'usage stats are of different types' unless ($m1[1] eq $m2[1]);
	print "@@ usage of $m1[1]: $m1[0] vs $m2[0]\n" if $showstats;
	return undef if ($m1[0] eq $m2[0]);
	print "@@ WARNING: usage stats for $m1[1] differ ($m1[0] vs $m2[0])\n";
	return undef;
    }
    if ((@m1 = ($line1 =~ /^String usage (\d+&\d+) /)) &&
	(@m2 = ($line2 =~ /^String usage (\d+&\d+) /))) {
	print "@@ string usage: $m1[0] vs $m2[0]\n" if $showstats;
	print "@@ WARNING: string usage differs ($m1[0] vs $m2[0])\n"
	    unless ($m1[0] eq $m2[0]);
	return undef;
    }

    # oops, I guess we are stuck.
    return 'the lines are... different';
}

# absolute values
sub abs { (@_[0] >= 0) ? @_[0] : -@_[0] }

# `trivial' lines, i.e. banners, should be ignored.
sub trivial {
    local($_) = @_;
    return (/^This is (TeX|METAFONT|DVItype|GFtype), Version/
	    || /^\s*'\s*(TeX|METAFONT) output [\d.:]+'\s*$/
	    || /^\s*\((preloaded )?(format=trip|base=trap) [\d.]+\)\s*$/
	    || /^\s*\d+ strings of total length \d+\s*$/
	    || /^\s*out of \d+w,\d+h,\d+d,\d+i,\d+l,\d+k,\d+e,\d+p\)\s*$/
	    || /^\**\s*\&tr[ia]p\s+tr[ia]p\s/
	    || /^\**\((trip.tex|trap.mf)/);
}

# read in a line from the filehandle passed in as argument
sub readline {
    local($file) = @_[0];
    do {
	local($line) = scalar(<$file>);
	print $line if $printlines;
	if (! $line) {
	    return ('', 1, $.);
	}
    } while (&trivial($line));
    print "$file($.): $line" if $printlines;
    return ($line, 0, $.);
}

# flag an error
sub error {
    print <<"EndOfMessage";
@@ I found a mismatch that I can't account for.
@@ That can mean one of two things: either trip/trap just failed, or
@@ the rules I use to determine allowable differences are incomplete.
@@ In any case, a human with a clue should look at the two files I was
@@ comparing and figure out what's going on.
@@
@@ (If you are the responsible human and are looking for the clue: see
@@ web2c/tex/TeXtrip/tripman.tex and web2c/mf/MFtrap/trapman.tex.)
@@
@@ If trip/trap did fail, try compiling with less or no optimization.
@@ Changes won't take effect unless you make clean (or clean-triptrap)!
EndOfMessage

    exit @_;
}