#!/usr/bin/env perl

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

###############################################################################
###############################################################################
## 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,
    );

my @quickFineRegTests = (
    "mp_examples/nosym/lattice_3_3.dat",
    "examples/moae.dat",
    );
my @remainingFineRegTests = (
    "examples/lattice_3_3.dat",
    "mp_examples/nosym/cube_3+1.dat",
    "mp_examples/nosym/truncated_cube_3+1.dat",
    "mp_examples/sym/cube_3+1.dat",
    "mp_examples/sym/truncated_cube_3+1.dat",
    "mp_examples/sym/2Delta3.dat",
    "mp_examples/sym/3Delta2.dat",
    );

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 $errors = 0;

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

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

my $mpirun = "mpirun";
if(defined($ConfigFlags{MPI_PATH})){
   $mpirun = "$ConfigFlags{MPI_PATH}/bin/mpirun";
}
my $slotTest = `$mpirun --display-allocation true`;
print $slotTest,"\n";
my ($nSlots) = $slotTest =~ m/slots=(\d+) max_slots/;
if($nSlots < 12){
   print "Not enough slots available for all tests, will use --oversubscribe.\n";
   $mpirun .= " --oversubscribe";
}

my $cmdline = shift;
my $full = 0;
if(defined($cmdline)){
   $full = ($cmdline eq "--full");
}

if($full){
   print "Running full testsuite.\n\n";
} else {
   print "Running quick testsuite.\n\n";
}

my %tests=%quicktests;
my @fineRegTests=@quickFineRegTests;

if ($full) {
    %tests=(%tests,%remainingtests);
    push @fineRegTests, @remainingFineRegTests;
}

run_standard_tests();

if ($full) {
   run_developer_tests();
}

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

print "Summary: ";

if($errors == 0){
   print_green("All tests successfull.");
} else {
   print_red("There were $errors errors.");
}
print "\n\n";
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.

sub run_standard_tests{
   print "1. Running basic tests:\n";
   foreach my $key(keys %tests){
      run_test($key);
   }

   print "\n2. Running fineReg tests:\n";
   foreach my $testfile(@fineRegTests){
      run_fineReg_test($testfile);
   }
}

sub run_developer_tests {

   print "\n3. Running thorough tests:\n";
   foreach my $key(keys %tests){
      run_thorough_test($key);
   }

   print "\n4. Checking for leaks:\n";
   foreach my $key(keys %tests){
      if($tests{$key} < 100){
         check_leaks($key);
      }
   }

   print "\n5. Very basic timing tests to make sure we did not ruin everything:\n";
   foreach my $key (keys %timing){
      run_timing_test($key);
   }

   print "\n6. Triggering overflow errors:\n";
   my $error = `$binDir/mptopcom1 < testfiles/parse_coord.dat 2>&1`;
   if($error =~ m/Rational number is too big for the cast to/){
      print_green("Throws error when coordinates are too big.\n");
   } else {
      print_red("Did not throw error when coordinates are too big.\n");
   }
   $error = `$binDir/mptopcom1 < testfiles/init_check.dat 2>&1`;
   if($error =~ m/Normalized volume makes Scalar type overflow/){
      print_green("Failing for overflowing normalized volume.\n");
   } else {
      print_red("Not failing for overflowing normalized volume.\n");
   }

   print "\n7. Test drawing:\n";
   foreach my $file (@drawTest){
      run_draw_test($file);
   }

   print "\n8. Should fail:\n";
   equality_test("./mp_examples/nosym/moae.dat", "$binDir/mptopcom1", "$binDir/points2ntriangs");
   evaluate_result("mptopcom1", mptopcom1("./mp_examples/nosym/moae.dat"), 0);
   print "\n";
   my $tm = triangulations_match("{{1,2,3},{2,3,4}}","{{1,2,3},{1,3,4}}");
   if($tm){print_green("triangulation_match\n");}
   else {print_red("triangulation_match\n");}
   print "Timing: ";
   run_timing_test_inner("mp_examples/nosym/D3xD2.dat", 0);
   print "\n";
   $errors -= 4;
}


###############################################################################
# Running basic tests, i.e. just checking whether the number of triangulations
# agree.
sub run_fineReg_test{
   my($testfile) = @_;
   my $desired = run_topcom_cmd($testfile, "points2nfinetriangs");
   print "Running fine test: ",$testfile," - ";
   run_test_core($testfile, $desired, "-F");
   print "\n";
   $desired = run_topcom_cmd($testfile, "points2ntriangs --regular");
   print "Running regular test: ",$testfile," - ";
   run_test_core($testfile, $desired, "--regular");
   print "\n";
   $desired = run_topcom_cmd($testfile, "points2nfinetriangs --regular");
   print "Running fineRegular test: ",$testfile," - ";
   run_test_core($testfile, $desired, "-F --regular");
   print "\n";
}

sub run_test{
   my($testfile) = @_;
   my $desired = $tests{$testfile};
   print "Running test: ",$testfile," - ";
   run_test_core($testfile, $desired, "");
   evaluate_result("points2ntriangs", run_topcom_cmd($testfile, "points2ntriangs"), $desired);
   print "\n";
}

