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