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',
  61                                     'Harness'
  62                                   )
  63                                 : ()
  64                             ),
  65                             't',
  66                             'sample-tests',
  67                             'simple'
  68                         ),
  69                     }
  70                 ),
  71                 [   '1..5',
  72                     'ok 1',
  73                     'ok 2',
  74                     'ok 3',
  75                     'ok 4',
  76                     'ok 5',
  77                 ]
  78             ];
  79         },
  80     },
  81     {   name    => 'Three selectable sources',
  82         sources => sub {
  83             return map {
  84                 [   TAP::Parser->new(
  85                         {   source => File::Spec->catfile(
  86                                 (   $ENV{PERL_CORE}
  87                                     ? ( File::Spec->updir(), 'ext', 'Test',
  88                                         'Harness'
  89                                       )
  90                                     : ()
  91                                 ),
  92                                 't',
  93                                 'sample-tests',
  94                                 'simple'
  95                             ),
  96                         }
  97                     ),
  98                     [   '1..5',
  99                         'ok 1',
 100                         'ok 2',
 101                         'ok 3',
 102                         'ok 4',
 103                         'ok 5',
 104                     ]
 105                 ]
 106             } 1 .. 3;
 107         },
 108     },
 109     {   name    => 'Three selectable sources, two non-selectable sources',
 110         sources => sub {
 111             my @tap = (
 112                 [   '1..1',
 113                     'ok 1 Just fine'
 114                 ],
 115                 [   '1..2',
 116                     'not ok 1 Oh dear',
 117                     'ok 2 Better'
 118                 ]
 119             );
 120
 121             return (
 122                 map {
 123                     [   TAP::Parser->new(
 124                             { tap => join( "\n", @$_ ) . "\n" }
 125                         ),
 126                         $_
 127                     ]
 128                   } @tap
 129               ),
 130               ( map {
 131                     [   TAP::Parser->new(
 132                             {   source => File::Spec->catfile(
 133                                     (   $ENV{PERL_CORE}
 134                                         ? ( File::Spec->updir(), 'ext',
 135                                             'Test', 'Harness'
 136                                           )
 137                                         : ()
 138                                     ),
 139                                     't',
 140                                     'sample-tests',
 141                                     'simple'
 142                                 ),
 143                             }
 144                         ),
 145                         [   '1..5',
 146                             'ok 1',
 147                             'ok 2',
 148                             'ok 3',
 149                             'ok 4',
 150                             'ok 5',
 151                         ]
 152                     ]
 153                   } 1 .. 3
 154               );
 155         },
 156     }
 157 );
 158
 159 for my $test (@schedule) {
 160     my $name    = "$test->{name} ($fork_desc)";
 161     my @sources = $test->{sources}->();
 162     my $mux     = TAP::Parser::Multiplexer->new;
 163
 164     my $count = @sources;
 165     $mux->add(@$_) for @sources;
 166
 167     is $mux->parsers, $count, "$name: count OK";
 168
 169     while ( my ( $parser, $stash, $result ) = $mux->next ) {
 170
 171         # use Data::Dumper;
 172         # diag Dumper( { stash => $stash, result => $result } );
 173         if ( defined $result ) {
 174             my $expect = ( shift @$stash ) || ' OOPS ';
 175             my $got = $result->raw;
 176             is $got, $expect, "$name: '$expect' OK";
 177         }
 178         else {
 179             ok @$stash == 0, "$name: EOF OK";
 180
 181             # Make sure we only get one EOF per stream
 182             push @$stash, ' expect no more ';
 183         }
 184     }
 185     is $mux->parsers, 0, "$name: All used up";
 186 }
 187
 188 1;