#!/usr/bin/env perl
########################################################################
# test-os8-run - Collects the set of all --*-os8-* options from the
#   configure script, generates all unique subsets of that option set,
#   runs configure with each of those subsets, and compares the output
#   OS/8 bin RK05 disk to the previous run's version.  If there is a
#   discrepancy, generate a diff against the build log for that option
#   set and report the problem for the user to diagnose.
#
#   The first time the script is run, or the first time a new unique
#   option subset is generated, we save the build results as the
#   exemplar to use in later tests.
#
# Copyright © 2017-2018 by Warren Young
#
# Permission is hereby granted, free of charge, to any person obtaining
# a copy of this software and associated documentation files (the
# "Software"), to deal in the Software without restriction, including
# without limitation the rights to use, copy, modify, merge, publish,
# distribute, sublicense, and/or sell copies of the Software, and to
# permit persons to whom the Software is furnished to do so, subject to
# the following conditions:
#
# The above copyright notice and this permission notice shall be
# included in all copies or substantial portions of the Software.
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
# EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
# MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
# IN NO EVENT SHALL THE AUTHORS LISTED ABOVE BE LIABLE FOR ANY CLAIM,
# DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT
# OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE
# OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
#
# Except as contained in this notice, the names of the authors above
# shall not be used in advertising or otherwise to promote the sale,
# use or other dealings in this Software without prior written
# authorization from those authors.
########################################################################

use strict;
use warnings;

# Modules from CPAN
use Math::Subsets::List;
use Parallel::Loops;

# Core modules
use Cwd qw(getcwd abs_path);
use Digest::SHA qw(sha256_hex);
use English;
use File::Basename;
use File::Copy;
use Getopt::Std;
use List::Util qw(shuffle);
use Term::ANSIColor;

# Perl::Critic rules we're willing to bend
## no critic (InputOutput::RequireBriefOpen )


#### GLOBALS ###########################################################

my @tests;
my $tests_mf;
my (%generated, %tested);
my $currlog = 'obj/os8-run.log';
my $cmplz = abs_path (dirname ($0)) . '/cmplz';

# Command line option values
my ($dry_run, $existing_only, $generate_only, $single_core, $shuffle,
        $verbose);


#### sanitize_log ######################################################
# Copy the given input log file to the ouptut file, expurgating bits
# that change from one run to the next without being meaningful.

sub sanitize_log
{
    my ($ifile, $ofile) = @_;

    open my $if, '<', $ifile or die "Cannot read $ifile: $!\n";
    open my $of, '>', $ofile or die "Cannot write $ofile: $!\n";

    while (<$if>) {
        # Strip all the CRs out.  We only need the LFs.
        s{\r}{}gs;
        my $original = $_;      # save it post-strip

        # Strip variable parts of SIMH line following each Ctrl-E:
        #
        # "Simulation stopped, PC: 01210 (JMP 1207)"
        s{
            (Simulation\ stopped)            # bit to preserve
            ,\ PC:\ \d+\ \([A-Z]+(\ \d+)?\)  # variable bit
        }{$1.}x;

        # Rewrite SIMH ATTACH commands to remove pointless differences
        # in absolute paths between machines or Fossil checkouts.
        s{
            (attach\ )           # SIMH command
            (-r\ )?              # optional flag
            ([a-z0-9]+\ )        # SIMH device name
            (.*test/tmp/[0-9]+/) # noise parts of image file name thru PID
        }{$1$3.../}x;
        s{
            (attach\ )
            (-r\ )?
            ([a-z0-9]+\ )
            (.*/(media/os8)/)    # also squish this noise
        }{$1$3.../$5/}x;

        # Add cleaned line to ofile
        print $of $_;
    }

    close $if;
    close $of;

    return;
}


#### construct_test ####################################################
# Assembles a test record for a single permutation

