lib/Test/Harness/t/scheduler.t

   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