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