#!/usr/athena/bin/perl
# $Header: /afs/sipb.mit.edu/project/tex-dev/repository/texk/web2c/triptrapdiff.pl,v 1.3 1997/10/22 05:17:20 amu Exp $
# Originally by bert; minor modifications by amu.
# 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(17);
    }
    if ($eof2) {

	print "\@\@ Mismatch: $fn1 is longer than $fn2.\n";
	print "\@\@ Offending line ($fn1 line $ln1):\n$str1";
	&error(17);
    }

    $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(17);
    }
}

# 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 [0-9+]+$/)) &&
	(@m2 = ($line2 =~ /^\s*(\d+) ([a-z ]+) out of [0-9+]+$/)))
    {
	return 'usage stats are of different types' unless
	    ($m1[1] eq $m2[1] || "$m1[1]s" eq $m2[1] || $m1[1] eq "$m2[1]s");
	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;
    }
    if ((@m1 = ($line1 =~ /^at most (\d+) strings of total length (\d+)/)) &&
	(@m2 = ($line2 =~ /^at most (\d+) strings of total length (\d+)/))) {
	$s1 = "$m1[0]&$m1[1]";
	$s2 = "$m2[0]&$m2[1]";
	print "\@\@ string usage: $s1 vs $s2\n" if $showstats;
	print "\@\@ WARNING: string usage differs ($s1 vs $s2)\n"
	    unless ($m1[0] eq $m2[0]);
	return undef;
    }
    if ((@m1 = ($line1 =~ /^Hyphenation trie of length (\d+) has (\d+) ops out of \d+/)) &&
	(@m2 = ($line2 =~ /^Hyphenation trie of length (\d+) has (\d+) ops out of \d+/))) {
	print "\@\@ Hyphenation trie length: $m1[0] vs $m2[0]\n" if $showstats;
	print "\@\@ WARNING: hyphenation tree length differs ($m1[0] vs $m2[0])\n"
	    unless ($m1[0] eq $m2[0]);
	print "\@\@ Number of hyphenation trie ops: $m1[1] vs $m2[1]\n" if $showstats;
	print "\@\@ WARNING: number of hyphenation tree ops differs ($m1[1] vs $m2[1])\n"
	    unless ($m1[1] eq $m2[1]);
	return undef;
    }

    # ignore changes in whitespace
    $line1b = " $line1 "; $line1b =~ s/\s+/ /g;
    $line2b = " $line2 "; $line2b =~ s/\s+/ /g;
    if ($line1b eq $line2b) {
	print "\@\@ ignoring whitespace difference\n";
	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|e-TeX|METAFONT|DVItype|GFtype|MetaPost),( C)? Version/
	    || /^\s*'\s*(TeX|METAFONT) output [\d.:]+'\s*$/
	    || /^\s*\((preloaded )?(format=trip|base=trap|mem=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*\d+i,\d+n,\d+p,\d+b stack positions out of \d+i,\d+n,\d+p,\d+b/
	    || /^\**\s*\&tr[ia]p\s+tr[ia]p\s/
	    || /^\**\((trip.tex|trap.mf)/
	    || /^\s*(write|\\openout)\d+ = /
	    || /^\s*%%CreationDate:/
	    || /^\s*\d+ string compactions \(moved \d+ characters, \d+ strings\)/
	    || /^\s*entering (compatibility|extended) mode/
	    || /^\s*$/);
}

# 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 $_[0];
}