#!/usr/bin/perl -w
##@(#)Copyright, 1996, Regents of University of California
##@(#)portions are (c) 1997 Graham THE Ollis
##==============================================================================
## test driver (tdr.pl)
## this program runs the given file and reports on
## how it worked out.  makes .ao (actual output) and
## compares it to .eo (expected output)
##
## History:
## Date       Author	Commented
## ----       ------	---------
## 20 May 96  G. Ollis	started & finished code
## 22 May 96  G. Ollis	added support for the ERR files
##			also made the code look nice
## 23 May 96  G. Ollis	added some command line options
##			-i for interactive
##			-v to include warnings
##			-s to display the signal sent to the test program
## 24 May 96  G. Ollis  trap the no command line arguments thing
##			check to see if the program is executable
## 29 May 96  G. Ollis  treat each argument as a command
##			rather than whole line is a cmdline
## 30 May 96  G. Ollis	one line output mode
## 3  Jun 96  G. Ollis	changed local() to my()
## 12 Jun 96  G. Ollis	changed $log back to local()
##			added accounting for the data
##			append to log file unless using the
##			fixed the code!  (it works this time)
## 2  Aug 96  G. Ollis	fixed a few little things, added documentation.
## 27 Feb 97  G. Ollis	return non zero if a difference is found.
##			added return value checking.
##			all the bases are covered in glue now, carefull you
##			don't fall down.
##==============================================================================
## see man page for more information.  (or POD below)

require 5;		# this funny thing doesn't even do anything but is a
			# great visual aid for the version impaired.

## GLOBALS
$VERSION	= '0.71';  if($VERSION) {}
$LOG_FILE_NAME	= 'tdr.log';		# where to put the test driver log
$DATE_CMD	= 'date | cut -c5-';	# date command

## options stuff
$interactive = 0;	# (-i) by default to non-interactive
$verbose = 0;		# (-v) by default don't print out warnings
$overWrite = 0;		# (-o) by default, DO NOT overwrite log file

$return_value = 0;	# this is the value which will be returned
			# assuming it is a "normal" execution.

$0 =~ s!^.*/!!g;

unless(defined($ARGV[0])) {
  print STDERR "usage: $0 [-v  [-i] ] [-o] cmd [args]\n";
  exit 2;
}

while($ARGV[0] =~ /^-/) {
  $arg = shift(@ARGV);
  $interactive = 1 if($arg eq '-i');
  $verbose = 1 if($arg eq '-v');
  $overWrite = 1 if($arg eq '-o');
}

if((-e $LOG_FILE_NAME) and ($overWrite == 0)) {
  open(LOG,">>$LOG_FILE_NAME");
} else {
  open(LOG,">$LOG_FILE_NAME");
}

for(@ARGV) {
  &testProgram($_);
}

exit $return_value;

##==============================================================================
## testProgram
## test the given program, make the right files
##
## INPUT : program name
## OUTPUT : debuging fles
##==============================================================================

#void
sub testProgram { # $progName
  $progName = $_[0];

  ## if the name given doesn't have the .t extension, add it unless
  ## there isn't a file without a .t extension the user wants to use.
  $progName .= ".t" unless(-x $progName);

  ## if the file given or file.t doesn't exist, then tell the user
  ## that he's going to have to do better.
  unless(-x $progName) {
    print "file doesn't exist, or permission denied.\n";
    exit 3;
  }

  ## all the file names are given here relative to the command given to tdr
  my $root;	($root = $progName) =~ s!\.t$!!;
  my $fileName = "$root.ao";
  my $errName = "$root.aERR";
  my $oldFileName = "$root.eo";
  my $oldErrName = "$root.eERR";
  my $diffFileName = "$root.diff";
  my $diffErrName = "$root.diffERR";
  my $retName = "$root.aRET";
  my $oldRetName = "$root.eRET";

  ## warn the user that a file is to be overwriten
  &checkFile($fileName);
  &checkFile($errName);
  &checkFile($retName);

  ## run the program, redirect as needed
  system "$progName 1> $fileName 2> $errName";

  my $exitValue = ($? >> 8);
  my $signalValue = ($? & 255);
  # right shift 8 bits - the wonders of perl.  2 values in 16 bit int
  # $exitValue is the value returned by the program
  # $signalValue is the signal used to terminate it

  ## save the return value for completeness
  open(RETURN, ">$retName") || die "could not open $retName for writing $!\n";
  print RETURN "exit($exitValue) signal($signalValue)\n";
  close RETURN;

  ## if there is expected output warn of differences
  my $outDiff = &checkDiff($fileName, $oldFileName, $diffFileName);
  my $errDiff = &checkDiff($errName, $oldErrName, $diffErrName);
  my $retDiff = &checkDiff($retName, $oldRetName, '/dev/null');

  local $log;		# don't tell anyone i used a local here...

  if(($outDiff==2) or ($errDiff==2) or ($retDiff==2)) {	# diff FAILED!
    $log = "diff FAILED\n";    
  } elsif(($outDiff==3) or ($errDiff==3)) {		# no expected output
    $log = "N/A\n";

  } elsif(($outDiff==0) and ($errDiff==0) and 
         (($retDiff==3) or ($retDiff==0)) ) {
    $log = "OK\n";
  } else {
    $log = '';
    $log .= 'STDOUT ' if $outDiff == 1;
    $log .= 'STDERR ' if $errDiff == 1;
    $log .= 'RETVAL ' if $retDiff == 1;
    $log .= "fail\n";
    $return_value = 4;
  }
   
  write;
  write LOG;

format STDOUT =
@<<<<<<<<<<<<<< @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$progName,	$log
.

format LOG =
@<<<<<<<<<<<<<<<<<<<<<<< : @<<<<<<<<<<<<<< @*
&getTime,		    $progName,	    $log
.

}

