Commit | Line | Data |
b965d173 |
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; |
f7c69158 |
10 | use TAP::Parser::IteratorFactory; |
b965d173 |
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, |
f7c69158 |
44 | File::Spec->catfile( |
27fc0087 |
45 | ( $ENV{PERL_CORE} |
46 | ? ( File::Spec->updir(), 'ext', 'Test', 'Harness' ) |
47 | : () |
48 | ), |
49 | 't', |
50 | 'sample-tests', |
51 | 'out_err_mix' |
f7c69158 |
52 | ) |
b965d173 |
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 | |
f7c69158 |
89 | my $factory = TAP::Parser::IteratorFactory->new; |
b965d173 |
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}; |
f7c69158 |
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"; |
b965d173 |
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 | |
f7c69158 |
140 | my $stream = $factory->make_iterator( IO::Handle->new ); |
b965d173 |
141 | |
142 | isa_ok $stream, 'TAP::Parser::Iterator::Stream'; |
143 | |
144 | my @die; |
145 | |
146 | eval { |
147 | local $SIG{__DIE__} = sub { push @die, @_ }; |
148 | |
f7c69158 |
149 | $factory->make_iterator( \1 ); # a ref to a scalar |
b965d173 |
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 | |
f7c69158 |
162 | my $stream = $factory->make_iterator( |
b965d173 |
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 | |
f7c69158 |
173 | $stream = $factory->make_iterator( |
b965d173 |
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 | |
f7c69158 |
191 | $factory->make_iterator( {} ); |
b965d173 |
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 | |
f7c69158 |
199 | my $parser = $factory->make_iterator( |
b965d173 |
200 | { command => [ |
201 | $^X, |
202 | File::Spec->catfile( 't', 'sample-tests', 'out_err_mix' ) |
203 | ], |
204 | merge => 1, |
205 | } |
206 | ); |
207 | |
f7c69158 |
208 | is $parser->{err}, '', 'confirm we set err to empty string'; |
b965d173 |
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 |