#!/usr/bin/perl
#
# Copyright (C) 2005-2008 Heiko Appel, M. Oliveira, F. Nogueira
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2, or (at your option)
# any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
# 02110-1301, USA.
#

use Getopt::Std;
use File::Basename;
use Fcntl ':mode';
use POSIX qw(ceil);


sub usage {

  print <<EndOfUsage;

 Copyright (C) 2005-2008 by Heiko Appel, M. Oliveira, and F. Nogueira

Usage: ape-run_regression_test.pl [options]

    -f        filename of testsuite
    -d        working directory for the tests
    -D        name of the directory where to look for the executables
    -p        preserve working directories
    -n        dry-run
    -u        update reference values
    -t        update tolerances
    -h        this usage
    -i        print inputfile
    -l        copy output log to current directory
    -m        run matches only (assumes there are work directories)
    -v        verbose

Exit codes:
    0         all tests passed
    255       test skipped
    1..254    number of test failures

Report bugs to <micael\@teor.fis.uc.pt>.
EndOfUsage

  exit 0;
}


# Check, if STDOUT is a terminal. If not, not ANSI sequences are
# emitted.
if(-t STDOUT) {
    $color_start{blue}="\033[34m";
    $color_end{blue}="\033[0m";
    $color_start{red}="\033[31m";
    $color_end{red}="\033[0m";
    $color_start{green}="\033[32m";
    $color_end{green}="\033[0m";
}

if (not @ARGV) { usage; }

# Options
getopts("nlvhD:f:d:ipmut");

# Default values
use File::Temp qw/tempdir/;

# Handle options
$opt_h && usage;

if ($opt_d){
  $workdir = $opt_d;
} else {
  $workdir = tempdir('/tmp/ape.XXXXXX');
}

# -t and -u are mutually exclusive
die "-u and -t mutually exclusive" if ( $opt_t && $opt_u ); 

my $exec_directory;
if($opt_D) {
 $exec_directory = $opt_D;
 if($exec_directory !~ /^\//){
  $exec_directory = $ENV{PWD}."/$exec_directory";
 }
} else {
 $exec_directory = "/usr/bin";
}

# Find out if the executable is available.
opendir(EXEC_DIRECTORY, $exec_directory) || 
 die "Could not open the directory $exec_directory to look for the executable";
$available_exec = grep { /^ape$/ } readdir(EXEC_DIRECTORY);
if (!$available_exec){
  die "$color_start{red}No valid executable$color_end{red} found\n";
}
closedir(EXEC_DIRECTORY);

# We might need to run APE through some other application, like a debugger.
$aexec = get_env("EXEC");


# This variable counts the number of failed testcases.
$failures = 0;

chomp($workdir);

if (!$opt_m) {
  system ("rm -rf $workdir");
  mkdir $workdir;
}

# create script for cleanups in the current workdir
$mscript = "$workdir/clean.sh";
open(SCRIPT, ">$mscript") or die "could not create script file\n";
print SCRIPT "#\!/bin/bash\n\n";
print SCRIPT "rm -rf ae pp tests out.ape out *.UPF \n";
close(SCRIPT);
chmod 0755, $mscript;


# testsuite
open(TESTSUITE, "<".$opt_f ) or die "cannot open testsuite file\n";

# new updated file
if ($opt_t || $opt_u){
  open(NEW_TESTSUITE, ">".$opt_f.".new") or die "could not create new testsuite file\n";
}


while ($_ = <TESTSUITE>) {

  # preserve all lines that are not going to be updated
  if ( !($_ =~ /^match/) && ( $opt_t || $opt_u) ) {
    print NEW_TESTSUITE $_;
  }

  # skip comments
  next if /^#/;

  if ( $_ =~ /^Test\s*:\s*(.*)\s*$/) {
    $test{"name"} = $1;
    if(!$opt_i) {
      print "$color_start{blue} ***** $test{\"name\"} ***** $color_end{blue} \n\n";
      print "Using workdir    : $workdir \n";
      print "Using test file  : $opt_f \n";
    }
  }

  if ( $_ =~ /^Enabled\s*:\s*(.*)\s*$/) {
    %test = ();
    $enabled = $1;
    $enabled =~ s/^\s*//;
    $enabled =~ s/\s*$//;
    $test{"enabled"} = $enabled;
  }

  # Running this regression test if it is enabled
  if ( $enabled eq "Yes" ) {

    if ( $_ =~ /^Input\s*:\s*(.*)\s*$/) {
      $input_base = $1;
      $input_file = dirname($opt_f) . "/" . $input_base;
      $input_prefix = $opt_f;
      $input_prefix =~ s/test//;
      $input_base =~ s/$input_prefix//; 

      if( -f $input_file ) {
	print "\n\nUsing input file : $input_file \n";
	system("cp $input_file $workdir/inp.ape");
	# Ensure, that the input file is writable so that it can
	# be overwritten by the next test.
	$mode = (stat "$workdir/inp.ape")[2];
	chmod $mode|S_IWUSR, "$workdir/inp.ape";
      } else {
	die "could not find input file: $input_file\n";
      }

      if ( !$opt_m ) {
	if ( !$opt_n ) {
	  print "\nStarting test run ...\n";
	  print "Executing: cd $workdir; $aexec  $exec_directory/ape > out \n";
	  system("cd $workdir; $aexec $exec_directory/ape > out ");
	  system("sed -n '/Running ape/{N;N;N;N;N;N;p;}' $workdir/out > $workdir/build-stamp");
	  print "Finished test run.\n\n"; }
	else {
	  if(!$opt_i) { print "cd $workdir; $aexec $exec_directory/ape > out \n"; }
	}
	$test{"run"} = 1;
      }

      # copy all files of this run to archive directory with the name of the
      # current input file
      mkdir "$workdir/$input_base";
      @wfiles = `ls -d $workdir/* | grep -v inp`;
      $workfiles = join("",@wfiles);
      $workfiles =~ s/\n/ /g;
      system("cp -r $workfiles $workdir/inp.ape $workdir/$input_base");

      # file for shell script with matches
      $mscript = "$workdir/$input_base/matches.sh";
      open(SCRIPT, ">$mscript") or die "could not create script file\n";
      # write skeleton for script
      print SCRIPT "#\!/bin/bash\n\n";
      close(SCRIPT);
      chmod 0755, $mscript;

    }

    if ( $_ =~ /^match/ && !$opt_n) {
      if(run_match_new($_)){
	$test_succeeded = 1;
      } else {
	$test_succeeded = 0;
	$failures++;
      }
    }
    
  } else {
    if ( $_ =~ /^RUN/) { print " skipping test\n"; }
  }
}

