iterators.t revision 1.1.1.3
1#!/usr/bin/perl -w 2 3use strict; 4use warnings; 5use lib 't/lib'; 6 7use Test::More tests => 76; 8 9use File::Spec; 10use TAP::Parser; 11use TAP::Parser::Iterator::Array; 12use Config; 13 14sub array_ref_from { 15 my $string = shift; 16 my @lines = split /\n/ => $string; 17 return \@lines; 18} 19 20# we slurp __DATA__ and then reset it so we don't have to duplicate our TAP 21my $offset = tell DATA; 22my $tap = do { local $/; <DATA> }; 23seek DATA, $offset, 0; 24 25my $did_setup = 0; 26my $did_teardown = 0; 27 28my $setup = sub { $did_setup++ }; 29my $teardown = sub { $did_teardown++ }; 30 31package NoForkProcess; 32use base 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 85for 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 $iterator 94 = $class 95 ? $class->new($source) 96 : make_iterator($source); 97 98 ok $iterator, "$name: We should be able to create a new iterator"; 99 isa_ok $iterator, 'TAP::Parser::Iterator', 100 '... and the object it returns'; 101 isa_ok $iterator, $subclass, '... and the object it returns'; 102 103 can_ok $iterator, 'exit'; 104 ok !defined $iterator->exit, 105 "$name: ... and it should be undef before we are done ($subclass)"; 106 107 can_ok $iterator, 'next'; 108 is $iterator->next, 'one', 109 "$name: next() should return the first result"; 110 111 is $iterator->next, 'two', 112 "$name: next() should return the second result"; 113 114 is $iterator->next, '', 115 "$name: next() should return the third result"; 116 117 is $iterator->next, 'three', 118 "$name: next() should return the fourth result"; 119 120 ok !defined $iterator->next, 121 "$name: next() should return undef after it is empty"; 122 123 is $iterator->exit, 0, 124 "$name: ... and exit should now return 0 ($subclass)"; 125 126 is $iterator->wait, 0, 127 "$name: wait should also now return 0 ($subclass)"; 128 129 if ( my $after = $test->{after} ) { 130 $after->(); 131 } 132 } 133} 134 135{ 136 137 # coverage tests for the ctor 138 139 my $iterator = make_iterator( IO::Handle->new ); 140 141 isa_ok $iterator, 'TAP::Parser::Iterator::Stream'; 142 143 my @die; 144 145 eval { 146 local $SIG{__DIE__} = sub { push @die, @_ }; 147 make_iterator( \1 ); # a ref to a scalar 148 }; 149 150 is @die, 1, 'coverage of error case'; 151 152 like pop @die, qr/Can't iterate with a SCALAR/, 153 '...and we died as expected'; 154} 155 156{ 157 158 # coverage test for VMS case 159 160 my $iterator = make_iterator( 161 [ 'not ', 162 'ok 1 - I hate VMS', 163 ] 164 ); 165 166 is $iterator->next, 'not ok 1 - I hate VMS', 167 'coverage of VMS line-splitting case'; 168 169 # coverage test for VMS case - nothing after 'not' 170 171 $iterator = make_iterator( 172 [ 'not ', 173 ] 174 ); 175 176 is $iterator->next, 'not ', '...and we find "not" by itself'; 177} 178 179SKIP: { 180 skip "No open3", 4 unless _can_open3(); 181 182 # coverage testing for TAP::Parser::Iterator::Process ctor 183 184 my @die; 185 186 eval { 187 local $SIG{__DIE__} = sub { push @die, @_ }; 188 make_iterator( {} ); 189 }; 190 191 is @die, 1, 'coverage testing for TPI::Process'; 192 193 like pop @die, qr/Must supply a command to execute/, 194 '...and we died as expected'; 195 196 my $parser = make_iterator( 197 { command => [ 198 $^X, 199 File::Spec->catfile( 't', 'sample-tests', 'out_err_mix' ) 200 ], 201 merge => 1, 202 } 203 ); 204 205 is $parser->{err}, '', 'confirm we set err to empty string'; 206 is $parser->{sel}, undef, '...and selector to undef'; 207 208 # And then we read from the parser to sidestep the Mac OS / open3 209 # bug which frequently throws an error here otherwise. 210 $parser->next; 211} 212 213sub make_iterator { 214 my $thing = shift; 215 my $ref = ref $thing; 216 if ( $ref eq 'GLOB' || UNIVERSAL::isa( $ref, 'IO::Handle' ) ) { 217 return TAP::Parser::Iterator::Stream->new($thing); 218 } 219 elsif ( $ref eq 'ARRAY' ) { 220 return TAP::Parser::Iterator::Array->new($thing); 221 } 222 elsif ( $ref eq 'HASH' ) { 223 return TAP::Parser::Iterator::Process->new($thing); 224 } 225 else { 226 die "Can't iterate with a $ref"; 227 } 228} 229 230__DATA__ 231one 232two 233 234three 235