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