#!/usr/bin/perl -w

$successes=0;
$total=0;
$setbaseline=0;
$verbose="yes";
$pager="cat";
$log="";
$tmp1 = "/tmp/equations-1";
$tmp2 = "/tmp/equations-2";
$tmp3 = "/tmp/equations-diff";
$tmp4 = "/tmp/baseline";
@keys = ();
$collectkeys = 0;
$collectcases = 0;
%knownkeys = ();
$filearg = 0;
$status = 0;
$statusfilter = "all";
$epsilon = 1.0e-3;

# Creates a baseline, i.e. the stores the actual result as the expected result
sub setbaseline
{

    my $f = shift;
    $log ="/tmp/log-$f";
    system "omc $f >$log 2>&1";

    open(RES,">$tmp4");
    open(LOG,"<$log");    
    open(SRC,"<$f");
    
    while(<SRC>) {
     if (/^\/\/ Result:/../^\/\/ endResult/) {
       
      } else {
	print RES $_;
      }
    }
    print RES "// Result:\n";
    while(<LOG>) {
	print RES "// ";
	  print RES $_;
        
    }
    print RES "// endResult\n";
    close RES;
    close LOG;
    close SRC;
    print "Set baseline for ";print $f;print "\n"; 
    $total = $total + 1;
    
    open(SRC,"<$tmp4");
    open(DST,">$f");
    while(<SRC>) {
      print DST $_;
    } 
    return 0;
}

