ext/Test-Harness/t/multiplexer.t

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4 use lib 't/lib';
   5
   6 use Test::More qw( no_plan );
   7
   8 use File::Spec;
   9 use TAP::Parser;
  10 use TAP::Parser::Multiplexer;
  11 use TAP::Parser::Iterator::Process;
  12
  13 my $fork_desc
  14   = TAP::Parser::Iterator::Process->_use_open3
  15   ? 'fork'
  16   : 'nofork';
  17
  18 my @schedule = (
  19     {   name => 'Single non-selectable source',
  20
  21         # Returns a list of parser, stash pairs. The stash contains the
  22         # TAP that we expect from this parser.
  23         sources => sub {
  24             my @tap = (
  25                 '1..1',
  26                 'ok 1 Just fine'
  27             );
  28
  29             return [
  30                 TAP::Parser->new( { tap => join( "\n", @tap ) . "\n" } ),
  31                 \@tap,
  32             ];
  33         },
  34     },
  35     {   name    => 'Two non-selectable sources',
  36         sources => sub {
  37             my @tap = (
  38                 [   '1..1',
  39                     'ok 1 Just fine'
  40                 ],
  41                 [   '1..2',
  42                     'not ok 1 Oh dear',
  43                     'ok 2 Better'
  44                 ]
  45             );
  46
  47             return map {
  48                 [   TAP::Parser->new( { tap => join( "\n", @$_ ) . "\n" } ),
  49                     $_
  50                 ]
  51             } @tap;
  52         },
  53     },
  54     {   name    => 'Single selectable source',
  55         sources => sub {
  56             return [
  57                 TAP::Parser->new(
  58                     {   source => File::Spec->catfile(
  59                             (   $ENV{PERL_CORE}
  60                                 ? ( File::Spec->updir(), 'ext', 'Test-Harness'
  61                                   )
  62                                 : ()
  63                             ),
  64                             't',
  65                             'sample-tests',
  66                             'simple'
  67                         ),
  68                     }
  69                 ),
  70                 [   '1..5',
  71                     'ok 1',
  72                     'ok 2',
  73                     'ok 3',
  74                     'ok 4',
  75                     'ok 5',
  76                 ]
  77             ];
  78         },
  79     },
  80     {   name    => 'Three selectable sources',
  81         sources => sub {
  82             return map {
  83                 [   TAP::Parser->new(
  84                         {   source => File::Spec->catfile(
  85                                 (   $ENV{PERL_CORE}
  86                                     ? ( File::Spec->updir(), 'ext',
  87                                         'Test-Harness'
  88                                       )
  89                                     : ()
  90                                 ),
  91                                 't',
  92                                 'sample-tests',
  93                                 'simple'
  94                             ),
  95                         }
  96                     ),
  97                     [   '1..5',
  98                         'ok 1',
  99                         'ok 2',
 100                         'ok 3',
 101                         'ok 4',
 102                         'ok 5',
 103                     ]
 104                 ]
 105             } 1 .. 3;
 106         },
 107     },
 108     {   name    => 'Three selectable sources, two non-selectable sources',
 109         sources => sub {
 110             my @tap = (
 111                 [   '1..1',
 112                     'ok 1 Just fine'
 113                 ],
 114                 [   '1..2',
 115                     'not ok 1 Oh dear',
 116                     'ok 2 Better'
 117                 ]
 118             );
 119
 120             return (
 121                 map {
 122                     [   TAP::Parser->new(
 123                             { tap => join( "\n", @$_ ) . "\n" }
 124                         ),
 125                         $_
 126                     ]
 127                   } @tap
 128               ),
 129               ( map {
 130                     [   TAP::Parser->new(
 131                             {   source => File::Spec->catfile(
 132                                     (   $ENV{PERL_CORE}
 133                                         ? ( File::Spec->updir(), 'ext',
 134                                             'Test-Harness'
 135                                           )
 136                                         : ()
 137                                     ),
 138                                     't',
 139                                     'sample-tests',
 140                                     'simple'
 141                                 ),
 142                             }
 143                         ),
 144                         [   '1..5',
 145                             'ok 1',
 146                             'ok 2',
 147                             'ok 3',
 148                             'ok 4',
 149                             'ok 5',
 150                         ]
 151                     ]
 152                   } 1 .. 3
 153               );
 154         },
 155     }
 156 );
 157
 158 for my $test (@schedule) {
 159     my $name    = "$test->{name} ($fork_desc)";
 160     my @sources = $test->{sources}->();
 161     my $mux     = TAP::Parser::Multiplexer->new;
 162
 163     my $count = @sources;
 164     $mux->add(@$_) for @sources;
 165
 166     is $mux->parsers, $count, "$name: count OK";
 167
 168     while ( my ( $parser, $stash, $result ) = $mux->next ) {
 169
 170         # use Data::Dumper;
 171         # diag Dumper( { stash => $stash, result => $result } );
 172         if ( defined $result ) {
 173             my $expect = ( shift @$stash ) || ' OOPS ';
 174             my $got = $result->raw;
 175             is $got, $expect, "$name: '$expect' OK";
 176         }
 177         else {
 178             ok @$stash == 0, "$name: EOF OK";
 179
 180             # Make sure we only get one EOF per stream
 181             push @$stash, ' expect no more ';
 182         }
 183     }
 184     is $mux->parsers, 0, "$name: All used up";
 185 }
 186
 187 1;