1#!/usr/bin/perl -w
2
3use strict;
4use lib 't/lib';
5
6use Test::More;
7use TAP::Parser::Scheduler;
8
9my $perl_rules = {
10    par => [
11        { seq => '../ext/DB_File/t/*' },
12        { seq => '../ext/IO_Compress_Zlib/t/*' },
13        { seq => '../lib/CPANPLUS/*' },
14        { seq => '../lib/ExtUtils/t/*' },
15        '*'
16    ]
17};
18
19my $incomplete_rules = { par => [ { seq => [ '*A', '*D' ] } ] };
20
21my $some_tests = [
22    '../ext/DB_File/t/A',
23    'foo',
24    '../ext/DB_File/t/B',
25    '../ext/DB_File/t/C',
26    '../lib/CPANPLUS/D',
27    '../lib/CPANPLUS/E',
28    'bar',
29    '../lib/CPANPLUS/F',
30    '../ext/DB_File/t/D',
31    '../ext/DB_File/t/E',
32    '../ext/DB_File/t/F',
33];
34
35my @schedule = (
36    {   name  => 'Sequential, no rules',
37        tests => $some_tests,
38        jobs  => 1,
39    },
40    {   name  => 'Sequential, Perl rules',
41        rules => $perl_rules,
42        tests => $some_tests,
43        jobs  => 1,
44    },
45    {   name  => 'Two in parallel, Perl rules',
46        rules => $perl_rules,
47        tests => $some_tests,
48        jobs  => 2,
49    },
50    {   name  => 'Massively parallel, Perl rules',
51        rules => $perl_rules,
52        tests => $some_tests,
53        jobs  => 1000,
54    },
55    {   name  => 'Massively parallel, no rules',
56        tests => $some_tests,
57        jobs  => 1000,
58    },
59    {   name  => 'Sequential, incomplete rules',
60        rules => $incomplete_rules,
61        tests => $some_tests,
62        jobs  => 1,
63    },
64    {   name  => 'Two in parallel, incomplete rules',
65        rules => $incomplete_rules,
66        tests => $some_tests,
67        jobs  => 2,
68    },
69    {   name  => 'Massively parallel, incomplete rules',
70        rules => $incomplete_rules,
71        tests => $some_tests,
72        jobs  => 1000,
73    },
74);
75
76plan tests => @schedule * 2 + 266;
77
78for my $test (@schedule) {
79    test_scheduler(
80        $test->{name},
81        $test->{tests},
82        $test->{rules},
83        $test->{jobs}
84    );
85}
86
87# An ad-hoc test
88
89{
90    my @tests = qw(
91      A1 A2 A3 B1 C1 C8 C5 C7 C4 C6 C3 C2 C9 D1 D2 D3 E3 E2 E1
92    );
93
94    my $rules = {
95        par => [
96            { seq => 'A*' },
97            { par => 'B*' },
98            { seq => [ 'C1', 'C2' ] },
99            {   par => [
100                    { seq => [ 'C3', 'C4', 'C5' ] },
101                    { seq => [ 'C6', 'C7', 'C8' ] }
102                ]
103            },
104            {   seq => [
105                    { par => ['D*'] },
106                    { par => ['E*'] }
107                ]
108            },
109        ]
110    };
111
112    my $scheduler = TAP::Parser::Scheduler->new(
113        tests => \@tests,
114        rules => $rules
115    );
116
117    # diag $scheduler->as_string;
118
119    my $A1 = ok_job( $scheduler, 'A1' );
120    my $B1 = ok_job( $scheduler, 'B1' );
121    finish($A1);
122    my $A2 = ok_job( $scheduler, 'A2' );
123    my $C1 = ok_job( $scheduler, 'C1' );
124    finish( $A2, $C1 );
125    my $A3 = ok_job( $scheduler, 'A3' );
126    my $C2 = ok_job( $scheduler, 'C2' );
127    finish( $A3, $C2 );
128    my $C3 = ok_job( $scheduler, 'C3' );
129    my $C6 = ok_job( $scheduler, 'C6' );
130    my $D1 = ok_job( $scheduler, 'D1' );
131    my $D2 = ok_job( $scheduler, 'D2' );
132    finish($C6);
133    my $C7 = ok_job( $scheduler, 'C7' );
134    my $D3 = ok_job( $scheduler, 'D3' );
135    ok_job( $scheduler, '#' );
136    ok_job( $scheduler, '#' );
137    finish( $D3, $C3, $D1, $B1 );
138    my $C4 = ok_job( $scheduler, 'C4' );
139    finish( $C4, $C7 );
140    my $C5 = ok_job( $scheduler, 'C5' );
141    my $C8 = ok_job( $scheduler, 'C8' );
142    ok_job( $scheduler, '#' );
143    finish($D2);
144    my $E3 = ok_job( $scheduler, 'E3' );
145    my $E2 = ok_job( $scheduler, 'E2' );
146    my $E1 = ok_job( $scheduler, 'E1' );
147    finish( $E1, $E2, $E3, $C5, $C8 );
148    my $C9 = ok_job( $scheduler, 'C9' );
149    ok_job( $scheduler, undef );
150}
151
152{
153    my @tests = ();
154    for my $t ( 'A' .. 'Z' ) {
155        push @tests, map {"$t$_"} 1 .. 9;
156    }
157    my $rules = { par => [ map { { seq => "$_*" } } 'A' .. 'Z' ] };
158
159    my $scheduler = TAP::Parser::Scheduler->new(
160        tests => \@tests,
161        rules => $rules
162    );
163
164    # diag $scheduler->as_string;
165
166    for my $n ( 1 .. 9 ) {
167        my @got = ();
168        push @got, ok_job( $scheduler, "$_$n" ) for 'A' .. 'Z';
169        ok_job( $scheduler, $n == 9 ? undef : '#' );
170        finish(@got);
171    }
172}
173
174sub finish { $_->finish for @_ }
175
176sub ok_job {
177    my ( $scheduler, $want ) = @_;
178    my $job = $scheduler->get_job;
179    if ( !defined $want ) {
180        ok !defined $job, 'undef';
181    }
182    elsif ( $want eq '#' ) {
183        ok $job->is_spinner, 'spinner';
184    }
185    else {
186        is $job->filename, $want, $want;
187    }
188    return $job;
189}
190
191sub test_scheduler {
192    my ( $name, $tests, $rules, $jobs ) = @_;
193
194    ok my $scheduler = TAP::Parser::Scheduler->new(
195        tests => $tests,
196        defined $rules ? ( rules => $rules ) : (),
197      ),
198      "$name: new";
199
200    # diag $scheduler->as_string;
201
202    my @pipeline = ();
203    my @got      = ();
204
205    while ( defined( my $job = $scheduler->get_job ) ) {
206
207        # diag $scheduler->as_string;
208        if ( $job->is_spinner || @pipeline >= $jobs ) {
209            die "Oops! Spinner!" unless @pipeline;
210            my $done = shift @pipeline;
211            $done->finish;
212
213            # diag "Completed ", $done->filename;
214        }
215        next if $job->is_spinner;
216
217        # diag "      Got ", $job->filename;
218        push @pipeline, $job;
219
220        push @got, $job->filename;
221    }
222
223    is_deeply [ sort @got ], [ sort @$tests ], "$name: got all tests";
224}
225
226