cprove

#!/bin/env perl

use v5.14;    # or later

use warnings;
use strict;

use Cwd;

use constant TEST_SUITE_VERSION => 'testsuite';
use constant KNOWN_ERRORS       => 't/' . TEST_SUITE_VERSION . '/C-COMPILED/known_errors.txt';

# blacklist_rules
my @BLACKLIST = (
    qw{benchmark perf porting bigmem lib win32 japh porting run test_pl op/threads.t},
    qr{_thr\.t$},         # do not care about threads
    qr{\Q.subtest.\E},    # blacklist any cruft remaining from a previous or current run
);

exit( run(@ARGV) // 0 ) unless caller;

sub run {
    my (@args) = @_;

    my @copy_args = @args;

    my $v = TEST_SUITE_VERSION;

    return usage() if !scalar @args || grep { $_ =~ qr{^-+h(elp)?$} } @args;

    #$run_compile_version = grep { qr{^-+c(ompiled)?$} } @args;
    my $run_compile_version = !grep { $_ =~ qr{^-+u(ncompiled)?$} } @args;
    @args = grep { $_ !~ qr{^-+u(ncompiled)?$} } @args;

    my $saving_state;

    if ( grep { $_ =~ qr{^--?c(onfig)?$} } @args ) {
        @args = grep { $_ !~ qr{^--?c(onfig)$} } @args;
        say '# Running: Makefile.PL + make install for B::C';
        system('./configure.cpanel') == 0 or do { warn $!; return $? };
        say '# Ok: B::C is updated.';
    }

    if ( grep { $_ eq q{-t} } @args ) {
        @args = grep { $_ ne q{-t} } @args;
        qx{git checkout t};
        say '# git checkout t - ', $? ? 'failure !' : 'ok';
    }

    if ( grep { $_ eq q{-k} } @args ) {
        @args = grep { $_ ne q{-k} } @args;
        qx{git checkout t/$v/C-COMPILED/known_errors.txt};
        say qq[# git checkout t/$v/C-COMPILED/known_errors.txt -], $? ? 'failure !' : 'ok';
        $ENV{PERLCC_DONT_UPDATE_TESTS} = 1;
    }

    if ( !grep { $_ =~ qr{^--state} } @args ) {
        unshift @args, '--state=save';
        unlink '.prove';
        $saving_state = 1;
    }
    if ( grep { $_ =~ qr{^-+errors?$} } @args ) {
        push @args, load_error_tests();
        @args = grep { $_ !~ qr{^-+errors?$} } @args;
    }

    if ( grep { $_ =~ qr{^-+(git|new)$} } @args ) {
        push @args, load_new_error_tests();
        @args = grep { $_ !~ qr{^-+(git|new)$} } @args;
    }

    if ( grep { $_ eq '--all' } @args ) {
        my $tv       = TEST_SUITE_VERSION;
        my @alltests = glob qq{t/$tv/C-COMPILED/*/*.t};
        @args = grep { $_ ne '--all' } @args;
        push @args, '-j10' unless grep { $_ =~ qr{^-j} } @args;
        push @args, @alltests;
    }
    my $call_restart = grep { $_ eq '--restart' || $_ eq '--rerun' } @args;

    my $restart = sub {
        my $cwd        = cwd();
        my $no_restart = !$saving_state;

        # do not restart the test if -v was already used
        $no_restart ||= grep { $_ =~ qr{^\-+v} } @copy_args;

        # only preserve options except -j and verbose
        my @args = grep { $_ =~ qr{^\-} && $_ !~ qr{^\-\-?[jv]} } @copy_args;
        unshift @args, '-v';
        my @cmd = ( $0, '--state=failed', @args );

        return sub {

            # cannot rerun if we do not save the state
            return if $no_restart;
            $ENV{VERBOSE} = 1;
            print "# Rerunning failures with verbose on\n";
            print join( ' ', '#', '>', @cmd, "\n" );
            chdir($cwd);
            exec @cmd;
        };
      }
      ->();

    my @blacklist_tests = load_blacklisted_tests();

    my @tests;
    while ( $args[-1] && $args[-1] =~ m/\.t$/ ) {
        my $t = pop @args;

        # can simply run 'prove op/kvaslice.t'
        if ( $t !~ qr{\Q/$v/\E} ) {
            $t = 't/' . $v . '/t/' . $t;
        }

        $t =~ s{C-COMPILED}{t};    # normalize

        my ( $before, $after ) = split( $v . '/t/', $t );
        if ($run_compile_version) {
            $t = $before . $v . '/C-COMPILED/' . $after;
        }
        else {
            $t = $after;           # need to chdir for the uncompiled version
        }

        if ( grep { $t eq $_ } @blacklist_tests ) {
            say "Test '$t' is blacklisted by known_errors.txt file";
            next;
        }

        # remove blacklisted tests
        do { say "Test '$t' is blacklisted by a rule."; next } if grep { ref $_ ? ( $t =~ $_ ) : ( $t =~ qr{^$_/} or $t =~ qr{$_$} ) } @BLACKLIST;

        #die "Cannot find a test file" unless -e $t;
        unshift @tests, $t;
    }

    my @cmd = ( 'prove', @args, @tests );
    if ( int( grep { $_ !~ qr{^-} } @cmd ) < 2 ) {    # should have at least one test to run
        say "# Nothing to run";
        return 1;
    }

    say "# Running: ", join( ' ', @cmd );
    if ( !$run_compile_version ) {
        chdir("t/$v/t");                              # core tests need to be run from t directory
    }

    # allow glob...
    system( join ' ', @cmd );
    my $status = $?;
    $restart->() if $run_compile_version && $call_restart && $status;

    return $status == 0 ? 0 : 1;
}

# cprove --new only run new errors detected on the file
sub load_new_error_tests {
    my $db = KNOWN_ERRORS;
    my @result = split /\n/, qx{git diff --unified=0 $db};

    my %tests;
    foreach my $line (@result) {
        next if $line =~ qr{^(\-\-\-|\+\+\+)\s};
        next unless $line =~ s{^(\-|\+)}{};
        if ( $line =~ qr{([^\s]+\.t)\s} ) {
            $tests{$1} = 1;
        }
    }

    return sort keys %tests;
}

sub load_error_tests {
    my @tests;

    open( my $fh, '<', KNOWN_ERRORS ) or die;
    while ( my $line = <$fh> ) {
        next if $line =~ qr/^\s*#/;
        if ( $line =~ qr{^([^\s]+\.t)\s} ) {
            push @tests, $1;
        }
    }

    return @tests;
}

sub load_blacklisted_tests {
    my @tests;

    open( my $fh, '<', KNOWN_ERRORS ) or die;
    while ( my $line = <$fh> ) {
        next if $line =~ qr/^\s*#/;
        next unless $line =~ m{\b(?:COMPAT|SKIP)\b};
        if ( $line =~ qr{^([^\s]+\.t)\s} ) {
            push @tests, $1;
        }
    }

    return @tests;
}

sub usage {

    my $V = TEST_SUITE_VERSION;

    print <<"EOS";
# run the compiled version
> cprove -j4 t/$V/t/*/*.t
> cprove t/$V/C-COMPILED/op/my.t
# rerun new failures or passing test to flag them correctly
> cprove -j4 --rerun t/$V/t/*/*.t

# run everything in parallel
> cprove --all
> cprove -j10 t/$V/C-COMPILED/*/*.t

# run the uncompiled version
> cprove -u -j4 t/$V/t/*/*.t
> cprove -u t/$V/C-COMPILED/op/my.t

# run the compiled version
> cprove op/my.t

# run the uncompiled version
> cprove -u -v op/my.t

# run multiple compiled tests
> cprove op/*.t

# recompile B::C before running one or more tests
> cprove -c -v extra/*.t
> cprove --config -v extra/*.t

# run 'git checkout t' before running tests
> cprove -t extra/something.t

# run 'git checkout t/$V/C-COMPILED/known_errors.txt before running tests
> cprove -k extra/something.t

# combo: recompile B::C and git checkout t before running one or more tests
> cprove -c -v -t extra/const-array.t
> cprove -c -v -t extra/*.t

# run only tests known as broken
> cprove --errors

# run new errors detected by a git diff
> cprove --new
or
> cprove --git

EOS

    return 0;
}