:
#!/bin/sh -- # -*- perl -*-
# $Id: checktest,v 1.1.1.2 2004/10/04 17:25:17 nthiery Exp $
# alas, perl is in diefferent places in old and new installations.
# So, this one gets necessary:
eval 'exec perl -w -S $0 ${1+"$@"}'
    if 0;
# It's a NOP for perl, but shells parse line-oriented. Standard hack.
#
# This parses the .tst files generated by a LaTeX run on MuPAD documentation
# and tries to verify the results.
#
# ccr, 30.3.99
use IO::File;
use IPC::Open2;
use Getopt::Long;

my $textwidth=63;
my $MuPAD_name = "dmupad";
my $MuPAD_library = undef;
my @MuPAD_packpath = ();
my $check_inputs = 0;
my $timeout = 600; # 10 Minuten
my $verbose = 0;
my $init = "";

GetOptions("textwidth=i" => \$textwidth,
	   "MuPAD=s"     => \$MuPAD_name,
	   "libpath=s"   => \$MuPAD_library,
           "packpath=s"  => \@MuPAD_packpath,
	   "inputs!"     => \$check_inputs,
           "verbose+"    => \$verbose,
	   "timeout=i"   => \$timeout,
	   "init=s"      => \$init);

$ARGV[0] || die "Usage: $0 file.tst [file.tst ...]\nOptions: --textwidth=<int>, --MuPAD=<bin>, --libpath=<path>\n     --packpath=<path> --inputs/--noinputs --timeout=<seconds> --verbose --init=<MuPAD code>\n";

# $MuPAD_library && warn "Explicit libpath set.\nExamples with file descriptors in output will produce errors.\n";

# MuPAD-Voreinstellungen
my $prettyprint=1;
my $userinit = new IO::File("userinit.mu", O_WRONLY|O_CREAT)
    or die "Can't write userinit.mu: $!\n";
$userinit->print(<< "EOF");
TEXTWIDTH:=$textwidth:
Pref::typeCheck(Always):
testargs(TRUE):
//  proc()
//      local i, l, tar;
//  begin
//      tar := FALSE;
//      l := length(LIBPATH);
//      for i from 0 to l - 1 do
//        if LIBPATH[i] = "#" then
//  	  tar := TRUE;
//  	  break;
//        end_if
//      end_for;
//      if not tar then fclose(fopen("/etc/passwd")) end;
//  end_proc():
$init
EOF
$userinit->close();

$SIG{__DIE__} = sub { unlink "userinit.mu"; }; 

# Konstanten zur Kommunikation, 
# siehe DEV/KERNEL/MPR_protocol.h
my %constants = ( 'input'       => chr(1),
		  'output'      => chr(2),
		  'error'       => chr(9),
		  'prompt'      => chr(13),
		  'syntaxerror' => chr(25), # unused?
		  'quit'        => chr(29),
		  'start'       => chr(6),
		  'end'         => chr(7),
		  'mask'        => chr(8),
		  'prettyprint' => chr(7),
		  'gfx'         => chr(17),
		  );
my $valid_char="[^$constants{'end'}$constants{'mask'}]";
my $start="(?:^|[^$constants{'mask'}])$constants{'start'}";
my $start_unknown=$start."[^$constants{'output'}$constants{'error'}$constants{'prompt'}$constants{'prettyprint'}]";
my $start_output=$start."[$constants{'output'}$constants{'error'}]";
my $start_prompt=$start.$constants{'prompt'};
my $start_gfx=$start.$constants{'gfx'};
my $msg_content="(?:$valid_char)*".
    "(?:$constants{'mask'}.$valid_char)*";


# We need to detect the prompt.  Use something which does not occur
# in the usual output.
my $prompt="-------";

# We use the global handles RDR and WTR.
my ($MuPAD_write, $MuPAD_read);
$MuPAD_write=new IO::File;
$MuPAD_read=new IO::File;

my $patchfile = $ARGV[0];
$patchfile =~ s/\.tst/\.patch/;

# Experimental feature: when called as checktest bla.tst, creates a file
# bla.patch containing a multi-file patch which replaces each expected
# output in the document file by the actual MuPAD output. Of course,
# this patch is to be used with great care! It is mainly intended for
# interactive application with, for example, epatch under emacs.
my $patch = new IO::File(">$patchfile");

# First of all, open a fresh MuPAD session.
&startsession();

