#!/usr/bin/env perl

use strict;
use warnings;
use Benchmark qw(:all :hireswallclock);

use Getopt::Long qw( GetOptions :config require_order no_ignore_case );

###############################################################################
###############################################################################
## List of testfiles with number of triangulations
###############################################################################
###############################################################################
my %quicktests = (
    "examples/cube_3.dat", 6,
    "examples/D3xD2.dat", 35,
    "examples/D3xD1.dat", 1,
    "examples/cyclic_4_2.dat", 1,
    "examples/cyclic_5_2.dat", 1,
    "examples/moae.dat", 5,
    );
my %remainingtests = (
    "examples/truncated_cube.dat", 5,
    "examples/6-gonxI.dat", 5986,
    "examples/P10.dat", 302,
    "mp_examples/sym/square.dat", 1,
    "mp_examples/sym/lattice_2_2.dat", 6,
    "mp_examples/sym/rectangle.dat", 6,
    "mp_examples/nosym/5pts.dat", 5,
    "mp_examples/nosym/6pts.dat", 14,
    "mp_examples/nosym/cube_3.dat", 74,
    "mp_examples/nosym/cyclic_8_4.dat", 40,
    "mp_examples/nosym/D3xD2.dat", 4488,
    "mp_examples/nosym/lattice_3_3.dat", 387,
    "mp_examples/nosym/moae.dat", 18,
    "mp_examples/sym/dp2xdp2.dat", 204,
    );

my $quickFineRegData = [
    ["mp_examples/nosym/lattice_3_3.dat", 64, 387, 64],
    ["examples/moae.dat", 2, 4, 1],
];

my $remainingFineRegData = [
    ["examples/lattice_3_3.dat", 14, 69, 14],
    ["mp_examples/nosym/cube_3+1.dat", 166, 222, 148],
    ["mp_examples/nosym/truncated_cube_3+1.dat", 19, 35, 19],
    ["mp_examples/sym/cube_3+1.dat", 16, 20, 14],
    ["mp_examples/sym/truncated_cube_3+1.dat", 9, 14, 9],
    ["mp_examples/sym/2Delta3.dat", 15, 59, 15],
    ["mp_examples/sym/3Delta2.dat", 18, 213, 18],
];

my %fineTests = ();
my %regTests = ();
my %fineRegTests = ();

my @drawTest = (
    "examples/moae.dat",
    "examples/cube_3.dat",
    "examples/D3xD2.dat",
    "mp_examples/nosym/lattice_3_3.dat",
);

my %timing = (
    "mp_examples/nosym/D3xD2.dat", 5,
    "mp_examples/nosym/cube_3.dat", 2,
    "mp_examples/nosym/lattice_3_3.dat", 4,
);

my %centralTests = (
    "examples/cube_3.dat", 4,
    "examples/D3xD2.dat", 26,
    "mp_examples/polytropes/polytropes3.in", 1,
    "mp_examples/polytropes/polytropes4.in", 7,
);

my %centralTests_regular = (
    "examples/cube_3.dat", 4,
    "examples/D3xD2.dat", 26,
    "mp_examples/polytropes/polytropes3.in", 1,
    "mp_examples/polytropes/polytropes4.in", 6,
);
    
my %cyclicTests = (
    "mp_examples/nosym/cyclic_8_4.dat", 40,
    "mp_examples/nosym/cyclic_10_5.dat", 1233,
    "mp_examples/nosym/cyclic_10_6.dat", 102,
    "mp_examples/nosym/cyclic_11_6.dat", 3278,
    "mp_examples/nosym/cyclic_11_7.dat", 165,
    "mp_examples/nosym/cyclic_12_7.dat", 12589,
    "mp_examples/nosym/cyclic_13_8.dat", 35789,
);

my $errors = 0;

###############################################################################
###############################################################################
## Main routine
###############################################################################
###############################################################################

