Commit | Line | Data |
b965d173 |
1 | #!/usr/bin/perl -w |
2 | |
3 | use strict; |
4 | use lib 't/lib'; |
5 | |
6 | use Test::More qw( no_plan ); |
7 | |
8 | use File::Spec; |
9 | use TAP::Parser; |
10 | use TAP::Parser::Multiplexer; |
11 | use TAP::Parser::Iterator::Process; |
12 | |
13 | my $fork_desc |
14 | = TAP::Parser::Iterator::Process->_use_open3 |
15 | ? 'fork' |
16 | : 'nofork'; |
17 | |
18 | my @schedule = ( |
19 | { name => 'Single non-selectable source', |
20 | |
21 | # Returns a list of parser, stash pairs. The stash contains the |
22 | # TAP that we expect from this parser. |
23 | sources => sub { |
24 | my @tap = ( |
25 | '1..1', |
26 | 'ok 1 Just fine' |
27 | ); |
28 | |
29 | return [ |
30 | TAP::Parser->new( { tap => join( "\n", @tap ) . "\n" } ), |
31 | \@tap, |
32 | ]; |
33 | }, |
34 | }, |
35 | { name => 'Two non-selectable sources', |
36 | sources => sub { |
37 | my @tap = ( |
38 | [ '1..1', |
39 | 'ok 1 Just fine' |
40 | ], |
41 | [ '1..2', |
42 | 'not ok 1 Oh dear', |
43 | 'ok 2 Better' |
44 | ] |
45 | ); |
46 | |
47 | return map { |
48 | [ TAP::Parser->new( { tap => join( "\n", @$_ ) . "\n" } ), |
49 | $_ |
50 | ] |
51 | } @tap; |
52 | }, |
53 | }, |
54 | { name => 'Single selectable source', |
55 | sources => sub { |
56 | return [ |
57 | TAP::Parser->new( |
58 | { source => File::Spec->catfile( |
27fc0087 |
59 | ( $ENV{PERL_CORE} |
60 | ? ( File::Spec->updir(), 'ext', 'Test', |
61 | 'Harness' |
62 | ) |
63 | : () |
64 | ), |
65 | 't', |
66 | 'sample-tests', |
67 | 'simple' |
b965d173 |
68 | ), |
69 | } |
70 | ), |
71 | [ '1..5', |
72 | 'ok 1', |
73 | 'ok 2', |
74 | 'ok 3', |
75 | 'ok 4', |
76 | 'ok 5', |
77 | ] |
78 | ]; |
79 | }, |
80 | }, |
81 | { name => 'Three selectable sources', |
82 | sources => sub { |
83 | return map { |
84 | [ TAP::Parser->new( |
85 | { source => File::Spec->catfile( |
27fc0087 |
86 | ( $ENV{PERL_CORE} |
87 | ? ( File::Spec->updir(), 'ext', 'Test', |
88 | 'Harness' |
89 | ) |
90 | : () |
91 | ), |
92 | 't', |
93 | 'sample-tests', |
94 | 'simple' |
b965d173 |
95 | ), |
96 | } |
97 | ), |
98 | [ '1..5', |
99 | 'ok 1', |
100 | 'ok 2', |
101 | 'ok 3', |
102 | 'ok 4', |
103 | 'ok 5', |
104 | ] |
105 | ] |
106 | } 1 .. 3; |
107 | }, |
108 | }, |
109 | { name => 'Three selectable sources, two non-selectable sources', |
110 | sources => sub { |
111 | my @tap = ( |
112 | [ '1..1', |
113 | 'ok 1 Just fine' |
114 | ], |
115 | [ '1..2', |
116 | 'not ok 1 Oh dear', |
117 | 'ok 2 Better' |
118 | ] |
119 | ); |
120 | |
121 | return ( |
122 | map { |
123 | [ TAP::Parser->new( |
124 | { tap => join( "\n", @$_ ) . "\n" } |
125 | ), |
126 | $_ |
127 | ] |
128 | } @tap |
129 | ), |
130 | ( map { |
131 | [ TAP::Parser->new( |
132 | { source => File::Spec->catfile( |
27fc0087 |
133 | ( $ENV{PERL_CORE} |
134 | ? ( File::Spec->updir(), 'ext', |
135 | 'Test', 'Harness' |
136 | ) |
137 | : () |
138 | ), |
139 | 't', |
140 | 'sample-tests', |
141 | 'simple' |
b965d173 |
142 | ), |
143 | } |
144 | ), |
145 | [ '1..5', |
146 | 'ok 1', |
147 | 'ok 2', |
148 | 'ok 3', |
149 | 'ok 4', |
150 | 'ok 5', |
151 | ] |
152 | ] |
153 | } 1 .. 3 |
154 | ); |
155 | }, |
156 | } |
157 | ); |
158 | |
159 | for my $test (@schedule) { |
160 | my $name = "$test->{name} ($fork_desc)"; |
161 | my @sources = $test->{sources}->(); |
162 | my $mux = TAP::Parser::Multiplexer->new; |
163 | |
164 | my $count = @sources; |
165 | $mux->add(@$_) for @sources; |
166 | |
167 | is $mux->parsers, $count, "$name: count OK"; |
168 | |
169 | while ( my ( $parser, $stash, $result ) = $mux->next ) { |
170 | |
171 | # use Data::Dumper; |
172 | # diag Dumper( { stash => $stash, result => $result } ); |
173 | if ( defined $result ) { |
174 | my $expect = ( shift @$stash ) || ' OOPS '; |
175 | my $got = $result->raw; |
176 | is $got, $expect, "$name: '$expect' OK"; |
177 | } |
178 | else { |
179 | ok @$stash == 0, "$name: EOF OK"; |
180 | |
181 | # Make sure we only get one EOF per stream |
182 | push @$stash, ' expect no more '; |
183 | } |
184 | } |
185 | is $mux->parsers, 0, "$name: All used up"; |
186 | } |
187 | |
188 | 1; |