sub runone
{
    my $mismatch = 0;
    my ($f,%info) = @_;
    system "omc $f >$log 2>&1";
#    system "../Compiler/omc +d=daedump $f >$log 2>&1";
#    system "../omc $f >$log 2>&1";
    
    if ( $? != 0 ) {
	if ($info{"status"} eq "incorrect") {
	    print "ok\n";
	    return 0;
	}
	print "nonzero exit status\n";
	return 1;
    }

    system "egrep -s '^#|Execution failed!' $log";
    if ( $? == 0 ) {
	if ($info{"status"} eq "incorrect") {
	    print "ok\n";
	    return 0;
	}
	print "execution failed\n";
	return 1;
    }

    if ($info{"status"} eq "incorrect") {
	print "this test should have failed\n";
	return 1;
    }

    # Extract the result
    open(RES,">$tmp1");
    open(LOG,"<$log");
    while(<LOG>) {
      s/^[ \t]*//;
      s/[ \t]+/ /;
      print RES $_;
    }
    close LOG;
    close RES;

    # Compare
    # system "sort $tmp1 > $tmp1-sorted";
    # system "sort $tmp2 > $tmp2-sorted";
    system "diff -w $tmp1 $tmp2 > $tmp3";

	# adrpo - 2006-12-06 
	# if we have only numbers see if their difference is < 1.0e-5 
	# which is the dassl integration step!
	# some array for handline what we "expect" and what we "got"
	my @expect; 
    my @got;
    my $majorNumberDifferences = 0;
    
    if ( $? != 0 ) 
    {  
      # open the log first, as we need to put in the differences!
      open(LOG,">>$log");
	  print LOG "\n";
	  print LOG "Equation diff:\n\n";
    
	  open(DIFF,"<$tmp3");
	  while(<DIFF>) 
	  {
	      if (/^>(.*)$/) 
	      {
	      	my $line = $1;
	      	chomp($line);
	      	$line = trim($line);
		  	push @expect, $line; # push the expected content in @expect
	      } 
	      elsif (/^<(.*)$/) 
	      {
	      	my $line = $1;
	      	chomp($line);
	      	$line = trim($line);
	      	push @got, $line;    # push the calculated content in @got
	      }
	  }
	  close DIFF;
	  # now we have what we need in @expect and @got
	  if (@expect == @got) # are they equal in size?
	  {
		  while ( my $e = pop @expect )
	      { 
	    	my $g = pop @got;
	    		    	
	    	#check if $e and $g are numbers or arrays!
	    	# first try normal numbers!
	    	if (isNumber($e) && isNumber($g))
	    	{
	    		if (LessThanEpsilon($e,$g,$epsilon) == 0)
	    		{
		    	  print LOG "expected:$e - got:$g > epsilon:$epsilon\n";
		    	  $majorNumberDifferences = 1;
		    	  goto DEFAULT;	    			
	    		}
	    		else
	    		{ 
	    	  		print LOG "expected:$e - got:$g < epsilon:$epsilon\n";
	    		}
	    	}
	    	else # here we should have arrays of numbers {0.1, 1.2, ..., nn.mm}
	    	{
	    		# get rid of { and }
	    		$e =~ s/\{//g; $e =~ s/\}//g;
	    		$g =~ s/\{//g; $g =~ s/\}//g;
	    		@expect_array = split /,/ , $e;
	    		@got_array = split /,/ , $g;
	  			if (@expect_array == @got_array) # are they equal in size?
	  			{
		  			while ( my $e1 = pop @expect_array )
	      			{ 
	    				my $g1 = pop @got_array;	    	
	    				# first try normal numbers!
	    				if (isNumber($e1) && isNumber($g1))
	    				{
	    					if (LessThanEpsilon($e1,$g1,$epsilon) == 0)
	    					{
		    	  				print LOG "expected:$e1 - got:$g1 > epsilon:$epsilon\n";
		    	  				$majorNumberDifferences = 1;
		    	  				goto DEFAULT;	    			
	    					}
	    					else
	    					{ 
	    	  					print LOG "expected:$e1 - got:$g1 < epsilon:$epsilon\n";
	    					}
	    				}
	    			}
	    		}
	    		else 
	    		{
	    			goto DEFAULT;
	    		}
	    	} 
	      }
	      if ($majorNumberDifferences == 0)
	      {
	        print "warning - numeric differences less than $epsilon\n";
	        print "\t* for details please check: $log\n";
	        close LOG;
	        return 0;
	      }
	  }
	  
	  DEFAULT:
	  open(DIFF,"<$tmp3");
	  while(<DIFF>) {
	      if (/^>(.*)$/) {
		  print LOG "expected:$1\n";
		  $mismatch = 1;
	      } elsif (/^<(.*)$/) {
		  if (/^< *String(.*)\.unit;$/) {
		      # igore missing units
		  } elsif (/^<.*\.unit = \"\";$/) {
		      # igore missing units
		  } else {
		      print LOG "got:     $1\n";
		      $mismatch = 1;
		  }
	      }
	  }
	  close DIFF;
	  close LOG;

	  if ($mismatch) {
	      print "equation mismatch\n";
	      return 1;
	  }
      }

    print "ok\n";
    return 0;
}

sub dofile
{
    my $f = shift;
    my %info = ("status"   => "unknown",
		"name"     => $f,
		"keywords" => "unknown");
    $log = "/tmp/log-$f";
    $tc_err = 1;
    # Find the expected result
    open(OUT,">$tmp2");
    open(IN,"<$f");
    while(<IN>) {
	# @adrpo - uncomment for debugging
	# print ($_);
	if (/^\/\/[ \\|]*([a-z]*):[ \\|]*([^\012\015\n\r]*)/) {
	    # @adrpo - uncomment for debugging
	    # print "Noticed: $1 = $2\n";		
	    # $info{$1} = $value;
	    $info{$1} = $2;
	} elsif (/^\/\/ Result:/../^\/\/ endResult/) {
	    s/^[ \t]*//;
	    s/^\/\/ Result://;
	    s/^\/\/ endResult//;
	    s/[ \t]+/ /;
	    if (/^.../) {
		print OUT substr($_,3);
	    }
	    elsif ($tc_err == 0)  {
		print "Error in testcase: $f\n";
		$tc_err = 1;		
	    }
	}
    }
    close IN;
    close OUT;

    # Check for keyword match
    if ($#keys >=0) {
	my %ks;
	for (split(/ *, */,$info{"keywords"})) { $ks{$_} = 1; }
	for (@keys) {
	    if (! $ks{$_}) {
		return 0;
	    }
	}
    }

    # Check for status match
     if ($statusfilter ne "all") {
 	if ($info{"status"} ne $statusfilter) {
 	    return 0;
 	}
     }

    # Collecting files
    if ($collectcases) {
	if ($info{'status'} ne "unknown") {
	    print $info{'name'}."\n";
	}
	return 0;
    }

    # Collecting keys?
    if ($collectkeys) {
	if ($info{"keywords"}) {
	    for (split(/ *, */, $info{"keywords"})) {
		if (!$knownkeys{$_}) {
		    $knownkeys{$_} = 1;
		} else {
		    $knownkeys{$_} += 1;
		}
	    }
	}
	return 0;
    }

    printf(" %s %-31s... ",
	   $info{'status'} eq 'correct'?'+':'-', $info{'name'});
    $total = $total + 1;

    if ( $info{"status"} !~ /^(erroneous|(in|)correct)$/ ) {
	print "unknown testcase status\n";
	return 1;
    }

    $status = runone $f,%info;
    if ($status == 0) {
	$successes = $successes + 1;
    } else {
	if ($verbose eq "yes" ) {
	    print "\n";
	    print "==== Log $log\n";
	    system "$pager $log";
	}
    }
}

while ($#ARGV >= 0) {
    $arg = shift(@ARGV);
    if ($arg eq "-v") {
	$verbose="yes";
    } elsif ($arg eq "-b") {
        $setbaseline = 1;
    } elsif ($arg eq "-p") {
	if ($ENV{"PAGER"} eq "") {
	    $pager="more";
	} else {
	    $pager=$ENV{"PAGER"};
	}
    } elsif ($arg eq "-k") {
	if ($#ARGV < 0) {
	    print "-m needs an argument\n";
	    exit 1;
	}
	@keys = split(/,/,shift(@ARGV));
    } elsif ($arg eq "-s") {
	if ($#ARGV < 0) {
	    print "-s needs an argument\n";
	    exit 1;
	}
	$statusfilter = shift;
    } elsif ($arg eq "-l") {
	$collectkeys = 1;
    } elsif ($arg eq "-L") {
	$collectcases = 1;
    } else {	
	$filearg = 1;
	if ($setbaseline) {
          setbaseline $arg
        } else {
	  dofile $arg;
        }
    }
}

##################################################################
## Sub Name: isNumber
## Description: returns 1 if is an integer or a real, else 0
## @author adrpo
##################################################################
sub isNumber
{
    eval
    {
        local $SIG{__WARN__} = sub { die };

        scalar ($_[0] == $_[0]);
    };

    !$@;
}

#@author adrpo
sub trim($)
{
	my $string = shift;
	$string =~ s/^\s+//;
	$string =~ s/\s+$//;
	return $string;
}


##################################################################
## Sub Name: LessThanEpsilon.
## Description: This sub check if $1 - $2 < $3
## @author adrpo
##################################################################
sub LessThanEpsilon
{
	my $e       = shift;
	my $g       = shift;
	my $epsilon = shift;
    	
    if (abs($e - $g) < $epsilon) 
    {
    		return 1;
    }
    else 
    {
    		return 0;	
    }	
}

# Check for no file args
if ($filearg == 0) {
    for (glob '*.mos ') { dofile $_; }
}

# Final output. Statistics and stuff
if ($collectkeys || $collectcases) {
    for (sort(keys %knownkeys)) {
	printf "  %3d %s\n", $knownkeys{$_}, $_;
    }
} elsif ($setbaseline) {
  printf "\n== set new baseline for %d tests\n",$total;
} else {
    printf "\n== %d out of %d tests succeeded\n", $successes, $total;
}

