Gecko [ www.blackthorn-inc.com ]

Name	Size	Permission	Date
compat	[ DIR ]	drwxr-xr-x	2015-02-14 16:55
data	[ DIR ]	drwxr-xr-x	2015-02-14 16:55
lib	[ DIR ]	drwxr-xr-x	2015-02-14 16:55
proverc	[ DIR ]	drwxr-xr-x	2015-02-14 16:55
sample-tests	[ DIR ]	drwxr-xr-x	2015-02-14 16:55
source_tests	[ DIR ]	drwxr-xr-x	2016-10-10 18:24
subclass_tests	[ DIR ]	drwxr-xr-x	2015-02-14 16:55
aggregator.t	9.35 KB	-r--r--r--	2014-12-27 11:48
bailout.t	3.12 KB	-r--r--r--	2014-12-27 11:48
base.t	4.68 KB	-r--r--r--	2014-12-27 11:48
callbacks.t	2.57 KB	-r--r--r--	2014-12-27 11:48
console.t	1.06 KB	-r--r--r--	2014-12-27 11:48
errors.t	4.64 KB	-r--r--r--	2014-12-27 11:48
file.t	13.61 KB	-r--r--r--	2014-12-27 11:48
glob-to-regexp.t	988 B	-r--r--r--	2014-12-27 11:48
grammar.t	11.55 KB	-r--r--r--	2014-12-27 11:48
harness-bailout.t	1.19 KB	-r--r--r--	2014-12-27 11:48
harness-subclass.t	1.58 KB	-r--r--r--	2014-12-27 11:48
harness.t	28.38 KB	-r--r--r--	2014-12-27 11:48
iterator_factory.t	4.8 KB	-r--r--r--	2014-12-27 11:48
iterators.t	5.68 KB	-r--r--r--	2014-12-27 11:48
multiplexer.t	4.53 KB	-r--r--r--	2014-12-27 11:48
nested.t	860 B	-r--r--r--	2014-12-27 11:48
nofork-mux.t	119 B	-r--r--r--	2014-12-27 11:48
nofork.t	1.55 KB	-r--r--r--	2014-12-27 11:48
object.t	772 B	-r--r--r--	2014-12-27 11:48
parse.t	30.97 KB	-r--r--r--	2014-12-27 11:48
parser-config.t	731 B	-r--r--r--	2014-12-27 11:48
parser-subclass.t	2.2 KB	-r--r--r--	2014-12-27 11:48
perl5lib.t	1.13 KB	-r--r--r--	2014-12-27 11:48
premature-bailout.t	2.32 KB	-r--r--r--	2014-12-27 11:48
process.t	1015 B	-r--r--r--	2014-12-27 11:48
prove.t	47.6 KB	-r--r--r--	2014-12-27 11:49
proveenv.t	338 B	-r--r--r--	2014-12-27 11:49
proverc.t	472 B	-r--r--r--	2014-12-27 11:48
proverun.t	4.14 KB	-r--r--r--	2014-12-27 11:48
proveversion.t	763 B	-r--r--r--	2014-12-27 11:48
regression.t	111.62 KB	-r--r--r--	2014-12-27 11:48
results.t	7.68 KB	-r--r--r--	2014-12-27 11:48
scheduler.t	5.33 KB	-r--r--r--	2014-12-27 11:48
source.t	8.21 KB	-r--r--r--	2014-12-27 11:48
source_handler.t	12.32 KB	-r--r--r--	2014-12-27 11:48
spool.t	3.12 KB	-r--r--r--	2014-12-27 11:48
state.t	7.7 KB	-r--r--r--	2014-12-27 11:48
state_results.t	4.95 KB	-r--r--r--	2014-12-27 11:48
streams.t	6.33 KB	-r--r--r--	2014-12-27 11:48
taint.t	1.3 KB	-r--r--r--	2014-12-27 11:49
testargs.t	4.95 KB	-r--r--r--	2014-12-27 11:48
unicode.t	3.73 KB	-r--r--r--	2014-12-27 11:48
yamlish-output.t	2.44 KB	-r--r--r--	2014-12-27 11:48
yamlish-writer.t	7.17 KB	-r--r--r--	2014-12-27 11:48
yamlish.t	15.01 KB	-r--r--r--	2014-12-27 11:48

Rename

#!/usr/bin/perl -w

use strict;
use warnings;
use lib 't/lib';

use Test::More;
use TAP::Parser::Scheduler;

my $perl_rules = {
    par => [
        { seq => '../ext/DB_File/t/*' },
        { seq => '../ext/IO_Compress_Zlib/t/*' },
        { seq => '../lib/CPANPLUS/*' },
        { seq => '../lib/ExtUtils/t/*' },
        '*'
    ]
};

my $incomplete_rules = { par => [ { seq => [ '*A', '*D' ] } ] };

my $some_tests = [
    '../ext/DB_File/t/A',
    'foo',
    '../ext/DB_File/t/B',
    '../ext/DB_File/t/C',
    '../lib/CPANPLUS/D',
    '../lib/CPANPLUS/E',
    'bar',
    '../lib/CPANPLUS/F',
    '../ext/DB_File/t/D',
    '../ext/DB_File/t/E',
    '../ext/DB_File/t/F',
];