sub construct_test
{
    my @opts = @_;

    # Distill this option set to a hash value after which we will
    # name the output files.  We don't want to name files with a
    # leading hyphen or with long variable-length names, potentially
    # multiple lines long.
    my $optstr = join ' ', @opts;
    my $hash = sha256_hex($optstr);
    my $hdir = "test/$hash";    # test hash dir relative to our CWD
    my $rhdir = "../../$hash";  # $hdir relative to builddir test/tmp/$PID
    my $test = { 
        hash   => $hash,
        hdir   => $rhdir,
        log    => "$rhdir/last.log",
        name   => '{' . substr ($hash, 0, 12) . '}',
        optstr => $optstr,
        rklz   => "$rhdir/last.rklz",
    };

    # Skip this one if it already exists and we're in -g mode.
    if ($generate_only) {
        if (-d $hdir) {
            if (-f "$hdir/last.log") {
                if (-f "$hdir/last.rklz") {
                    print "Skipping $test->{name}: already done.\n";
                    return;
                }
                elsif ($verbose) {
                    print "Must re-gen $hash despite -g: rklz missing!\n";
                }
            }
            elsif ($verbose) {
                print "Must re-gen $hash despite -g: log missing!\n";
            }
        }
        elsif ($verbose) {
            print "Will generate $hash.\n";
        }
    }
    elsif (-d $hdir) {
        print "Will test $optstr against $hash.\n" if $verbose;
    }
    elsif ($verbose) {
        print "Must generate missing test set $hash.\n";
    }

    push @tests, $test;

    return;
}


#### compare_rklz ######################################################
# Compare two lz4-compressed RK05 disk images, returning true if they
# are the same.  If they are different, also outputs a binary difference
# report.
#
# We call a separate shell script instead of use inline shell code here
# because the helper code uses a Bash feature, and /bin/sh might not be
# bash, as on a Raspbian box.

sub compare_rklz
{
    my ($r1, $r2) = @_;
    return system("$cmplz '$r1' '$r2'") == 0;
}


#### do_test ###########################################################
# Test a single permutation

sub do_test
{
    # Set up working directory
    my $test = $_;
    print "Configuring test $test->{name}, PID $PID...\n";
    return if $dry_run;
    chdir "test/tmp" or die "Could not CD to tmp dir: $!\n";
    mkdir $PID;
    chdir $PID;
    die "Could not mkdir $test->{hdir}: $!\n"
            unless -d $test->{hdir} || mkdir($test->{hdir});

    my $currdsk = "bin/v3d.rk05";
    my $currdlz = substr ($currdsk, 0, length ($currdsk) - 2) . 'lz';
    my $target  = 'os8-sys';

    # Configure the test disk image
    system "../../../configure $test->{optstr} > cfg.log 2>&1"
            and die "Failed to configure $test->{name}!\n";
    # We used to link binaries here, but there are more now.
    # So our target, os8-sys now installs binaries and libraries we need.
    open my $itf, '>', 'media/os8/init.tx'             # avoid a pointless diff
            or die "Cannot overwrite init.tx with neutral version: $!\n";
    print $itf "TEST-OS8-RUN BUILT THIS DISK IMAGE.\n\n";
    close $itf;

    # Build the test disk image
    print "Building $currdsk for test $test->{name} (PID $PID)...\n";
    system "make $target > make.log 2>&1"
            and die "Failed to build $currdsk!\n";

    # Quickly compress the test disk: we don't want to store all the
    # "air" in an RK05 in our test corpus.
    system("lz4 -q $currdsk > $currdlz");

    if (not -f $test->{log} or not -f $test->{rklz}) {
        # This test hasn't run here yet, so save it as our exemplar for
        # this optstr, to be compared to future builds.
        sanitize_log ($currlog, $test->{log});
        move ($currdlz, $test->{rklz});

        # Log the mapping between the hash and the options it
        # represents, so the user can reverse it.
        print $tests_mf "$test->{hash}  $test->{optstr}\n";
        $generated{$test->{hash}} = 1;
    }
    elsif (compare_rklz ($currdlz, $test->{rklz})) {
        # We had this test examplar here already and on re-doing it we
        # got the same result.
        print colored(['green'], "mkos8 $test->{name} test passed."), "\n";
        $tested{$test->{hash}} = 1;
    }
    else {
        # This build resulted in a difference, so yell and save the
        # results for manual comparison.
        my $fdiff = "$test->{hdir}/fail.diff";
        my $faillog = "$test->{hdir}/fail.log";
        sanitize_log ($currlog, $faillog);
        move ($currdlz, $test->{hdir} . '/fail.rklz');
        system "diff -wu $test->{log} $faillog > $fdiff";
        print colored(['bold red'], 'RESULT DIFFERS!  See test/',
                substr($fdiff, 6)), "\n";
        $tested{$test->{hash}} = 0;
    }

    system("cd .. ; rm -fr $PID");      # -f because there are read-only files

    return;
}


