#!/usr/bin/perl

use IO::File;
use Getopt::Long;
use File::Compare;

my (%opts);
GetOptions(\%opts, 'dir|d=s', 'compiler|g=s', 'help|h|?', 'icu|i', 'keep|k', 'output|o=s', 'preprocessor|p=s', 'verbose|v', 'testengine|r=s', 'version=i', 'warning|w=i@');

if ($opts{help})
{
    die <<'EOT';
    regtest [-g grcompiler] [-o logfile] [-p gdlpp] [-r regtest] [-v] 
            [-w number] [-k] [dir]
Searches for fonts to run tests on in [dir] (defaults to .) and runs them
storing log info in logfile and exiting with the number of errors

  -d|--dir=dir              Use dir for intermediate test files
  -g|--compiler=grcompiler  command to use to run grcompiler [grcompiler]
  -h|--help                 print this help and exit
  -i|--icu                  Gives icu version or uses icu-config * 10 to guess
  -k|--keep                 keep temporary files
  -o|--output= logfile      file to log to [regtest.log]
  -p|--preprocessor=gdlpp   command to run the gdlpp []
  -r|--testengine=regtest   command to test result font [GrcRegressionTest]
  -v|--verbose              Run compiler -q by default, this stops it
  --version=num             default graphite version to generate [2]
  -w|--warning= number      Run compiler with -w value (may be repeated)
EOT
}

$opts{compiler} ||= 'grcompiler';
$opts{output} ||= 'regtest.log';
$ENV{'GDLPP'} = $opts{preprocessor} if (defined $opts{preprocessor});
$opt{testengine} ||= 'GrcRegressionTest';
$opt{version} ||= 2;

my ($dir) = $ARGV[0] || '.';
my (@fonts) = sort glob("$dir/*Input.ttf");
my ($outf) = IO::File->new("> $opts{output}") || die "Can't create $opts{output}";
my ($f, $errors);
$opts{icu} ||= `icu-config --version` * 10;
my (@icudirs) = reverse sort map {s/^.*?(\d+)$/$1/o; $_} glob("$dir/icu*");

foreach $f (@fonts)
{
    my ($b, $v);
    my ($t) = $f;
    my ($r) = $f;
    my ($n) = $f;
    $n =~ s/Input.ttf$//o;

    next unless (-f "${n}Main.gdl");
    foreach $b ("${n}Benchmark_v2.ttf", "${n}Benchmark_v3.ttf", "${n}Benchmark.ttf")
    {
        next unless (-f $b);
        if ($b =~ m/_v(\d)/o)
        { 
            $v = $1;
            $r = "${n}Test_v$v.ttf";
        }
        else
        {
            $v = $opt{version};
            $r = "${n}Test.ttf";
        }
        if ($opts{dir})
        { $r =~ s{^.*[\\/](.*?)$}{$opts{dir}/$1}o; }
        print "Testing Font: $n at v$v\n";
        $t = "${n}Main.gdl";
#    $r =~ s{^.*[/\\](.*?)$}{$1}o;

        my (@gopts);
        push (@gopts, '-q') unless ($opts{verbose});
        push (@gopts, map {"-w" => $_}, @{$opts{warning}}) if (defined $opts{warning});
        push (@gopts, "-v$v");
        print $opts{compiler} . " " . join(" ", @gopts) . "\n" if ($opts{verbose});
        system($opts{compiler}, @gopts, $t, $f, $r);
        if (-f $r)      # assume it passes if it gives a result
        {
            my ($failed) = 0;
            unlink 'grcregtest.log';
            foreach $i (@icudirs)
            {
                next if ($i > $opts{icu});
                my ($bench) = $b;
                $bench =~ s{/([^/]*)$}{/icu$i/$1}og;
                if (-f $bench)
                {
                    $b = $bench;
                    last;
                }
            }
            my ($res) = system($opts{testengine}, $b, $r);
            if ($res == -1)
            {
                print "Failed to run $opts{testengine} because $!\n";
                $errors++;
                $failed = 1;
            }
            my ($logf) = IO::File->new("grcregtest.log");
            if ($logf)
            {
                while (<$logf>)
                { $outf->print($_); }
                $logf->close;
            }
            if ($res > 0)
            {
                $res >>= 8;
                print "job error $res\n";
                $errors += $res;
                $failed = 1;
            }
            else
            {
                print "Comparing $r and $b\n";
                $failed = compare($r, $b);
                print "comparison error in $f\n" if ($failed);
            }
            unlink $r unless ($opts{'keep'} || $failed);
        }
        else
        {
            my ($logf) = IO::File->new("gdlerr.log");
            if ($logf)
            {
                while (<$logf>)
                { $outf->print($_); }
                $logf->close;
            }
            $errors++;
        }
    }
}

$outf->close;

print "$errors errors encountered\n" if ($errors);
exit($errors);