# Then, start reading the file
my $curr_mode="started";
my $count_inputlines=0;
my $ex_lineno="unknown";
my $ex_filename="unknown";
my @test_output=();
my @test_input=();
my @stored_input=();
my @MuPAD_output=();
my %handle_line=( "write" => sub { push @test_input, $_;
#  zum Auffinden von Haengern
                                   warn "Input: $_" if $verbose;
			       },
		  "read"  => sub { chomp; push @test_output, $_; },
		  'started' => sub {warn "This shouldn't happen!\n"; } );

while(<>) {
    m|^<<<I>>>(\d*)/(.*)$| && do {
				   &finish_read() if @test_input > 0;
				   $curr_mode="write";
				   $ex_lineno = $1;
				   $ex_filename = $2;
                                   warn (("-"x20)." $ex_filename, $ex_lineno\n")
                                       if $verbose;
				   &start_write();
				   next; };
    m|^<<<O>>>$| && do {
			 &start_read();
			 $curr_mode="read";
			 next; };
    m|^<<<R>>>$| && do {
			 &finish_read();
			 &startsession();
			 $curr_mode="started";
                         warn "="x30, "\n"
                             if $verbose;
			 next; };
# else/default:
    &{$handle_line{$curr_mode}}($_);
}

&finish_read() if @test_input > 0 or @test_output > 0;
&close_session();

$patch->close();

unlink("userinit.mu");

######################################################################

sub startsession {
    &close_session() if ($MuPAD_write->opened);
    open2($MuPAD_read, $MuPAD_write, "$MuPAD_name -S -u . -R" .
	  ($MuPAD_library ? " -l $MuPAD_library" : '') .
          ' '.(join(' ', map { '-p '.$_} @MuPAD_packpath)));
# Prompt weglesen
    &get_output();
    autoflush $MuPAD_write 1;
}

sub send_command {
    &startsession() unless $MuPAD_write->opened;
    print $MuPAD_write
	$constants{'start'}, $constants{'input'},
	@_, $constants{'end'};
}

sub check_input {
    return unless @test_input;
    my $old_pretty = $prettyprint;
    print $MuPAD_write
	$constants{'start'}, $constants{'prettyprint'},
	'0', $constants{'end'},
	$constants{'start'}, $constants{'input'},
	'hold((', @test_input, '))', "\n", $constants{'end'};
    my $out = &get_output();
    print $MuPAD_write
	$constants{'start'}, $constants{'prettyprint'},
	$old_pretty, $constants{'end'},
	$constants{'start'}, $constants{'input'},
	'null()', $constants{'end'};
    &get_output();
    my ($input, $output) = ('', '');
    my @tmp = @test_input;
    foreach (@tmp) {
	chomp;
	s/^\s*//;
	$input .= $_.' ';
    }
    @tmp = split('\n', $out);
    foreach (@tmp) {
	chomp;
	s/^\s*//;
	s/\\$//;
	$output .= $_.' ';
    }
    
    if($input ne $output) {
	$output =~ s/ $/: /;
	if($input ne $output) {
	    $output =~ s/: $/; /;
	    if($input ne $output) {
		chomp $out;
		$out =~ s/\n/\n> /g;
		warn "Input starting at line $ex_lineno in file $ex_filename\n",
		"formatted incorrectly:\n< ", join("< ", @test_input), "\n> ",
		$out, "\n";
	    }}}
}

sub get_output {
    my $output='';
    my $everything='';
    eval {
	local $SIG{ALRM} = sub { die "Alarm\n"; };
	local $SIG{__DIE__} = sub { ; };
	alarm $timeout;
	while( sysread($MuPAD_read, $_, 1024) ) {
	    alarm $timeout;
	    $everything .= $_;
# Schritt 1: komplette Nachrichten unbekannten Typs entfernen
#	    print "Unbekannte Nachricht: $1\n\n" while
#		$everything =~ 
#		    s/(${start_unknown}${msg_content}${constants{'end'}})//o;
# Schritt 2: komplette Ausgaben an $output anhaengen.
	    while ($everything =~ 
		   s/$start_output($msg_content)$constants{'end'}//o) {
		$output .= $1;
	    }
# Schritt 3: Änderungen von PRETTYPRINT speichern
	    while ($everything =~
		   s/$start$constants{'prettyprint'}
		   ($msg_content)$constants{'end'}//ox) {
		$prettyprint = $1;
	    }
# Schritt 4: Grafik-Ausgaben: Datei löschen
##            while ($everything =~
##                   s/$start_gfx($msg_content)$constants{'end'}//ox) {
##                warn "deleting graphics file $1\n";
##                unlink $1;
##            }
### Hack: For some reason or other, the 'end-of-message' constant
###       gets lost very often for this message.  If it's not there,
###       go ahead anyway.
            while ($everything =~
                   s{$start_gfx([-_/a-zA-Z0-9]+)($constants{'end'})?}{}ox) {
                warn "deleting graphics file $1\n";
                unlink $1;
                warn "End-of-message token was lost!\n"
                    unless $2;
            }
# Schritt 5: Wenn ein Prompt ausgegeben wurde, sind wir fertig
	    last if $everything =~
		m/$start_prompt$msg_content$constants{'end'}/o;
	}
	alarm 0;
    };
    if ($@) {
	die unless $@ eq "Alarm\n";
	warn "*** Timeout ***\n";
	&startsession();
    }
    $output =~ s/ *$//mg;
    return $output;
}

