cpan/Test-Harness/t/iterators.t

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4 use lib 't/lib';
   5
   6 use Test::More tests => 76;
   7
   8 use File::Spec;
   9 use TAP::Parser;
  10 use TAP::Parser::IteratorFactory;
  11 use Config;
  12
  13 sub array_ref_from {
  14     my $string = shift;
  15     my @lines = split /\n/ => $string;
  16     return \@lines;
  17 }
  18
  19 # we slurp __DATA__ and then reset it so we don't have to duplicate our TAP
  20 my $offset = tell DATA;
  21 my $tap = do { local $/; <DATA> };
  22 seek DATA, $offset, 0;
  23
  24 my $did_setup    = 0;
  25 my $did_teardown = 0;
  26
  27 my $setup    = sub { $did_setup++ };
  28 my $teardown = sub { $did_teardown++ };
  29
  30 package NoForkProcess;
  31 use vars qw( @ISA );
  32 @ISA = qw( TAP::Parser::Iterator::Process );
  33
  34 sub _use_open3 {return}
  35
  36 package main;
  37
  38 my @schedule = (
  39     {   name     => 'Process',
  40         subclass => 'TAP::Parser::Iterator::Process',
  41         source   => {
  42             command => [
  43                 $^X,
  44                 File::Spec->catfile(
  45                     't',
  46                     'sample-tests',
  47                     'out_err_mix'
  48                 )
  49             ],
  50             merge    => 1,
  51             setup    => $setup,
  52             teardown => $teardown,
  53         },
  54         after => sub {
  55             is $did_setup,    1, "setup called";
  56             is $did_teardown, 1, "teardown called";
  57         },
  58         need_open3 => 15,
  59     },
  60     {   name     => 'Array',
  61         subclass => 'TAP::Parser::Iterator::Array',
  62         source   => array_ref_from($tap),
  63     },
  64     {   name     => 'Stream',
  65         subclass => 'TAP::Parser::Iterator::Stream',
  66         source   => \*DATA,
  67     },
  68     {   name     => 'Process (Perl -e)',
  69         subclass => 'TAP::Parser::Iterator::Process',
  70         source =>
  71           { command => [ $^X, '-e', 'print qq/one\ntwo\n\nthree\n/' ] },
  72     },
  73     {   name     => 'Process (NoFork)',
  74         subclass => 'TAP::Parser::Iterator::Process',
  75         class    => 'NoForkProcess',
  76         source =>
  77           { command => [ $^X, '-e', 'print qq/one\ntwo\n\nthree\n/' ] },
  78     },
  79 );
  80
  81 sub _can_open3 {
  82     return $Config{d_fork};
  83 }
  84
  85 my $factory = TAP::Parser::IteratorFactory->new;
  86 for my $test (@schedule) {
  87     SKIP: {
  88         my $name       = $test->{name};
  89         my $need_open3 = $test->{need_open3};
  90         skip "No open3", $need_open3 if $need_open3 && !_can_open3();
  91         my $subclass = $test->{subclass};
  92         my $source   = $test->{source};
  93         my $class    = $test->{class};
  94         my $iter
  95           = $class
  96           ? $class->new($source)
  97           : $factory->make_iterator($source);
  98         ok $iter,     "$name: We should be able to create a new iterator";
  99         isa_ok $iter, 'TAP::Parser::Iterator',
 100           '... and the object it returns';
 101         isa_ok $iter, $subclass, '... and the object it returns';
 102
 103         can_ok $iter, 'exit';
 104         ok !defined $iter->exit,
 105           "$name: ... and it should be undef before we are done ($subclass)";
 106
 107         can_ok $iter, 'next';
 108         is $iter->next, 'one', "$name: next() should return the first result";
 109
 110         is $iter->next, 'two',
 111           "$name: next() should return the second result";
 112
 113         is $iter->next, '', "$name: next() should return the third result";
 114
 115         is $iter->next, 'three',
 116           "$name: next() should return the fourth result";
 117
 118         ok !defined $iter->next,
 119           "$name: next() should return undef after it is empty";
 120
 121         is $iter->exit, 0,
 122           "$name: ... and exit should now return 0 ($subclass)";
 123
 124         is $iter->wait, 0, "$name: wait should also now return 0 ($subclass)";
 125
 126         if ( my $after = $test->{after} ) {
 127             $after->();
 128         }
 129     }
 130 }
 131
 132 {
 133
 134     # coverage tests for the ctor
 135
 136     my $stream = $factory->make_iterator( IO::Handle->new );
 137
 138     isa_ok $stream, 'TAP::Parser::Iterator::Stream';
 139
 140     my @die;
 141
 142     eval {
 143         local $SIG{__DIE__} = sub { push @die, @_ };
 144
 145         $factory->make_iterator( \1 );    # a ref to a scalar
 146     };
 147
 148     is @die, 1, 'coverage of error case';
 149
 150     like pop @die, qr/Can't iterate with a SCALAR/,
 151       '...and we died as expected';
 152 }
 153
 154 {
 155
 156     # coverage test for VMS case
 157
 158     my $stream = $factory->make_iterator(
 159         [   'not ',
 160             'ok 1 - I hate VMS',
 161         ]
 162     );
 163
 164     is $stream->next, 'not ok 1 - I hate VMS',
 165       'coverage of VMS line-splitting case';
 166
 167     # coverage test for VMS case - nothing after 'not'
 168
 169     $stream = $factory->make_iterator(
 170         [   'not ',
 171         ]
 172     );
 173
 174     is $stream->next, 'not ', '...and we find "not" by itself';
 175 }
 176
 177 SKIP: {
 178     skip "No open3", 4 unless _can_open3();
 179
 180     # coverage testing for TAP::Parser::Iterator::Process ctor
 181
 182     my @die;
 183
 184     eval {
 185         local $SIG{__DIE__} = sub { push @die, @_ };
 186
 187         $factory->make_iterator( {} );
 188     };
 189
 190     is @die, 1, 'coverage testing for TPI::Process';
 191
 192     like pop @die, qr/Must supply a command to execute/,
 193       '...and we died as expected';
 194
 195     my $parser = $factory->make_iterator(
 196         {   command => [
 197                 $^X,
 198                 File::Spec->catfile( 't', 'sample-tests', 'out_err_mix' )
 199             ],
 200             merge => 1,
 201         }
 202     );
 203
 204     is $parser->{err}, '',    'confirm we set err to empty string';
 205     is $parser->{sel}, undef, '...and selector to undef';
 206
 207     # And then we read from the parser to sidestep the Mac OS / open3
 208     # bug which frequently throws an error here otherwise.
 209     $parser->next;
 210 }
 211 __DATA__
 212 one
 213 two
 214
 215 three