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