#### remove_missing ####################################################
# Implements -e: given a list of mkos8 options, returns only those for
# which we have a valid test set.

sub remove_missing
{
    my (@tests) = @_;
    my $all = @tests;

    # First read in the set of prebuilt tests, filtering out those that
    # refer to output files that do not exist here.  (This happens when
    # copying over the manifest file but only a subset of the actual
    # test output files.)
    my %existing;
    my $genned = 0;
    my $mff = 'test/tests-manifest.txt';
    open my $mf, '<', $mff or die "Could not read from $mff: $!\n";
    while (<$mf>) {
        chomp;
        my ($hash, @opts) = split ' ';
        my $dir = 'test/' . $hash;
        if (-d $dir and -f "$dir/last.rklz" and -f "$dir/last.log") {
            $existing{join ' ', @opts} = $hash;
        }
        ++$genned;
    }
    close $mf;

    # Now filter the test set to remove those that do not exist
    my @filtered = grep { $existing{$_->{optstr}} } @tests;
    print "Filtered $genned of $all tests down to ", scalar(@filtered),
            " for -e.\n";
    return @filtered;
}


#### report* ###########################################################
# Print on-exit status report.

sub report_part
{
    my ($partref, $kind) = @_;

    return unless keys %$partref;

    my ($successes, $tries) = (0, 0);
    for my $s (values %$partref) {
        ++$tries;
        ++$successes if $s;
    }

    my $extra = $successes == $tries ? '' : " of $tries";
    print colored ([
                $successes == 0 ? 'bold red' :
                    $successes != $tries ?
                        'bold yellow' :
                        'green'
            ],
            "Successfully $kind $successes$extra tests.\n");
}

sub report
{
    print "\n", '=' x 79, "\n";
    report_part (\%generated, 'generated');
    report_part (\%tested,    'built');
    print "\n";

    return;
}


#### main ##############################################################

# Parse command line
my %clopts;
getopts('egnsv1', \%clopts) or die "Failed to parse command line!\n";
$dry_run = $clopts{n};
$existing_only = $clopts{e};
$generate_only = $clopts{g};
$shuffle = $clopts{s};
$verbose = $clopts{v};
$single_core = $clopts{1};

# Init global resources
mkdir 'test';
system("rm -rf test/tmp");
mkdir 'test/tmp';
open $tests_mf, '>>', 'test/tests-manifest.txt'
        or die "Cannot append to test manifest: $!\n";
$SIG{INT} = $SIG{TERM} = sub { report; exit 1 };
$SIG{PIPE} = 'IGNORE';

# Get all current --*-os8-* options, filtering out those we know should
# not be tried for this:
#
# *   No --os8-minimal because that just turns on all --disable-os8-* 
#     options, so it's already covered.
# *   No --disable-os8-src because we don't test the src disk; it's
#     always generated the same way.
# *   No --disable-os8-focal because it disables the other two FOCAL
#     options, which we're already going to test singly and together.
my @cmd = (
    "./configure --help",
    "grep -- -os8-",
    "sed -Ee 's/^ +//'",
    "cut -f1 -d' '",
    "grep -v -e 'os8-minimal' -e 'os8-src' -e 'os8-focal\$'"
);
open my $ocmd, '-|', join('|', @cmd) or die "Failed to get os8 option set: $!\n";
my @cfgOpts = <$ocmd>;
close $ocmd;
chomp @cfgOpts;

# Generate all possible permutations of those options.  Shuffle them if
# requested.
subsets \&construct_test, @cfgOpts;
@tests = remove_missing(@tests) if $existing_only;
@tests = shuffle @tests if $shuffle;

# Run the tests
my $tdir = abs_path(dirname($0));
my $cores = $single_core ? 1 : int(`$tdir/corecount`);
my $pl = Parallel::Loops->new($cores);
$pl->share (\%generated, \%tested);
$pl->foreach ( \@tests, \&do_test);

report;