sub run_test_core{
   my($testfile, $desired, $options) = @_;
   # When mptopcom is adapted, this loop should go away.
   if($full){
      evaluate_result("mptopcom[3,50]", mptopcom($testfile, 3, 100, 50, $options), $desired);
   }
   evaluate_result("mptopcom[3,100]", mptopcom($testfile, 3, 100, 100, $options), $desired);
   if($full){
      evaluate_result("mptopcom[3,200]", mptopcom($testfile, 3, 100, 200, $options), $desired);
      evaluate_result("mptopcom[12,50]", mptopcom($testfile, 12, 100, 50, $options), $desired);
   }
   evaluate_result("mptopcom[12,100]", mptopcom($testfile, 12, 100, 100, $options), $desired);
   if($full){
      evaluate_result("mptopcom[12,200]", mptopcom($testfile, 12, 100, 200, $options), $desired);
   }
   evaluate_result("mptopcom1", mptopcom1($testfile, $options), $desired);
}

sub evaluate_result{
   my($testname, $result, $desired) = @_;
   if($result == $desired){
      print_green($testname." ");
   } else {
      print_red($testname."(".$result.":".$desired.") ");
   }
}

###############################################################################
# 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 mptopcom{
   my($testfile, $np, $maxnodes, $flipcache, $options) = @_;
   my $output = `$mpirun -np $np $binDir/mptopcom $options -maxnodes $maxnodes --flip_cache $flipcache < $testfile 2>&1 1>/dev/null`;
   my ($result) = $output =~ m/Total nodes:\s*(\d+)\s*Total number of jobs/;
   return $result;
}

sub run_topcom_cmd{
   my($testfile, $cmd) = @_;
   my $output = `$binDir/$cmd < $testfile 2>/dev/null`;
   my ($discard, $result) = $output =~ m/(\d+)\D+(\d+)/s;
   return $result;
}

sub mptopcom1{
   my($testfile, $options) = @_;
   my $output = `$binDir/mptopcom1 $options < $testfile 2>&1 1>/dev/null`;
   my ($result) = $output =~ m/Totalcount:\s*(\d+)/;
   return $result;
}

###############################################################################
# Running a thorough test, i.e. checking for actual equality
sub run_thorough_test{
   my($testfile) = @_;
   my $desired = $tests{$testfile};
   if(($desired < 500) && ($testfile =~ m/mp_examples/) && ($testfile =~  m/nosym/)){
      equality_test($testfile, "$binDir/mptopcom1", "$binDir/points2triangs");
      equality_test($testfile, "$mpirun -np 5 $binDir/mptopcom -maxnodes 30", "$binDir/points2triangs");
      equality_test($testfile, "$mpirun -np 5 $binDir/mptopcom -maxnodes 30 --flip_cache 100", "$binDir/points2triangs");
   }
}

sub equality_test{
   my($testfile, $cmd1, $cmd2) = @_;
   my $check = equality_test_inner($testfile, $cmd1, $cmd2);
   $check &= equality_test_inner($testfile, $cmd2, $cmd1);
   if($check){
      print_green($testfile." [".$cmd1." - ".$cmd2."]\n");
   } else {
      print_red($testfile." [".$cmd1." - ".$cmd2."]\n");
   }
}

sub equality_test_inner{
   my($testfile, $cmd1, $cmd2) = @_;
   my $result1 = `$cmd1 < $testfile 2>/dev/null`;
   my $result2 = `$cmd2 < $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;
         }
      }
   }
   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($testfile) = @_;
   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;
   my $def = $output =~ m/definitely lost: 0 bytes in 0 blocks/s;
   my $indir = $output =~ m/indirectly lost: 0 bytes in 0 blocks/s;
   my $poss = $output =~ m/possibly lost: 0 bytes in 0 blocks/s;
   if($all){print_green("All heap blocks were freed -- no leaks are possible\n"); return;}
   if($def){print_green("definitely ");} else {print_red("definitely ");}
   if($indir){print_green("indirectly ");} else {print_red("indirectly ");}
   if($poss){print_green("possibly ");} else {print_red("possibly ");}
   print "\n";
}

###############################################################################
# Basic timing test
sub run_timing_test{
   my($file) = @_;
   my $factor = $timing{$file};
   print $file,": ";
   for(my $i=0; $i<5; $i++){
      run_timing_test_inner($file, $factor);
   }
   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;}
   if($mptopcom1 <= $factor*$topcom){
      print_green("OK ");
   } else {
      print_red("FAIL[".$topcom.":".$mptopcom1."] ");
   }
}

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_test{
   my($file) = @_;
   print $file,": ";
   my $opt = "make_tree";
   my $check = run_draw_test_option($file, $opt);
   if($check){ print_green("--$opt ");} else {print_red("--$opt ");}
   if($file !~ m/nosym/){
      $opt = "make_marked_tree";
      my $check_sym = run_draw_test_option($file, $opt);
      if($check_sym){ print_green("--$opt ");} else {print_red("--$opt ");}
   }
   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`;
   my $result2 = `$cmd2`;
   return $result1 eq $result2;
}