my @schedule = (
    {   name  => 'Sequential, no rules',
        tests => $some_tests,
        jobs  => 1,
    },
    {   name  => 'Sequential, Perl rules',
        rules => $perl_rules,
        tests => $some_tests,
        jobs  => 1,
    },
    {   name  => 'Two in parallel, Perl rules',
        rules => $perl_rules,
        tests => $some_tests,
        jobs  => 2,
    },
    {   name  => 'Massively parallel, Perl rules',
        rules => $perl_rules,
        tests => $some_tests,
        jobs  => 1000,
    },
    {   name  => 'Massively parallel, no rules',
        tests => $some_tests,
        jobs  => 1000,
    },
    {   name  => 'Sequential, incomplete rules',
        rules => $incomplete_rules,
        tests => $some_tests,
        jobs  => 1,
    },
    {   name  => 'Two in parallel, incomplete rules',
        rules => $incomplete_rules,
        tests => $some_tests,
        jobs  => 2,
    },
    {   name  => 'Massively parallel, incomplete rules',
        rules => $incomplete_rules,
        tests => $some_tests,
        jobs  => 1000,
    },
);

plan tests => @schedule * 2 + 266;

for my $test (@schedule) {
    test_scheduler(
        $test->{name},
        $test->{tests},
        $test->{rules},
        $test->{jobs}
    );
}

# An ad-hoc test

{
    my @tests = qw(
      A1 A2 A3 B1 C1 C8 C5 C7 C4 C6 C3 C2 C9 D1 D2 D3 E3 E2 E1
    );

my $rules = {
        par => [
            { seq => 'A*' },
            { par => 'B*' },
            { seq => [ 'C1', 'C2' ] },
            {   par => [
                    { seq => [ 'C3', 'C4', 'C5' ] },
                    { seq => [ 'C6', 'C7', 'C8' ] }
                ]
            },
            {   seq => [
                    { par => ['D*'] },
                    { par => ['E*'] }
                ]
            },
        ]
    };

my $scheduler = TAP::Parser::Scheduler->new(
        tests => \@tests,
        rules => $rules
    );

# diag $scheduler->as_string;

my $A1 = ok_job( $scheduler, 'A1' );
    my $B1 = ok_job( $scheduler, 'B1' );
    finish($A1);
    my $A2 = ok_job( $scheduler, 'A2' );
    my $C1 = ok_job( $scheduler, 'C1' );
    finish( $A2, $C1 );
    my $A3 = ok_job( $scheduler, 'A3' );
    my $C2 = ok_job( $scheduler, 'C2' );
    finish( $A3, $C2 );
    my $C3 = ok_job( $scheduler, 'C3' );
    my $C6 = ok_job( $scheduler, 'C6' );
    my $D1 = ok_job( $scheduler, 'D1' );
    my $D2 = ok_job( $scheduler, 'D2' );
    finish($C6);
    my $C7 = ok_job( $scheduler, 'C7' );
    my $D3 = ok_job( $scheduler, 'D3' );
    ok_job( $scheduler, '#' );
    ok_job( $scheduler, '#' );
    finish( $D3, $C3, $D1, $B1 );
    my $C4 = ok_job( $scheduler, 'C4' );
    finish( $C4, $C7 );
    my $C5 = ok_job( $scheduler, 'C5' );
    my $C8 = ok_job( $scheduler, 'C8' );
    ok_job( $scheduler, '#' );
    finish($D2);
    my $E3 = ok_job( $scheduler, 'E3' );
    my $E2 = ok_job( $scheduler, 'E2' );
    my $E1 = ok_job( $scheduler, 'E1' );
    finish( $E1, $E2, $E3, $C5, $C8 );
    my $C9 = ok_job( $scheduler, 'C9' );
    ok_job( $scheduler, undef );
}

{
    my @tests = ();
    for my $t ( 'A' .. 'Z' ) {
        push @tests, map {"$t$_"} 1 .. 9;
    }
    my $rules = { par => [ map { { seq => "$_*" } } 'A' .. 'Z' ] };

my $scheduler = TAP::Parser::Scheduler->new(
        tests => \@tests,
        rules => $rules
    );

# diag $scheduler->as_string;

for my $n ( 1 .. 9 ) {
        my @got = ();
        push @got, ok_job( $scheduler, "$_$n" ) for 'A' .. 'Z';
        ok_job( $scheduler, $n == 9 ? undef : '#' );
        finish(@got);
    }
}

sub finish { $_->finish for @_ }

sub ok_job {
    my ( $scheduler, $want ) = @_;
    my $job = $scheduler->get_job;
    if ( !defined $want ) {
        ok !defined $job, 'undef';
    }
    elsif ( $want eq '#' ) {
        ok $job->is_spinner, 'spinner';
    }
    else {
        is $job->filename, $want, $want;
    }
    return $job;
}

sub test_scheduler {
    my ( $name, $tests, $rules, $jobs ) = @_;

ok my $scheduler = TAP::Parser::Scheduler->new(
        tests => $tests,
        defined $rules ? ( rules => $rules ) : (),
      ),
      "$name: new";

# diag $scheduler->as_string;

my @pipeline = ();
    my @got      = ();

while ( defined( my $job = $scheduler->get_job ) ) {

# diag $scheduler->as_string;
        if ( $job->is_spinner || @pipeline >= $jobs ) {
            die "Oops! Spinner!" unless @pipeline;
            my $done = shift @pipeline;
            $done->finish;

# diag "Completed ", $done->filename;
        }
        next if $job->is_spinner;

# diag "      Got ", $job->filename;
        push @pipeline, $job;

push @got, $job->filename;
    }

is_deeply [ sort @got ], [ sort @$tests ], "$name: got all tests";
}