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