iterators.t revision 1.1.1.1
1#!/usr/bin/perl -w 2 3use strict; 4use lib 't/lib'; 5 6use Test::More tests => 76; 7 8use File::Spec; 9use TAP::Parser; 10use TAP::Parser::IteratorFactory; 11use Config; 12 13sub 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 20my $offset = tell DATA; 21my $tap = do { local $/; <DATA> }; 22seek DATA, $offset, 0; 23 24my $did_setup = 0; 25my $did_teardown = 0; 26 27my $setup = sub { $did_setup++ }; 28my $teardown = sub { $did_teardown++ }; 29 30package NoForkProcess; 31use vars qw( @ISA ); 32@ISA = qw( TAP::Parser::Iterator::Process ); 33 34sub _use_open3 {return} 35 36package main; 37 38my @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 81sub _can_open3 { 82 return $Config{d_fork}; 83} 84 85my $factory = TAP::Parser::IteratorFactory->new; 86for 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 177SKIP: { 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__ 212one 213two 214 215three 216