if ($opt_l)  { system ("cat $workdir/out >> out.log"); }
if (!$opt_p && !$opt_m && $test_succeeded) { system ("rm -rf $workdir"); }

print "\n";
close(TESTSUITE);

if ($opt_t || $opt_u){
  close(NEW_TESTSUITE);
  `rm -f $opt_f.new` if (!$failures);
}

exit $failures;



sub run_match_new(){
  die "Have to run before matching" if !$test{"run"} && !opt_m;

  # parse match line
  my $line, $match, $name, $pre_command, $ref_value, $precision;
  $line = @_[0];
  $line =~ s/\\;/_COLUMN_/g;
  ($match, $name, $pre_command, $ref_value, $precision) = split(/;/, $line);
  $pre_command =~ s/_COLUMN_/;/g;
  $ref_value =~ s/^\s*//;
  $ref_value =~ s/\s*$//;
  $precision =~ s/^\s*//;
  $precision =~ s/\s*$//;
  $pre_command_raw = $pre_command;

  # parse command
  $pre_command =~ /\s*(\w+)\s*\((.*)\)/;

  my $func = $1;
  my $params = $2;

  # parse parameters
  $params =~ s/\\,/_COMMA_/g;
  my @par = split(/,/, $params);
   for($params=0; $params <= $#par; $params++){
    $par[$params] =~ s/_COMMA_/,/g;
    $par[$params] =~ s/^\s*//;
    $par[$params] =~ s/\s*$//;
  }

  if    ($func eq "SHELL"){ # function SHELL(shell code)
    $pre_command = $par[0];

  }elsif($func eq "LINE") { # function LINE(filename, line, column)
    $pre_command = "cat $par[0]";
    if($par[1] > 0){
      $pre_command .= " | tail -n +$par[1] | head -n 1";
    } else {
      $pre_command .= " | tail -n  $par[1] | head -n 1";
    }
    $pre_command .= " | cut -b $par[2]- | perl -ne '/\\s*([0-9\\-+.eEdD]*)/; print \$1'";

  }elsif($func eq "GREP") { # function GREP(filename, 're', column <, offset>)
    my $off = 1*$par[3];
    $pre_command = "n=\$(cat -n $par[0] | grep $par[1] | head -n 1 | awk '{print \$1;}');";
    $pre_command .= " cat $par[0] | tail -n +\$((n+$off)) | head -n 1";
    $pre_command .= " | cut -b $par[2]- | perl -ne '/\\s*([0-9\\-+.eEdD]*)/; print \$1'";

  }else{ # error
    printf stderr "Unknown command '$func'\n";
    return 0;
  }

  printf("%s\n", $pre_command) if ($opt_v);

  my $value = `cd $workdir; $pre_command`;

  # append the command and the regexp also to the shell script matches.sh in the
  # current archive directory
  open(SCRIPT, ">>$mscript");
  print SCRIPT "
echo '", "="x4, " [ $name - pre command ]'
$pre_command
echo
echo '", "-"x4, " [ $name - ref value   ]'
echo $ref_value
export LINE=`$pre_command`
perl -e 'print \"Match: \".(abs(\$ENV{LINE}-($ref_value)) <= $precnum ? \"OK\" : \"FAILED\");'
echo
echo";
  close(SCRIPT);

  $success = (abs(($value)-($ref_value)) <= $precision);

  # Update values if necessary
  print NEW_TESTSUITE "$match;$name;$pre_command_raw; $value; 1e-12\n" if $opt_u;
  if ( $opt_t ) {
    if($success) {
      print NEW_TESTSUITE "$match;$name;$pre_command_raw; $ref_value; $precision\n";
    } else {
      my $diff = sprintf("%20.16e", abs($ref_value - $value));
      my ($n,$e) = split(/e/, $diff);
      $n = ceil($n);
      print NEW_TESTSUITE "$match;$name;$pre_command_raw; $ref_value; $n"."e"."$e\n";
    }
  }

  # Print information about success
  if(!$success) {
    printf "%-50s%s", "$name", ":\t [ $color_start{red} FAIL $color_end{red} ] \n";
    print "\n  Match Failed\n";
    print "   Calculated value : ".$value."\n";
    print "   Reference value  : ".$ref_value."\n";
    print "   Difference       : ".abs($ref_value - $value)."\n";
    print "   Tolerance        : ".$precision."\n\n";
  } else {
    printf "%-50s%s", "$name", "\t [ $color_start{green}  OK  $color_end{green} ] \n";
  }

  return $success;

}

# return value of environment variable (specified by string argument), or "" if not set
sub get_env {
    if(exists($ENV{$_[0]})) {
	return $ENV{$_[0]};
    } else {
	return "";
    }
}