sub close_session {
    print $MuPAD_write "$constants{'start'}$constants{'quit'}$constants{'end'}";
    close $MuPAD_write;
    # collect return status of the mupad process
    # otherwise we generate tons of zombies in larger helpfiles
    wait; 
    while (<$MuPAD_read>) {};
    close $MuPAD_read;
}

sub start_read { @test_output = (); }
sub start_write { @test_input = (); @stored_input=(); }

my $ex_lastfilename;
my $ex_linenoshift;

sub print_error {
    my $msg = shift;

    # Append error to the patch file

    # Try to guess the line number of the first line of the output;
    # This is only exact for examples which are formated exactly as:
    # \begin{mexin}
    #   ...
    # \end{Mexin}
    # \begin{Mexout}
    # ...
    # This should not be so bad, since the error won't in practice
    # exceed 1 or 2 lines, and patch should be able to deal with it
    #
    # BUG: spaces at the end of output lines in the .tex file are
    # stripped in the latex-produced .tst. The checktest-produced
    # patch is thus incorrect, and cause rejections when there are
	# such spaces.

    my $lineno = $ex_lineno + @stored_input + 3;

    defined($ex_lastfilename) && $ex_lastfilename eq $ex_filename or do {
		# Entering new file
		$ex_linenoshift=0; # reset the lineshift counter
		$ex_lastfilename = $ex_filename;
		# Print file information
		# FIXME: give some sensible value to the dates below
		$patch->print
			("--- ", $ex_filename, ".tex	2004-09-25 23:19:02.115866080 +0200\n",
			 "+++ ", $ex_filename, ".tex	2004-09-25 23:19:02.115866080 +0200\n")
				unless $ex_filename eq "consistencyCheck";
	};
	$patch->print
		("@@ -", $lineno , ",", scalar(@test_output),
		 " +", $lineno+$ex_linenoshift, ",", scalar(@MuPAD_output), "@@\n",
		 (map { "-$_\n" } @test_output),
		 (map { "+$_\n" } @MuPAD_output))
			unless $ex_filename eq "consistencyCheck";
    $ex_linenoshift += $#MuPAD_output - $#test_output;

    # Diagnose the error on STDERR

    warn "-"x70, "\n", $msg,
    "\n(Input starts at line $ex_lineno in file $ex_filename.)\n",
    "Command input:\n", @stored_input,
    "*** Output listed in $ex_filename:\n", join("\n", @test_output),
    "\n*** Output generated by $MuPAD_name:\n", 
    join("\n", @MuPAD_output),"\n";
}

sub finish_read {
    &check_input()
	if $check_inputs;
    &send_command(@test_input);
    @stored_input = @test_input;
    @test_input = ();
    $curr_mode eq 'started'
        and return;
    my $output=&get_output();
# Skip first empty line
    $output =~ s/^\n//;

    @MuPAD_output= split("\n", $output);

# Compare the output generated by MuPAD with the claimed output
# Compare the number of lines
  if ( @MuPAD_output != @test_output ) {
      &print_error("Different number of input/output lines");
  } else {
      my $error = 0;
      foreach $i (0 .. $#MuPAD_output) {
	  if ($MuPAD_output[$i] ne $test_output[$i]) { $error++; }
      }
      if ($error > 0) {
	  &print_error("$error lines differ.");
      }
  }
#  $count_inputlines = 0;
    @test_output = ();
}

## Local Variables: ***
## mode:perl ***
## End: ***