##==============================================================================
## getTime
## get the time for logging purposes
##
## INPUT : none
## OUTPUT : the time/date fully qualified as a string
##==============================================================================

#string
sub getTime { # void
  my($fred);

  chop($fred = `$DATE_CMD`);

  $fred;
}

##==============================================================================
## checkDiff
## this function actually checks the difference between the two files given
## and put those differences in a .diff file
##
## INPUT : expected, actual, and diff file names
## OUTPUT : exit value of diff
##==============================================================================

#int
sub checkDiff { # $actualFileName, $expetedFileName, $diffFileName

  my($fileName, $oldFileName, $diffFileName) = @_;
  my $exitValue = 3;
  my $cmd = "diff $fileName $oldFileName 1> $diffFileName";

  if(-e $oldFileName) {  # if the expected output file exists, then....
    &checkFile($diffFileName);
    system $cmd;
    $exitValue = $? >> 8;
    unlink $diffFileName, $fileName if $exitValue == 0;
  }
  $exitValue;	# 0 = no difference
		# 1 = difference
		# 2 = diff failed
		# 3 = no expected output
}

##==============================================================================
## checkFile
## this function checks to see if the file can be over writen.
##
## INPUT : filename
## OUTPUT : none
##==============================================================================

#void 
sub checkFile { # $fileName
  my $fileName = $_[0];
  my $inp;

  return if $fileName eq '/dev/null';

  return if($verbose == 0);
  if(-e $fileName) {
    print STDERR "warning, $fileName exists, ";
    if($interactive == 1) {
      print STDERR "overwrite? ";
      $inp = <STDIN>;
      exit 1 if($inp =~ /^n/);
    }
    print STDERR "overwriting.\n" if($interactive == 0);
  }
}

__END__

=head1 NAME

    tdr - test driver.

=head1 SYNOPSIS

B<tdr> [-v  [-i] ] [-o] C<cmd> [C<args>]

=head1 DESCRIPTION

tdr is a program for testing programs.  tdr executes C<cmd> and puts the
various standard streams in the apropriate places.  C<cmd> is intended to
be a here document with a .t extension.  If the extension exists, then
this part of the file name will be removed for the output streams.  If
there are expected output files present in the current directory, then tdr
will do a B<diff>(1) on the expected and actuall output and inform the
user that differences were found. 

=head1 FILES

all these files should be found in the current directory the test program
is named B<fred> or B<fred.t> in this case: 

=head2 GENERATED FILES

   fred.ao	- actual output created by tdr
   fred.aERR	- actual error stream created by tdr
   fred.diff	- differences (ie. unix diff) between actual and expected
		  output iff there is a difference
   fred.diffERR - differences between actual and expected error stream
   fred.aRET	- text file with the return value
   tdr.log      - log file for the test driver.  this file is appended to.

=head2 EXISTING FILES

   fred.eo	- expected output created by programmer
   fred.eERR	- expected error stream created by programmer
   fred.eRET	- expected return value

note that the diff files are only created if there is a difference.  the
program warns the user when a file is to be overwriten if -v option used
but doesn't prompt, unless the -i option is specified.  

=head1 OPTIONS

    -v      warn before over writing files.
    -i      prompt before over writing files.
    -o      do not overwrite log file.

=head1 RETURN VALUES 

   0 - normal execution 
   1 - user abort 
   2 - usage line 
   3 - file doesn't exist
   4 - difference between actual and expected output

=head1 SEE ALSO

B<diff>(1)

=head1 LEGAL

Copyright, 1996, Regents of University of California

portions are (c) 1997 Graham THE Ollis

=head1 AUTHOR

Graham THE Ollis E<lt>ollisg@lanl.govE<gt>

=cut

