1 files changed, 123 insertions, 0 deletions
diff --git a/Master/support/tests/checkdvi.pl b/Master/support/tests/checkdvi.pl
new file mode 100755
index 00000000000..9c6eff2172d
--- /dev/null
+++ b/Master/support/tests/checkdvi.pl
@@ -0,0 +1,123 @@
+#!/usr/local/bin/perl
+# dvicheck -- DVI autotest helper.
+# $Id: //depot/Master/support/tests/checkdvi.pl#1 $
+# 
+# Public domain.
+# Originally written as a shell script by Patrice Dumas.
+# Revised version written in Perl by Karl Berry.
+# 
+# (Although it's much simpler and more functional in sh, Perl makes it
+# possible to run on Windows, for TeX Live, etc.  I hope someone cares
+# some day.)
+
+exit (&main ());
+
+sub main
+{
+  if (@ARGV != 2) {
+    print <<END_USAGE;
+Usage: $0 DVITYPE_KNOWN_GOOD DVI_TO_CHECK
+
+Run dvitype on DVI_TO_CHECK, and compare against DVITYPE_KNOWN_GOOD,
+ignoring the DVI comment.  DVI_TO_CHECK is assumed to be the straight
+output from dvitype (full output), including the banner line.
+
+For autotesting.
+END_USAGE
+    return 1;
+  }
+
+  my $good_type = $ARGV[0];
+  my $check_dvi = $ARGV[1];
+
+  die "No DVI file $check_dvi" if ! -s $check_dvi;
+  die "No good dvitype file $good_type" if ! -s $good_type;
+
+  # run dvitype on the file to test.
+  my $check = &snarf_output ("dvitype", $check_dvi);
+  
+  # remove extraneous comments from the known good dvitype output.
+  my $good = &clean_file ($good_type);
+  
+  # they should be exactly the same.
+  my $ret = $check ne $good;
+  if ($ret) {
+    warn "$0: ${check_dvi}type different from $good_type.\n";
+    warn "check=$check\n";
+    warn "good=$good\n";
+    &save_file ("${check_dvi}type", $check);
+    system ("diff", "${check_dvi}type", $good_type);
+  }
+  
+  return $ret;
+}
+
+
+# 
+# Run PROGRAM on ARGS, running output with clean_dvitype and returning as
+# a string.
+# 
+sub snarf_output
+{
+  my ($program,@args) = @_;
+
+  # use safe (more or less) form of open.
+  local *PROG;
+  open (PROG, "-|", $program, @args) ||die "open($program @args |) failed: $!";
+  my @lines = <PROG>;
+#warn "read lines from $program @args:\n@lines";
+  close (PROG) || warn "close($program @args |) failed: $!";
+  
+  return &clean_dvitype (@lines);
+}
+
+
+# 
+# Read file, run through clean_dvitype, and return as a string.
+# 
+sub clean_file
+{
+  my ($file) = @_;
+
+  local *FILE;
+  open (FILE, $file) || die "open($file) failed: $!";
+  # read whole file.
+  my @lines = <FILE>;
+  close (FILE) || warn "close($file) failed: $!";
+  
+  return &clean_dvitype (@lines);
+}
+
+
+# 
+# Clean dvitype output.  Make the first element of LINES be the empty
+# string (this contains the version number), and excise the first '...'
+# string (this is the DVI comment, which typically contains the date).
+# Return resulting string.
+# 
+sub clean_dvitype
+{
+  my (@lines) = @_;
+  
+  $lines[0] = "";
+  for my $line (@lines) {
+    last if $line =~ s/^'.*'//;
+  }
+  
+  my $clean = join ("", @lines);
+#warn "cleaned lines:\n@lines\ninto:$clean";
+  return $clean;
+}
+
+
+# 
+# Save STRING into FILE.  This will be the cleaned version, but that's ok.
+#
+sub save_file
+{
+  my ($file,$string) = @_;
+  local *FILE;
+  open (FILE, ">$file") || die "open(>$FILE) failed: $!";
+  print FILE $string;
+  close (FILE) || warn "close(>$FILE) failed: $!";
+}