#!/usr/bin/perl
use strict;
use warnings;

use JSON;

package Testcase;

sub read_json_file {
   my($class, $filename) = @_;
   # print "Filename: $filename\n";
   my $folder;
   if($filename =~ m/\//){
      ($folder) = $filename =~ m/(.*)\/[^\/]*/;
   } else {
      $folder = "."
   }
   my $entire = `cat $filename`;
   my $p = JSON->new->relaxed->decode($entire);
   $p->{folder} = $folder;
   # print %$p,"\n";
   bless($p, $class);
   return $p;
}

sub assemble_cmd {
   my($self, $binDir, $mpirun) = @_;
   defined $self->{folder} or die "folder not defined.";
   defined $self->{CMD} or die "CMD not defined.";
   defined $self->{BINARY} or die "BINARY not defined.";
   defined $self->{INPUTFILE} or die "INPUTFILE not defined.";
   if(defined $self->{MPINP}){
      $mpirun .= " -np ".$self->{MPINP};
   }
   my $result = $self->{CMD};
   $result =~ s/MPIRUN/$mpirun/;
   my $binary = "$binDir/".$self->{BINARY};
   $result =~ s/BINARY/$binary/;
   my $input = "$self->{folder}/$self->{INPUTFILE}";
   $result =~ s/INPUTFILE/$input/;
   if(defined $self->{SUPPRESS_OUTPUT}){
      if($self->{SUPPRESS_OUTPUT} == 1){
         $result .= " 1>/dev/null";
      }
   }
   return $result;
}

# Use with care;
# Not for production, only for internal management of testcases.
sub compare_to {
   my($self, $other) = @_;
   my @selfkeys = keys %$self;
   my @otherkeys = keys %$other;
   if(scalar @selfkeys != scalar @otherkeys){
      return 0;
   }
   foreach my $key (@selfkeys) {
      if($key ne "folder" && $key ne "RESULT"){
         if(defined $other->{$key}){
            if($self->{$key} ne $other->{$key}){
               return 0;
            }
         } else {
            return 0;
         }
      }
   }
   return 1;
}

sub validate {
   my $self = $_[0];
   my($check, $errorMsg) = validate_inner(@_);
   if(defined $self->{SHOULD_FAIL}){
      if($self->{SHOULD_FAIL} == 1){
         return (!$check, $errorMsg);
      } else {
         return ($check, $errorMsg);
      } 
   } else {
      return ($check, $errorMsg);
   }
}

sub validate_inner {
   my($self, $output, $error, $errCode) = @_;
   if(defined $self->{VALIDATOR}){
      if($self->{VALIDATOR} eq "compare_error"){
         return compare_error($self, $output, $error, $errCode);
      } else {
         $errCode == 0 or return report_error_code($errCode);
         if($self->{VALIDATOR} eq "no_of_triangs"){
            return validate_no_of_triangs($self, $output, $error, $errCode);
         } elsif ($self->{VALIDATOR} eq "thorough") {
            return validate_thoroughly($self, $output, $error, $errCode);
         } elsif ($self->{VALIDATOR} eq "leaks") {
            return validate_leaks($self, $output, $error, $errCode);
         } elsif ($self->{VALIDATOR} eq "timing") {
            return validate_timing($self, $output, $error, $errCode);
         } elsif ($self->{VALIDATOR} eq "compare_output") {
            return compare_output($self, $output, $error, $errCode);
         } elsif ($self->{VALIDATOR} eq "canonical_representative") {
            return validate_canonical_representative($self, $output, $error, $errCode);
         } else {
            die "Validator could not be recognized $self->{VALIDATOR}";
         }
      }
   } else {
      die "No validator found.";
   }
}

###############################################################################
## Check canonical_representative
sub validate_canonical_representative {
   my($self, $output, $error, $errCode) = @_;
   # print "Overflow error:\n$error\n";
   return validate_equal($self, $output);
}

###############################################################################
## Compare output
sub compare_output {
   my($self, $output, $error, $errCode) = @_;
   return validate_equal($self, $output);
}

###############################################################################
## Compare error output
sub compare_error {
   my($self, $output, $error, $errCode) = @_;
   return validate_equal($self, $error, $errCode);
}

###############################################################################
## Check timing
sub validate_timing {
   my($self, $output, $error, $errCode) = @_;
   # print "Timing error:\n$error, $errCode\n";
   my($real) = $error =~ m/real (\d+\.\d+)/;
   my $check = $real <= $self->{RESULT};
   report_test_result($check, $self->{RESULT}, $real, $error);
}

###############################################################################
## Check for leaks
sub validate_leaks {
   my($self, $output, $error, $errCode) = @_;
   if($error =~ m/All heap blocks were freed -- no leaks are possible/s) {
      return 1;
   }
   my $check = eval_leak_var("definitely", $error);
   $check &= eval_leak_var("indirectly", $error);
   $check &= eval_leak_var("possibly", $error);
   if(!$check) {
      report_test_result(0, "no leaks", $error);
   }
   report_test_result(1, "", "");
}

sub eval_leak_var {
   my($var_name, $error) = @_;
   return $error =~ m/$var_name lost: 0 bytes in 0 blocks/s;
}

###############################################################################
## Check equality of results up to permutation
sub validate_thoroughly {
   my($self, $output, $error, $errCode) = @_;
   defined $self->{RESULT} or die "Result file name not given.";
   my $resultfile = $self->{folder}."/".$self->{RESULT};
   my $desired = `cat $resultfile`;
   my @triangulations1 = extract_triangulations($output);
   my @triangulations2 = extract_triangulations($desired);
   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){
         open(my $failfile, ">$resultfile.fail");
         print $failfile $output;
         close($failfile);
         last; 
      }
   }
   report_test_result($check, join("\n", @triangulations2), join("\n", @triangulations1), $error);
}

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;
}

###############################################################################
## Check that number of triangles agree
sub validate_no_of_triangs {
   my($self, $output, $error, $errCode) = @_;
   if(!defined $self->{MPINP}){
      # print "Output:\n$output\n";
   }
   defined $self->{BINARY} or die "Binary not defined.";
   my $binary = $self->{BINARY};
   my $ntriangs;
   if($binary eq "mptopcom"){
      ($ntriangs) = $error =~ m/Total triangulations:\s*(\d+)\n/;
      if(!defined($ntriangs)){
         return (0, $self->{RESULT}, "undefined");
      }
      my $check = $self->{RESULT} == $ntriangs;
      report_test_result($check, $self->{RESULT}, $ntriangs);
   } else {
      return validate_equal($self, $output);
   }
}

sub validate_equal {
   my($self, $output) = @_;
   my $resultfile = $self->{folder}."/".$self->{RESULT};
   my $desired = "";
   if(-e $resultfile){
      $desired = `cat $resultfile`;
   }
   if($desired ne $output){
      open(my $failfile, ">$resultfile.fail");
      print $failfile $output;
      close($failfile);
   }
   if($output eq ""){
      $output = "Warning: empty output\n";
   }
   report_test_result($desired eq $output, $desired, $output);
}

###############################################################################
## Compose potential error msg from expected + got
sub report_test_result {
   my($check, $expected, $got, $error) = @_;
   my $errorMsg = "EXPECTED:\n$expected\n\nGOT:\n$got\n";
   if($error) {
      $errorMsg .= "\nERROR:\n$error";
   }
   return ($check, $errorMsg);
}

###############################################################################
## Compose potential error msg from expected + got
sub report_error_code {
   my($errCode) = @_;
   return (0, "Silent failure: $errCode");
}

1;