require Cwd;
my $InstallTop=Cwd::abs_path( $0 =~ m{(?:^|/+)[^/]+$} ? ($` || ".") : "." );
my $buildroot= $ENV{MPTOPCOM_BUILD_ROOT} ? "$InstallTop/build.$ENV{MPTOPCOM_BUILD_ROOT}" : "$InstallTop/build";
do "$InstallTop/support/install_utils.pl";
my %ConfigFlags=load_config_file("$buildroot/config.ninja", $InstallTop);
my $soplex = $ConfigFlags{WITH_SOPLEX};

my $full = 0;
my $debug = 0;
my $xml = 0;
my $jdr = ".";
my $buildmode = "Opt";
my $errfile = "/tmp/error$$.log";
my $mpiflags = "";

# enable autoflush for output 
$|++;

# testsuite options
my($jenkins_report, $report_fh, $report_writer, $only, $inverted);
if ( !GetOptions( 'full' => \$full,
                  'xml' => \$xml,
                  'build-mode:s' => \$buildmode,
                  'mpi-flags:s' => \$mpiflags,
                  'jenkins-report-dir:s' => \$jdr,
                  'only:i' => \$only
                ) ) {
   die "usage: perl testsuite.pl [--xml] [--full] [--build-mode=<string=Opt>] [--mpi-flags=<string>] [--jenkins-report-dir] [--only=<integer>]\n";
}

# Do not invert test results:
# (We do this sometimes to check whether tests can also fail)
$inverted = 0;

my $binDir = "$buildroot/$buildmode/bin";

if($xml){
   use XML::Writer;
   start_testsuite("$jdr/junit_mptopcom");
}

my($mpirun, $nSlots);
init_mpi();


if($full){
   print "Running full testsuite.\n";
   if($soplex){
      print "Using soplex for regularity checks via polymake.\n";
   }
   print "\n";
} else {
   print "Running quick testsuite.\n\n";
}

my @fineRegData = @$quickFineRegData;
my %tests=%quicktests;
my @fineRegTests=();
prepare_tests();

if(!$only){
   run_standard_tests();
   if ($full) {
      run_developer_tests();
   }
} else {
   run_only_test($only);
}

print "---------------------------------------------------------------------------\n\n";

print "Summary: ";

if($errors == 0){
   print_green("All tests successfull.");
} else {
   print_red("There were $errors errors.");
}
print "\n\n";

if($xml){
   close_testsuite();
}

exit 0;

###############################################################################
###############################################################################
## Submethods
###############################################################################
###############################################################################

###############################################################################
# The main scripts 
# 1. run_standard_tests: Comparing results, running more tests with --full
# 2. run_developer_tests: Check for leaks and speed. Also check whether the
#        checks themselves still work.
# 3. run_only_test: Only run selected tests.
sub run_standard_tests{
   for(my $i=1; $i<=3; $i++){
      run_only_test($i);
      print "\n";
   }
}

sub run_developer_tests {
   for(my $i=4; $i<=11; $i++){
      run_only_test($i);
      print "\n";
   }
}

sub run_only_test {
   my($index) = @_;
   if($index == 1){
      print "1. Running basic tests:\n";
      run_basic_tests();
   } elsif ($index == 2){
      print "2. Running (fine/regular/fine+regular) tests:\n";
      run_fineReg_tests();
   } elsif ($index == 3){
      print "3. Testing --cyclic-flips option:\n";
      run_cyclicFlips_tests();
   } elsif ($index == 4){
      print "4. Running thorough tests:\n";
      run_thorough_tests();
   } elsif ($index == 5){
      print "5. Checking for leaks:\n";
      check_leaks();
   } elsif ($index == 6){
      print "6. Very basic timing tests to make sure we did not ruin everything:\n";
      run_timing_tests();
   } elsif ($index == 7){
      print "7. Triggering overflow errors:\n";
      run_overflow_tests();
   } elsif ($index == 8){
      print "8. Test drawing:\n";
      run_draw_tests();
   } elsif ($index == 9){
      print "9. Test --central option:\n";
      run_central_tests();
   } elsif ($index == 10){
      print "10. Should fail:\n";
      should_fail_tests();
   } elsif ($index == 11){
      print "11. Canonical representative:\n";
      canonical_representative_tests();
   } else {
      print "Index $index not available.\n";
   }
}

###############################################################################
# Setup testing environment.
sub prepare_tests {
   if($full){
      %tests=(%tests,%remainingtests);
      push @fineRegData, @$remainingFineRegData;
   }

   foreach my $line(@fineRegData){
      my $key = $line->[0];
      $fineTests{$key} = $line->[1];
      $regTests{$key} = $line->[2];
      $fineRegTests{$key} = $line->[3];
      push @fineRegTests, $key;
   }
}

sub init_mpi {
   if(!defined($ConfigFlags{MPICXX})){
      print "MPI was disabled during configuration. Not running mpi tests.\n";
      return;
   }
   $mpirun = "mpirun";
   if(defined($ConfigFlags{MPI_PATH})){
      $mpirun = "$ConfigFlags{MPI_PATH}/bin/mpirun";
   }
   my $slotTest = `$mpirun $mpiflags --display-allocation true`;
   print $slotTest,"\n";
   # ompi 1.5.5
   #======================   ALLOCATED NODES   ======================
   #
   # Data for node: cluster-i	Num slots: 1	Max slots: 0
   #
   #=================================================================
   # ompi 3.0.2
   #======================   ALLOCATED NODES   ======================
   #	cluster-i: flags=0x11 slots=8 max_slots=0 slots_inuse=0 state=UP
   #=================================================================
   ($nSlots) = $slotTest =~ m/slots=(\d+) max_slots/;
   ($nSlots) = $slotTest =~ m/Num slots: (\d+)\s+Max slots:/ unless defined($nSlots);
   system("$mpirun --oversubscribe -np 20 echo x > /dev/null 2>&1");
   my $useoversub = ($? == 0);
   if($nSlots < 12 && $useoversub){
      print "Not enough slots available for all tests, will use --oversubscribe.\n";
      $mpirun .= " --oversubscribe";
   }
   $mpirun .= " ".$mpiflags;
}

###############################################################################
# Running basic tests, i.e. just checking whether the number of triangulations
# agree.
sub run_basic_tests{
   run_mptopcom_tests("basic", \%tests, "");
   run_mptopcom1_tests("basic", \%tests, "");
   run_topcom_tests("basic", \%tests, "points2ntriangs", "");
}

sub run_fineReg_tests{
   print "   Fine:\n";
   my $package = "fine";
   run_mptopcom_tests($package, \%fineTests, "--full");
   run_mptopcom1_tests($package, \%fineTests, "--full");
   run_topcom_tests($package, \%fineTests, "points2nfinetriangs", "");
   print "   Regular:\n";
   $package = "regular";
   run_mptopcom_tests($package, \%regTests, "--regular");
   run_mptopcom1_tests($package, \%regTests, "--regular");
   run_topcom_tests($package, \%regTests, "points2ntriangs", "--regular");
   print "   Fine + Regular:\n";
   $package = "regular+fine";
   run_mptopcom_tests($package, \%fineRegTests, "--full --regular");
   run_mptopcom1_tests($package, \%fineRegTests, "--full --regular");
   run_topcom_tests($package, \%fineRegTests, "points2nfinetriangs", "--regular");
}

sub run_cyclicFlips_tests{
   run_mptopcom_tests("cyclicFlips", \%cyclicTests, "--cyclic-flips");
   run_mptopcom1_tests("cyclicFlips", \%cyclicTests, "--cyclic-flips");
}

###############################################################################
# Test whether --central works
sub run_central_tests{
   print "   Central:\n";
   run_mptopcom_tests("central", \%centralTests, "--central");
   run_mptopcom1_tests("central", \%centralTests, "--central");
   print "   Central + Regular:\n";
   run_mptopcom_tests("centralRegular", \%centralTests_regular, "--central --regular");
   run_mptopcom1_tests("centralRegular", \%centralTests_regular, "--central --regular");
}


###############################################################################
# Test canonicalRepresentative
sub canonical_representative_tests {
   my $package = "canonicalRepresentative";
   my @folders = <"testfiles/canonicalRepresentatives/*">;
   @folders = grep(-d $_, @folders);
   foreach my $folder (@folders){
      my($classname) = $folder =~ m/\/(\w*)$/;
      print "\[$classname\] ";
      if($xml){
         $report_writer->startTag("testsuite", package=>$package, name=>$classname);
      }
      my @files = <"$folder/*.IN">;
      my $i = 0;
      foreach my $file (@files){
         compute_canonical_representative($classname, $file, "");
         compute_canonical_representative($classname."sg", $file, "--small-group");
         $i++;
         if(!$full && $i == 10) { last; }
      }
      print "\n";
      if($xml){
         $report_writer->endTag();
      }
   }
   print "\n";

}

sub compute_canonical_representative {
   my($classname, $filename, $opt) = @_;
   my($path, $index) = $filename =~ m/(.*)\/(\d+)\.IN/;
   if($xml){
      $report_writer->startTag("testcase", classname=>$classname, name=>$index);
   }
   my $result = `$binDir/canonicalRepresentative $opt < $filename 2>/dev/null`;
   my($computedCanonical, $computedgkz) = $result =~ m/(\{\{.*\}\}).*gkz: (\[.*?\]).*perm: \[.*\]/;
   my @desired = split("\n", `cat $path/$index.OUT`);
   my $desiredgkz = $desired[0];
   my $desiredCanonical = $desired[1];
   my $check = triangulations_match($desiredCanonical, $computedCanonical);
   $check &= $desiredgkz eq $computedgkz;
   my $error = "";
   if($opt eq "--small-group"){
      output_test_result($check, $error, $index."sg ", $index."sg ", "");
   } else {
      output_test_result($check, $error, $index." ", "$index ", "");
   }
   if($xml){
      $report_writer->endTag();
   }
}


###############################################################################
# Inner routines:
# 1. run mptopcom with different parameters for parallelization
# 2. run mptopcom1
# 3. run TOPCOM
# All of these take options, so they are used for the standard tests, as well
# as for fine/regular/fine+regular.
sub run_mptopcom_tests{
   my($package, $testcasesHashRef, $options) = @_;
   if(!defined($ConfigFlags{MPICXX})){
      return;
   }
   if($full){
      run_mptopcom_cmd_on_testcases($package, $testcasesHashRef, 3, 50, 50, $options);
   }
   run_mptopcom_cmd_on_testcases($package, $testcasesHashRef, 3, 100, 50, $options);
   if($full){
      run_mptopcom_cmd_on_testcases($package, $testcasesHashRef, 3, 200, 50, $options);
      run_mptopcom_cmd_on_testcases($package, $testcasesHashRef, 12, 50, 50, $options);
   }
   run_mptopcom_cmd_on_testcases($package, $testcasesHashRef, 12, 100, 50, $options);
   if($full){
      run_mptopcom_cmd_on_testcases($package, $testcasesHashRef, 12, 200, 50, $options);
   }
}

sub run_mptopcom_cmd_on_testcases{
   my($package, $testcasesHashRef, $np, $maxnodes, $flipcache, $options) = @_;
   my $testtype = "mptopcom[$np,$maxnodes]";
   my $classname = $package.".".$testtype;
   if($xml){
      $report_writer->startTag("testsuite", package=>$package, name=>$classname);
   }
   print $testtype,": ";
   my %testcasesHash = %$testcasesHashRef;
   foreach my $key(keys %testcasesHash){
      my $desired = $testcasesHash{$key};
      my $cmd = assemble_mptopcom_cmd($key, $np, $maxnodes, $flipcache, $options);
      treat_result($classname, $key, $testtype, $cmd, $desired);
   }
   if($xml){
      $report_writer->endTag();
   }
   print "\n";
}

sub run_mptopcom1_tests{
   my($package, $testcasesHashRef, $options) = @_;
   my $testtype = "mptopcom1";
   my $classname = $package.".".$testtype;
   if($xml){
      $report_writer->startTag("testsuite", package=>$package, name=>$classname);
   }
   print $testtype,": ";
   my %testcasesHash = %$testcasesHashRef;
   foreach my $key(keys %testcasesHash){
      my $desired = $testcasesHash{$key};
      my $cmd = assemble_mptopcom1_cmd($key, $options);
      treat_result($classname, $key, $testtype, $cmd, $desired);
   }
   if($xml){
      $report_writer->endTag();
   }
   print "\n";
}

sub run_topcom_tests{
   my($package, $testcasesHashRef, $topcomCmd, $options) = @_;
   my $testtype = $topcomCmd;
   my $classname = $package.".".$testtype;
   if($xml){
      $report_writer->startTag("testsuite", package=>$package, name=>$classname);
   }
   print $testtype,": ";
   my %testcasesHash = %$testcasesHashRef;
   foreach my $key(keys %testcasesHash){
      my $desired = $testcasesHash{$key};
      my $cmd = assemble_topcom_cmd($key, $testtype, $options);
      treat_result($classname, $key, $testtype, $cmd, $desired);
   }
   if($xml){
      $report_writer->endTag();
   }
   print "\n";
}

sub treat_result{
   my($classname, $testcase, $type, $cmd, $desired) = @_;
   my ($result,$error) = run_cmd_retrieve_result($type, $cmd);
   if($xml){
      $report_writer->startTag("testcase", classname=>$classname, name=>$testcase);
   }
   my $check = !$error && $desired == $result;
   output_test_result($check, $error, $testcase." ", "$testcase($desired:$result) -- $error\n", "desired: $desired, got: $result");
   if($xml){
      $report_writer->endTag();
   }
}

sub run_cmd_retrieve_result{
   my($testname, $cmd) = @_; 
   my $output = `$cmd`;
   my $errcode = $?;
   my $error = `tail -n 20 $errfile`;
   unlink $errfile;
   my $result;
   if($testname =~ m/points2ntriangs/ || $testname =~ m/points2nfinetriangs/){
      ($result) = $output =~ m/(\d+)/s;
   } elsif($testname =~ m/mptopcom\[/){
      ($result) = $error =~ m/Total triangulations:\s*(\d+)\n/;
   } elsif($testname =~ m/mptopcom1/){
      ($result) = $error =~ m/Totalcount:\s*(\d+)/;
   } else {
      die("Cannot extract result type from testname: \n$testname\n");
   }
   if (defined($result)) {
      $error = "";
   } else {
      $result = -1;
      if (!$error) {
         $error = "silent failure $errcode";
      }
   }
   return ($result, $error);
}

sub run_cmd{
   my($cmd) = @_;
}

###############################################################################
# Printing the test result in desired color
sub print_red{
   my($text) = @_;
   $errors++;
   print "\033[91m",$text,"\033[0m";
}

sub print_green{
   my($text) = @_;
   print "\033[92m",$text,"\033[0m";
}

###############################################################################
# Running the different programs and extracting number of triangulations
sub assemble_mptopcom_cmd{
   my($testfile, $np, $maxnodes, $flipcache, $options) = @_;
   my $output = "$mpirun -np $np $binDir/mptopcom $options -maxnodes $maxnodes --flip-cache $flipcache < $testfile 1> /dev/null 2>$errfile";
   return $output;
}

sub assemble_topcom_cmd{
   my($testfile, $cmd, $options) = @_;
   my $output = "$binDir/$cmd $options < $testfile 2>$errfile";
   return $output;
}

sub assemble_mptopcom1_cmd{
   my($testfile, $options) = @_;
   my $output = "$binDir/mptopcom1 $options < $testfile 1>/dev/null 2>$errfile";
   return $output;
}

sub run_topcom_cmd{
   my($testfile, $cmd) = @_;
   run_cmd_retrieve_result($cmd, assemble_topcom_cmd($testfile, $cmd, ""));
}

###############################################################################
# Running a thorough test, i.e. checking for actual equality
sub run_thorough_tests {
   my $package = "thorough"; 
   run_thorough_test("$binDir/mptopcom1", "", $package, $package, $package.".mptopcom1");
   run_thorough_test("$binDir/mptopcom1", "--regular", $package, $package, $package.".mptopcom1");
   run_thorough_test("$binDir/mptopcom1", "--regular --full", $package, $package, $package.".mptopcom1");
   if(defined($ConfigFlags{MPICXX})){
      run_thorough_test("$mpirun -np 5 $binDir/mptopcom -maxnodes 30", $package, $package.".mptopcom[5,30,default]");
      run_thorough_test("$mpirun -np 5 $binDir/mptopcom -maxnodes 30 --flip-cache 100", $package, $package.".mptopcom[5,30,default]");
   }
}

sub run_thorough_test{
   my($cmd, $options, $package, $classname) = @_;
   if($xml){
      $report_writer->startTag("testsuite", package=>$package, name=>$classname);
   }
   foreach my $testfile(keys %tests){
      my $desired = $tests{$testfile};
      my $checkFine = $options =~ m/--full/;
      if($checkFine && $testfile =~ m/cyclic_8_4/){
         # This file will give integer overflows
         return;
      }
      if(($desired < 500) && ($testfile =~ m/mp_examples/) && ($testfile =~  m/nosym/)){
         if($xml){
            $report_writer->startTag("testcase", classname=>$classname, name=>$testfile);
         }
         my $topcomCmd = $checkFine ? "$binDir/points2finetriangs" : "$binDir/points2triangs";
         equality_test($testfile, $cmd, $topcomCmd, $options);
         if($xml){
            $report_writer->endTag();
         }
      }
   }
   if($xml){
      $report_writer->endTag();
   }
}

sub equality_test{
   my($testfile, $cmd1, $cmd2, $options) = @_;
   my $check = equality_test_inner($testfile, $cmd1, $cmd2, $options);
   $check &= equality_test_inner($testfile, $cmd2, $cmd1, $options);
   my $successMsg;
   if($options eq ""){
      $successMsg = $testfile." [".$cmd1." - ".$cmd2."]\n";
   } else {
      $successMsg = $testfile." [".$cmd1." - ".$cmd2." ($options)]\n";
   }
   my $xmlErrorMsg = "Output of '$cmd1' and '$cmd2' does not agree for testfile $testfile.";
   output_test_result($check, 0, $successMsg, $successMsg, $xmlErrorMsg);
}

sub equality_test_inner{
   my($testfile, $cmd1, $cmd2, $options) = @_;
   my $result1 = `$cmd1 $options < $testfile 2>/dev/null`;
   my $result2 = `$cmd2 $options < $testfile 2>/dev/null`;
   my @triangulations1 = extract_triangulations($result1);
   my @triangulations2 = extract_triangulations($result2);
   my $check = 1;
   # This looks complicated, but it is necessary. The point is that the order
   # of triangles might be a different one for us than for topcom, hence
   # triangulation_match will check the single triangles. At least the indices
   # in the triangles are ordered ascending. polymake would probably always
   # output the same order.
   foreach my $triangulation1 (@triangulations1){
      $check = 0;
      foreach my $triangulation2 (@triangulations2){
         if(triangulations_match($triangulation1, $triangulation2)){
            $check = 1;
         }
      }
      if(!$check){ last; }
   }
   return $check;
}

sub triangulations_match{
   my($t1, $t2) = @_;
   return triangulations_match_inner($t1, $t2) && triangulations_match_inner($t2, $t1);
}

sub triangulations_match_inner{
   my($t1, $t2) = @_;
   my @triangles1 = $t1 =~ m/{([^{}]*)}/g;
   foreach my $triangle (@triangles1){
      if($t2 !~ m/$triangle/x){
         return 0;
      }
   }
   return 1;
}

sub extract_triangulations{
   my($string) = @_;
   my @result = $string =~ m/\[[^{]*(\{\{[^\]]*\}\})\]/gs;
   return @result;
}

###############################################################################
# Running the different programs and extracting number of triangulations
sub check_leaks {
   my $package = "leak";
   foreach my $key(keys %tests){
      if($tests{$key} < 100){
         check_leaks_inner($key, $package);
      }
   }
}

sub check_leaks_inner{
   my($testfile, $package) = @_;
   my $classname = $package.".".$testfile;
   if($xml){
      $report_writer->startTag("testsuite", package=>$package, name=>$classname);
   }
   my $cmd = "env GLIBCXX_FORCE_NEW=1 valgrind --leak-check=yes $binDir/mptopcom1 < $testfile 2>&1";
   print $cmd," ";
   my $output = `$cmd`;
   my $all = $output =~ m/All heap blocks were freed -- no leaks are possible/s;
   if($all){
      print_green("All heap blocks were freed -- no leaks are possible\n");
      if($xml){
         $report_writer->startTag("testcase", classname=>$classname, name=>"all");
         $report_writer->endTag();
      }
      return;
   }
   eval_leak_var("definitely", $testfile, $classname, $output);
   eval_leak_var("indirectly", $testfile, $classname, $output);
   eval_leak_var("possibly", $testfile, $classname, $output);
   if($xml){
      $report_writer->endTag();
   }
   print "\n";
}

sub eval_leak_var {
   my($var_name, $testfile, $classname, $output) = @_;
   my $var = $output =~ m/$var_name lost: 0 bytes in 0 blocks/s;
   if($xml){
      $report_writer->startTag("testcase", classname=>$classname, name=>$var_name);
   }
   my $successMsg = $var_name." ";
   my $xmlErrorMsg = "Leak occured for $testfile:\n$output\n";
   output_test_result($var, 0, $successMsg, $successMsg, $xmlErrorMsg);
   if($xml){
      $report_writer->endTag();
   }
}

###############################################################################
# Basic timing test
sub run_timing_tests {
   my $package = "timing";
   foreach my $key (keys %timing){
      my $classname = $package.".".$key;
      if($xml){
         $report_writer->startTag("testsuite", package=>$package, name=>$classname);
      }
      run_timing_test($key, $classname);
      if($xml){
         $report_writer->endTag();
      }
   }
}

sub run_timing_test{
   my($file, $classname) = @_;
   my $factor = $timing{$file};
   print $file,": ";
   for(my $i=0; $i<5; $i++){
      if($xml){
         $report_writer->startTag("testcase", classname=>$classname, name=>"$i");
      }
      run_timing_test_inner($file, $factor);
      if($xml){
         $report_writer->endTag();
      }
   }
   print "\n";
}

sub run_timing_test_inner{
   my($file, $factor) = @_;
   my $mptopcom1 = get_time($file, "$binDir/mptopcom1");
   my $topcom = get_time($file, "$binDir/points2triangs");
   if($topcom == 0){ $topcom += .00001;}
   my $check = $mptopcom1 <= $factor*$topcom;
   my $successMsg = "OK ";
   my $errorMsg = "FAIL[".$topcom.":".$mptopcom1."] ";
   my $xmlErrorMsg = "Timing test for $file failed: $topcom vs $mptopcom1.";
   output_test_result($check, 0, $successMsg, $errorMsg, $xmlErrorMsg);
}

sub get_time{
    my($file, $cmd) = @_;
    my $t=Benchmark::timeit(1, sub{`$cmd < $file 2>&1 1>/dev/null`;});
    my $time=$t->real;
    return $time;
}

###############################################################################
# Test whether we can still draw the reverse search tree
sub run_draw_tests {
   my $package = "output_graph";
   foreach my $file (@drawTest){
      my $classname = $package.".".$file;
      if($xml){
         $report_writer->startTag("testsuite", package=>$package, name=>$classname);
      }
      run_draw_test($file, $classname);
      if($xml){ $report_writer->endTag(); }
   }
}

sub run_draw_test{
   my($file, $classname) = @_;
   print $file,": ";

   my $opt = "make-tree";
   my $check = run_draw_test_option($file, $opt);
   if($xml){ $report_writer->startTag("testcase", classname=>$classname, name=>"$file.$opt");}
   output_test_result($check, 0, "--$opt ", "--$opt ", "Got wrong graph with --$opt on $file");
   if($xml){ $report_writer->endTag(); }

   if($file !~ m/nosym/){
      $opt = "make-marked-tree";
      my $check_sym = run_draw_test_option($file, $opt);
      if($xml){ $report_writer->startTag("testcase", classname=>$classname, name=>"$file.$opt");}
      output_test_result($check_sym, 0, "--$opt ", "--$opt ", "Got wrong graph with --$opt on $file");
      if($xml){ $report_writer->endTag(); }
   }
   print "\n";
}

sub run_draw_test_option{
   my($file, $opt) = @_;
   return compare_output("$binDir/mptopcom1 --$opt < $file 2>&1", "cat testfiles/$file.$opt");
}

sub compare_output{
   my($cmd1, $cmd2) = @_;
   my $result1 = `$cmd1`;
   $result1 =~ s/mptopcom version.*?\n//s;
   my $result2 = `$cmd2`;
   $result2 =~ s/mptopcom version.*?\n//s;
   return $result1 eq $result2;
}

###############################################################################
# Should fail for coordinates that are too big.
sub run_overflow_tests {
   my $package = "overflow";
   my $classname = $package.".bigcast";
   if($xml){
      $report_writer->startTag("testsuite", package=>$package, name=>$classname);
      $report_writer->startTag("testcase", classname=>$classname, name=>"parse_coord");
   }
   my $cmd = "$binDir/mptopcom1 < testfiles/parse_coord.dat 2>&1";
   my $error = `$cmd`;
   my $check = $error =~ m/Rational number is too big for the cast to/;
   my $successMsg = "Throws error when coordinates are too big.\n";
   my $errorMsg = "Did not throw error when coordinates are too big.\n";
   my $xmlErrorMsg = "\"$cmd\" did not result in an error.";
   output_test_result($check, 0, $successMsg, $errorMsg, $xmlErrorMsg);
   if($xml){ $report_writer->endTag(); $report_writer->endTag(); }

   $classname = $package.".normalized_volume";
   if($xml){
      $report_writer->startTag("testsuite", package=>$package, name=>$classname);
      $report_writer->startTag("testcase", classname=>$classname, name=>"init_check");
   }
   $cmd = "$binDir/mptopcom1 < testfiles/init_check.dat 2>&1";
   $error = `$cmd`;
   $check = $error =~ m/Normalized volume makes Scalar type overflow/;
   $successMsg = "Failing for overflowing normalized volume.\n";
   $errorMsg = "Not failing for overflowing normalized volume.\n";
   $xmlErrorMsg = "\"$cmd\" did not result in an error.";
   output_test_result($check, 0, $successMsg, $errorMsg, $xmlErrorMsg);
   if($xml){ $report_writer->endTag(); $report_writer->endTag(); }
}

sub should_fail_tests {
   $inverted = 1;
   my $package = "shouldFail";
   my $classname = $package.".equality_test";
   if($xml){ 
      $report_writer->startTag("testsuite", package=>$package, name=>$classname); 
      $report_writer->startTag("testcase", classname=>$classname, name=>"shouldFail: moae.dat");
   }
   equality_test("./mp_examples/nosym/moae.dat", "$binDir/mptopcom1", "$binDir/points2ntriangs", "");
   if($xml){ $report_writer->endTag(); $report_writer->endTag(); }
   print "\n";


   $classname = $package.".triangulations_match";
   if($xml){ 
      $report_writer->startTag("testsuite", package=>$package, name=>$classname); 
      $report_writer->startTag("testcase", classname=>$classname, name=>"shouldFail: {{1,2,3},{2,3,4}},{{1,2,3},{1,3,4}} do not match");
   }
   my $tm = triangulations_match("{{1,2,3},{2,3,4}}","{{1,2,3},{1,3,4}}");
   output_test_result($tm, 0, "triangulation_match", "triangulation_match", "Internal method triangulation_match failed.");
   if($xml){ $report_writer->endTag(); $report_writer->endTag(); }
   print "\n";

   $classname = $package.".timing";
   if($xml){ 
      $report_writer->startTag("testsuite", package=>$package, name=>$classname); 
      $report_writer->startTag("testcase", classname=>$classname, name=>"shouldFail: always uses more than 0 seconds time");
   }
   print "Timing: ";
   run_timing_test_inner("mp_examples/nosym/D3xD2.dat", 0);
   if($xml){ $report_writer->endTag(); $report_writer->endTag(); }
   print "\n";
   
   $inverted = 0;
}

###############################################################################
# XML stuff
sub start_testsuite {
   my ($jenkins_report)=@_;
   my $report_file="${jenkins_report}.xml";
   open $report_fh, ">", $report_file or die "can't create $report_file: $!\n";
   binmode $report_fh, ":utf8";
   $report_writer=new XML::Writer(OUTPUT => $report_fh, NAMESPACES => 0, DATA_MODE => 1, DATA_INDENT => 2, ENCODING => 'utf-8', UNSAFE => 0);
   $report_writer->xmlDecl;
   $report_writer->startTag("testsuites");
}

sub close_testsuite {
   if ($report_writer) {
      $report_writer->endTag("testsuites");
      $report_writer->end;
      undef $report_writer;
      close $report_fh;
      undef $report_fh;
   }
}
   
sub output_test_result {
   my($check, $error, $successMsg, $errorMsg, $xmlErrorMsg) = @_;
   if($inverted){
      $inverted = 0;
      output_test_result(!$check, $error, "inverted: ".$errorMsg, "inverted: ".$successMsg, "Did not receive error: ".$xmlErrorMsg);
      $inverted = 1;
   } else {
      if($check){
         print_green($successMsg);
      } else {
         if ($xml) {
            if ($error) {
               $report_writer->emptyTag("failure", message=>"$error");
            } else {
               $report_writer->emptyTag("failure", message=>"$xmlErrorMsg");
            }
         }
         $error++;
         print_red($errorMsg);
      }
   }
}
