Commit | Line | Data |
f7c69158 |
1 | #!/usr/bin/perl -w |
2 | |
3 | use strict; |
4 | use lib 't/lib'; |
5 | |
6 | use Test::More; |
7 | use TAP::Parser::Scheduler; |
8 | |
9 | my $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 | |
19 | my $incomplete_rules = { par => [ { seq => [ '*A', '*D' ] } ] }; |
20 | |
21 | my $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 | |
35 | my @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 | |
76 | plan tests => @schedule * 2 + 266; |
77 | |
78 | for 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 | |
174 | sub finish { $_->finish for @_ } |
175 | |
176 | sub 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 | |
191 | sub 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 | |