#!/usr/bin/perl
use strict;
use warnings;
use Getopt::Long;
use Fatal qw(close);
use File::Temp qw(tempfile tempdir);
use TAP::Harness;
use TAP::Parser::Aggregator;
use Cwd qw(getcwd);
use File::Spec;
use File::Path;

my $impl = 'rakudo';
our $debug = 0;
our $out_filename = 'autounfudge.patch';

GetOptions  'impl=s'        => \$impl,
            'debug'         => \$debug,
            'specfile=s'    => \my $specfile,
            or usage();
my @files;

if ($specfile){
    @files = read_specfile($specfile);
} else {
    @files = @ARGV or usage();
}

if (-e $out_filename){
    unlink $out_filename or warn "Couldn't delete old unfudge.patch";
}
our $tmp_dir = tempdir('RAKUDOXXXXXX', CLEANUP => 1);

for (@files){
    auto_unfudge_file($_);
}

sub auto_unfudge_file {
    my $file_name = shift;
    open my $f, '<:encoding(UTF-8)', $file_name 
        or die "Can't open '$file_name' for reading: $!";
    print "Processing file '$file_name'\n";
    my @fudge_lines;
    while (<$f>) {
        push @fudge_lines, $. if m/^\s*#\?$impl/ && !m/unspecced/i;
    }
    close $f;
    if (@fudge_lines){
        print "Found " . (scalar @fudge_lines) . " fudges...\n" if $debug;
    } else {
        print "No fudges found. Nothing to do\n" if $debug;
        return;
    }
    my $fudged = fudge($file_name);
    print "Fudged: $fudged\n" if $debug;
    if (!tests_ok($fudged)){
        print "File '$file_name' doesn't even pass in its current state\n";
        return;
    }
    my @to_unfudge;
    for my $to_unfudge (@fudge_lines){
        $fudged = fudge(unfudge_some($file_name, 0, $to_unfudge));
        if (tests_ok($fudged)){
            print "WOOOOOT: Can remove fudge instruction on line $to_unfudge\n"
                if $debug;
            push @to_unfudge, $to_unfudge,
        }
    }

    if (@to_unfudge){
        my $u = unfudge_some($file_name, 1, @to_unfudge);
        system qq{diff -u "$file_name" "$u" >> "$out_filename"};
        unlink $u;
    }

}

sub fudge {
    my $fn = shift;
    open my $p, '-|', 't/spec/fudge', '--keep-exit-code',  $impl, $fn
        or die "Can't launch fudge: $!";
    my $ret_fn = <$p>;
    chomp $ret_fn;
    1 while <$p>;
    close $p;
    return $ret_fn;
}

sub usage {
    die <<"USAGE"
Usage:
    $0 [options] file+
Valid options:
    --debug             Enable debug output
    --impl impl         Specify a different implementation
    --specfile file     Specification file to read filenames from
USAGE
}

sub unfudge_some {
    my ($file, $delete, @lines) = @_;
    my ($fh, $tmp_filename) = tempfile(
            'tempXXXXX', 
            SUFFIX => '.t', 
            DIR => $tmp_dir
    );
    open my $in, '<', $file 
        or die "Can't open file '$file' for reading: $!";
    while (<$in>){
        if ($. == $lines[0]){
            print $fh "###$_" unless $delete;
            shift @lines if @lines > 1;
        } else {
            print $fh $_;
        }
    }
    close $fh;
    close $in;
    return $tmp_filename;
}

sub tests_ok {
    my $fn = shift;
    $fn =~ s/\s+\z//;
    my $harness = get_harness();
    my $agg = TAP::Parser::Aggregator->new();
    $agg->start();
    $harness->aggregate_tests($agg, $fn);
    $agg->stop();
#    my $agg = $harness->runtests($fn);
    return !$agg->has_errors;
}

sub get_harness {
    return TAP::Harness->new({
            verbosity   => -2,
            exec        => ['../../parrot', 'perl6.pbc'],
            merge       => 1,
    });
}

sub read_specfile {
    my $fn = shift;
    my @res;
    open (my $f, '<', $fn) or die "Can't open file '$fn' for reading: $!";
    while (<$f>){
        next if m/#/;
        next unless m/\S/;
        s/\s+\z//;
        push @res, "t/spec/$_";
    }
    return @res;
}

END {
    File::Path::rmtree($tmp_dir);
}