harness

#! parrot-nqp

INIT {
    pir::load_bytecode('library/kakapo_full.pbc');
    pir::load_bytecode('t/testlib/pla_test.pbc');
}

MAIN();

# TAP grammar in ABNF
# http://testanything.org/wiki/index.php/TAP_at_IETF:_Draft_Standard#Grammar
# TODO:
# verbose mode

sub MAIN () {
    my $total_passed := 0;
    my $total_failed := 0;
    my $total_files  := 0;
    my $failed_files := 0;
    my $max_length   := 30;
    my @files := get_all_tests("t", "t/pmc");
    my %failures := {};

    for @files {
        my $filename := $_;
        $total_files++;
        print_filename($filename, $max_length);
        %failures{$filename} := [];

        my $test_output := run_test($filename);
        my $plan := $test_output[0];
        my @plan_parts  := $plan.split('..');
        my $num_tests   := @plan_parts[1];
        my $curr_test   := 0;
        my $passed      := 0;
        my $failed      := 0;

        $test_output.shift;  # we don't need the plan anymore

        for $test_output {
            my $line := $_;

            if ( $line ) {

                my $line_parts := $line.split("ok ");
                my $right_side := $line_parts[1];
                my $right_side_parts := $right_side.split(' ');
                my $test_number := $right_side_parts[0];
                # strip out comments
                unless ($test_number > 0) {
                    my @test_num_parts := $test_number.split(' -');
                    $test_number := @test_num_parts[0];
                }
                if ($line_parts[0] eq 'not ') {
                    $failed++;
                    $curr_test++;
                    my $test_name := $line.split(' - ')[1];
                    %failures{$filename}.push($test_number ~ ": " ~ $test_name);
                } elsif ($test_number == ($curr_test+1)) {
                    $passed++;
                    $curr_test++;
                }
            }
        }
        if $failed {
            pir::say('not ok (' ~ $failed ~ '/' ~ $num_tests ~ ' failed)');
        }
        else {
            if @plan_parts[0] != 1 || $num_tests < 0 {
                pir::say('INVALID PLAN: ' ~ @plan_parts.join());
                $failed_files++;
            }
            else {
                pir::say('ok');
            }
        }
        $total_passed := $total_passed + $passed;
        $total_failed := $total_failed + $failed;
        if $num_tests != $curr_test {
            pir::say("Planned to run " ~ $num_tests ~ " tests but ran " ~ $curr_test ~ " tests");
            pir::say("FAILED");
        }
        reset_test_environment();
    }
    if $total_failed {
        pir::say("FAILED " ~ $total_failed ~ '/' ~ ($total_passed+$total_failed));
        pir::say("");
        pir::say("========================== FAILURES ==========================");
        for %failures {
            my $testfile := $_;
            my $failures_in_here := pir::elements(%failures{$testfile});
            if $failures_in_here > 0 {
                pir::say($testfile);
                for %failures{$testfile} {
                    pir::say("\t" ~ $_);
                }
                pir::say("");
            }
        }
        pir::exit(1);
    } elsif $failed_files {
        pir::say("FAILED " ~ $failed_files ~ " files, PASSED " ~ $total_passed ~ ' tests');
    } else {
        pir::say("PASSED " ~ $total_passed ~ ' tests in ' ~ $total_files ~ ' files');
    }
}


sub get_all_tests(*@dirs) {
    my $fs := FileSystem.instance;
    my @files := Parrot::new("ResizableStringArray");
    for @dirs {
        my $dir := $_;
        my @rawfiles := $fs.get_contents($dir);

        for @rawfiles {
            my $filename := $_;
            if pir::index__ISS($filename, ".t") != -1 {
                @files.push($dir ~ "/" ~ $filename);
                my $length := pir::length__IS($dir ~ "/" ~ $filename);
                #if $length > $max_length {
                #    $max_length := $length;
                #}
            }
        }
    }
    return (@files);
}


sub print_filename($filename, $max_length) {
    my $length := pir::length__IS($filename);
    my $diff := ($max_length - $length) + 3;
    my $elipses := pir::repeat__SSI('.', $diff);
    print($filename ~ " " ~ $elipses ~ " ");
}

sub run_test($filename) {
    my $sub := Nqp::compile_file($filename);
    my $stdout := Parrot::new("StringHandle");
    $stdout.open("blah", "rw");
    my %save_handles := Program::swap_handles(:stdout($stdout), :stderr($stdout));
    $sub[0]();
    Program::swap_handles(|%save_handles);
    return ($stdout.readall().split("\n"));
}

sub reset_test_environment() {
    # TODO: This is an evil hack. Test::Builder doesn't clean up it's environment
    #       so when I try to run multiple tests in a single program instance
    #       it breaks. When Test::Builder gets fixed, remove this nonsense
    Q:PIR {
        $P0 = new "Undef"
        set_hll_global [ 'Test'; 'Builder'; '_singleton' ], 'singleton', $P0
    };
}