1#!/usr/bin/perl -wT
2
3use strict;
4use warnings;
5use lib 't/lib';
6
7use Test::More tests => 81;
8
9use TAP::Parser;
10use TAP::Parser::Iterator::Array;
11use TAP::Parser::Aggregator;
12
13my $tap = <<'END_TAP';
141..5
15ok 1 - input file opened
16... this is junk
17not ok first line of the input valid # todo some data
18# this is a comment
19ok 3 - read the rest of the file
20not ok 4 - this is a real failure
21ok 5 # skip we have no description
22END_TAP
23
24my $iterator = TAP::Parser::Iterator::Array->new( [ split /\n/ => $tap ] );
25isa_ok $iterator, 'TAP::Parser::Iterator';
26
27my $parser1 = TAP::Parser->new( { iterator => $iterator } );
28isa_ok $parser1, 'TAP::Parser';
29
30$parser1->run;
31
32$tap = <<'END_TAP';
331..7
34ok 1 - gentlemen, start your engines
35not ok first line of the input valid # todo some data
36# this is a comment
37ok 3 - read the rest of the file
38not ok 4 - this is a real failure
39ok 5 
40ok 6 - you shall not pass! # TODO should have failed
41not ok 7 - Gandalf wins.  Game over.  # TODO 'bout time!
42END_TAP
43
44my $parser2 = TAP::Parser->new( { tap => $tap } );
45isa_ok $parser2, 'TAP::Parser';
46$parser2->run;
47
48can_ok 'TAP::Parser::Aggregator', 'new';
49my $agg = TAP::Parser::Aggregator->new;
50isa_ok $agg, 'TAP::Parser::Aggregator';
51
52can_ok $agg, 'add';
53ok $agg->add( 'tap1', $parser1 ), '... and calling it should succeed';
54ok $agg->add( 'tap2', $parser2 ), '... even if we add more than one parser';
55eval { $agg->add( 'tap1', $parser1 ) };
56like $@, qr/^You already have a parser for \Q(tap1)/,
57  '... but trying to reuse a description should be fatal';
58
59can_ok $agg, 'parsers';
60is scalar $agg->parsers, 2,
61  '... and it should report how many parsers it has';
62is_deeply [ $agg->parsers ], [ $parser1, $parser2 ],
63  '... or which parsers it has';
64is_deeply $agg->parsers('tap2'), $parser2, '... or reporting a single parser';
65is_deeply [ $agg->parsers(qw(tap2 tap1)) ], [ $parser2, $parser1 ],
66  '... or a group';
67
68# test aggregate results
69
70can_ok $agg, 'passed';
71is $agg->passed, 10,
72  '... and we should have the correct number of passed tests';
73is_deeply [ $agg->passed ], [qw(tap1 tap2)],
74  '... and be able to get their descriptions';
75
76can_ok $agg, 'failed';
77is $agg->failed, 2,
78  '... and we should have the correct number of failed tests';
79is_deeply [ $agg->failed ], [qw(tap1 tap2)],
80  '... and be able to get their descriptions';
81
82can_ok $agg, 'todo';
83is $agg->todo, 4, '... and we should have the correct number of todo tests';
84is_deeply [ $agg->todo ], [qw(tap1 tap2)],
85  '... and be able to get their descriptions';
86
87can_ok $agg, 'skipped';
88is $agg->skipped, 1,
89  '... and we should have the correct number of skipped tests';
90is_deeply [ $agg->skipped ], [qw(tap1)],
91  '... and be able to get their descriptions';
92
93can_ok $agg, 'parse_errors';
94is $agg->parse_errors, 0, '... and the correct number of parse errors';
95is_deeply [ $agg->parse_errors ], [],
96  '... and be able to get their descriptions';
97
98can_ok $agg, 'todo_passed';
99is $agg->todo_passed, 1,
100  '... and the correct number of unexpectedly succeeded tests';
101is_deeply [ $agg->todo_passed ], [qw(tap2)],
102  '... and be able to get their descriptions';
103
104can_ok $agg, 'total';
105is $agg->total, $agg->passed + $agg->failed,
106  '... and we should have the correct number of total tests';
107
108can_ok $agg, 'planned';
109is $agg->planned, $agg->passed + $agg->failed,
110  '... and we should have the correct number of planned tests';
111
112can_ok $agg, 'has_problems';
113ok $agg->has_problems, '... and it should report true if there are problems';
114
115can_ok $agg, 'has_errors';
116ok $agg->has_errors, '... and it should report true if there are errors';
117
118can_ok $agg, 'get_status';
119is $agg->get_status, 'FAIL', '... and it should tell us the tests failed';
120
121can_ok $agg, 'all_passed';
122ok !$agg->all_passed, '... and it should tell us not all tests passed';
123
124# coverage testing
125
126# _get_parsers
127# bad descriptions
128# currently the $agg object has descriptions tap1 and tap2
129# call _get_parsers with another description.
130# $agg will call  its _croak method
131my @die;
132
133eval {
134    local $SIG{__DIE__} = sub { push @die, @_ };
135
136    $agg->_get_parsers('no_such_parser_for');
137};
138
139is @die, 1,
140  'coverage tests for missing parsers... and we caught just one death message';
141like pop(@die),
142  qr/^A parser for \(no_such_parser_for\) could not be found at /,
143  '... and it was the expected death message';
144
145# _get_parsers in scalar context
146
147my $gp = $agg->_get_parsers(qw(tap1 tap2))
148  ;    # should return ref to array containing parsers for tap1 and tap2
149
150is @$gp, 2,
151  'coverage tests for _get_parser in scalar context... and we got the right number of parsers';
152isa_ok( $_, 'TAP::Parser' ) for (@$gp);
153
154# _get_parsers
155# todo_failed - this is a deprecated method, so it  (and these tests)
156# can be removed eventually.  However, it is showing up in the coverage
157# as never tested.
158my @warn;
159
160eval {
161    local $SIG{__WARN__} = sub { push @warn, @_ };
162
163    $agg->todo_failed();
164};
165
166# check the warning, making sure to capture the fullstops correctly (not
167# as "any char" matches)
168is @warn, 1,
169  'coverage tests for deprecated todo_failed... and just one warning caught';
170like pop(@warn),
171  qr/^"todo_failed" is deprecated[.]  Please use "todo_passed"[.]  See the docs[.] at/,
172  '... and it was the expected warning';
173
174# has_problems
175# this has a large number of conditions 'OR'd together, so the tests get
176# a little complicated here
177
178# currently, we have covered the cases of failed() being true and none
179# of the summary methods failing
180
181# we need to set up test cases for
182# 1. !failed && todo_passed
183# 2. !failed && !todo_passed && parse_errors
184# 3. !failed && !todo_passed && !parse_errors && exit
185# 4. !failed && !todo_passed && !parse_errors && !exit && wait
186
187# note there is nothing wrong per se with the has_problems logic, these
188# are simply coverage tests
189
190# 1. !failed && todo_passed
191
192$agg = TAP::Parser::Aggregator->new();
193isa_ok $agg, 'TAP::Parser::Aggregator';
194
195$tap = <<'END_TAP';
1961..1
197ok 1 - you shall not pass! # TODO should have failed
198END_TAP
199
200my $parser3 = TAP::Parser->new( { tap => $tap } );
201isa_ok $parser3, 'TAP::Parser';
202$parser3->run;
203
204$agg->add( 'tap3', $parser3 );
205
206is $agg->passed, 1,
207  'coverage tests for !failed && todo_passed... and we should have the correct number of passed tests';
208is $agg->failed, 0,
209  '... and we should have the correct number of failed tests';
210is $agg->todo_passed, 1,
211  '... and the correct number of unexpectedly succeeded tests';
212ok $agg->has_problems,
213  '... and it should report true that there are problems';
214is $agg->get_status, 'PASS', '... and the status should be passing';
215ok !$agg->has_errors, '.... but it should not report any errors';
216ok $agg->all_passed, '... bonus tests should be passing tests, too';
217
218# 2. !failed && !todo_passed && parse_errors
219
220$agg = TAP::Parser::Aggregator->new();
221
222$tap = <<'END_TAP';
2231..-1
224END_TAP
225
226my $parser4 = TAP::Parser->new( { tap => $tap } );
227isa_ok $parser4, 'TAP::Parser';
228$parser4->run;
229
230$agg->add( 'tap4', $parser4 );
231
232is $agg->passed, 0,
233  'coverage tests for !failed && !todo_passed && parse_errors... and we should have the correct number of passed tests';
234is $agg->failed, 0,
235  '... and we should have the correct number of failed tests';
236is $agg->todo_passed, 0,
237  '... and the correct number of unexpectedly succeeded tests';
238is $agg->parse_errors, 1, '... and the correct number of parse errors';
239ok $agg->has_problems,
240  '... and it should report true that there are problems';
241
242# 3. !failed && !todo_passed && !parse_errors && exit
243# now this is a little harder to emulate cleanly through creating tap
244# fragments and parsing, as exit and wait collect OS-status codes.
245# so we'll get a little funky with $agg and push exit and wait descriptions
246# in it - not very friendly to internal rep changes.
247
248$agg = TAP::Parser::Aggregator->new();
249
250$tap = <<'END_TAP';
2511..1
252ok 1 - you shall not pass!
253END_TAP
254
255my $parser5 = TAP::Parser->new( { tap => $tap } );
256$parser5->run;
257
258$agg->add( 'tap', $parser5 );
259
260push @{ $agg->{descriptions_for_exit} }, 'one possible reason';
261$agg->{exit}++;
262
263is $agg->passed, 1,
264  'coverage tests for !failed && !todo_passed && !parse_errors... and we should have the correct number of passed tests';
265is $agg->failed, 0,
266  '... and we should have the correct number of failed tests';
267is $agg->todo_passed, 0,
268  '... and the correct number of unexpectedly succeeded tests';
269is $agg->parse_errors, 0, '... and the correct number of parse errors';
270
271my @exits = $agg->exit;
272
273is @exits, 1, '... and the correct number of exits';
274is pop(@exits), 'one possible reason',
275  '... and we collected the right exit reason';
276
277ok $agg->has_problems,
278  '... and it should report true that there are problems';
279
280# 4. !failed && !todo_passed && !parse_errors && !exit && wait
281
282$agg = TAP::Parser::Aggregator->new();
283
284$agg->add( 'tap', $parser5 );
285
286push @{ $agg->{descriptions_for_wait} }, 'another possible reason';
287$agg->{wait}++;
288
289is $agg->passed, 1,
290  'coverage tests for !failed && !todo_passed && !parse_errors && !exit... and we should have the correct number of passed tests';
291is $agg->failed, 0,
292  '... and we should have the correct number of failed tests';
293is $agg->todo_passed, 0,
294  '... and the correct number of unexpectedly succeeded tests';
295is $agg->parse_errors, 0, '... and the correct number of parse errors';
296is $agg->exit,         0, '... and the correct number of exits';
297
298my @waits = $agg->wait;
299
300is @waits, 1, '... and the correct number of waits';
301is pop(@waits), 'another possible reason',
302  '... and we collected the right wait reason';
303
304ok $agg->has_problems,
305  '... and it should report true that there are problems';
306