#!/usr/bin/perl -w

$successes=0;
$total=0;
$verbose="no";
$pager="cat";
$log="";
$tmp1 = "/tmp/equations-1";
$tmp2 = "/tmp/equations-2";
$tmp3 = "/tmp/equations-diff";
@keys = ();
$collectkeys = 0;
$collectcases = 0;
%knownkeys = ();
$filearg = 0;
$status = 0;
$statusfilter = "all";
$grep = "egrep";

sub runone
{
    my $mismatch = 0;
    my ($f,%info) = @_;
    system "MODELICAUSERCFLAGS=$info{cflags} ../../modeq/modeq $f >$log 2>&1";
#    system "../modeq/modeq +d=daedump $f >$log 2>&1";
#    system "../modeq $f >$log 2>&1";
#    system "/home/x97davka/modeq/modeq $f >$log 2>&1";
    
    if ( $? != 0 ) {
	if ($info{"status"} eq "parseerrormsg") {

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

	    system "diff -w $tmp1 $tmp2 > $tmp3";
	    if ( $? != 0 ) {
		open(LOG,">>$log");
		print LOG "\n";		print LOG "Parsing error message diff:\n\n";
		
		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 "parse error message mismatch\n";
		    return 1;
		}
	    }
	    print "ok\n";
	    return 0;
	}

	if ($info{"status"} eq "incorrect") {
	    print "ok\n";
	    return 0;
	}
	print "nonzero exit status\n";
	return 1;
    }

    system "$grep -s -q '^#|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>) {
	if (/^fclass/../^end/) {
	    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";

    if ( $? != 0 ) {
	  open(LOG,">>$log");
	  print LOG "\n";
	  print LOG "Equation diff:\n\n";

	  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",
		"cflags"   => "");
    $log = "/tmp/log-$f";
    $tc_err = 0;
    # Find the expected result
    open(OUT,">$tmp2");
    open(IN,"<$f");
    while(<IN>) {
	if (/^\/\/[ \\|]([a-z]*): *(.*)$/) {
	    $info{$1} = $2;
	    # print "Noticed $1 = $2\n";
	} elsif (/^\/\/ fclass/../^\/\/ end/) {
	    s/^[ \t]*//;
	    s/[ \t]+/ /;
	    if (/^.../) {
		print OUT substr($_,3);
	    }
	    elsif ($tc_err == 0)  {
		print "Error in testcase: $f\n";
		$tc_err = 1;		
	    }
	} elsif (/^\/\/ \[/..$/) {
	    s/^[ \t]*//;
	    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|parseerrormsg)$/ ) {
	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 "-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;
	dofile $arg;
    }
}

# Check for no file args
if ($filearg == 0) {
    system "mkdir /tmp/log-drmodelica";
    for (glob '*.mo ') { dofile $_; }
    system "rm -rf /tmp/log-drmodelica";
}

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