[p5sagit/p5-mst-13.2.git] / cpan / Test-Harness / t / aggregator.t

#!/usr/bin/perl -wT

use strict;
use lib 't/lib';

use Test::More tests => 81;

use TAP::Parser;
use TAP::Parser::IteratorFactory;
use TAP::Parser::Aggregator;

my $tap = <<'END_TAP';
1..5
ok 1 - input file opened
... this is junk
not ok first line of the input valid # todo some data
# this is a comment
ok 3 - read the rest of the file
not ok 4 - this is a real failure
ok 5 # skip we have no description
END_TAP

my $factory = TAP::Parser::IteratorFactory->new;
my $stream = $factory->make_iterator( [ split /\n/ => $tap ] );
isa_ok $stream, 'TAP::Parser::Iterator';

my $parser1 = TAP::Parser->new( { stream => $stream } );
isa_ok $parser1, 'TAP::Parser';

$parser1->run;

$tap = <<'END_TAP';
1..7
ok 1 - gentlemen, start your engines
not ok first line of the input valid # todo some data
# this is a comment
ok 3 - read the rest of the file
not ok 4 - this is a real failure
ok 5 
ok 6 - you shall not pass! # TODO should have failed
not ok 7 - Gandalf wins.  Game over.  # TODO 'bout time!
END_TAP

my $parser2 = TAP::Parser->new( { tap => $tap } );
isa_ok $parser2, 'TAP::Parser';
$parser2->run;

can_ok 'TAP::Parser::Aggregator', 'new';
my $agg = TAP::Parser::Aggregator->new;
isa_ok $agg, 'TAP::Parser::Aggregator';

can_ok $agg, 'add';
ok $agg->add( 'tap1', $parser1 ), '... and calling it should succeed';
ok $agg->add( 'tap2', $parser2 ), '... even if we add more than one parser';
eval { $agg->add( 'tap1', $parser1 ) };
like $@, qr/^You already have a parser for \Q(tap1)/,
  '... but trying to reuse a description should be fatal';

can_ok $agg, 'parsers';
is scalar $agg->parsers, 2,
  '... and it should report how many parsers it has';
is_deeply [ $agg->parsers ], [ $parser1, $parser2 ],
  '... or which parsers it has';
is_deeply $agg->parsers('tap2'), $parser2, '... or reporting a single parser';
is_deeply [ $agg->parsers(qw(tap2 tap1)) ], [ $parser2, $parser1 ],
  '... or a group';

# test aggregate results

can_ok $agg, 'passed';
is $agg->passed, 10,
  '... and we should have the correct number of passed tests';
is_deeply [ $agg->passed ], [qw(tap1 tap2)],
  '... and be able to get their descriptions';

can_ok $agg, 'failed';
is $agg->failed, 2,
  '... and we should have the correct number of failed tests';
is_deeply [ $agg->failed ], [qw(tap1 tap2)],
  '... and be able to get their descriptions';

can_ok $agg, 'todo';
is $agg->todo, 4, '... and we should have the correct number of todo tests';
is_deeply [ $agg->todo ], [qw(tap1 tap2)],
  '... and be able to get their descriptions';

can_ok $agg, 'skipped';
is $agg->skipped, 1,
  '... and we should have the correct number of skipped tests';
is_deeply [ $agg->skipped ], [qw(tap1)],
  '... and be able to get their descriptions';

can_ok $agg, 'parse_errors';
is $agg->parse_errors, 0, '... and the correct number of parse errors';
is_deeply [ $agg->parse_errors ], [],
  '... and be able to get their descriptions';

can_ok $agg, 'todo_passed';
is $agg->todo_passed, 1,
  '... and the correct number of unexpectedly succeeded tests';
is_deeply [ $agg->todo_passed ], [qw(tap2)],
  '... and be able to get their descriptions';

can_ok $agg, 'total';
is $agg->total, $agg->passed + $agg->failed,
  '... and we should have the correct number of total tests';

can_ok $agg, 'planned';
is $agg->planned, $agg->passed + $agg->failed,
  '... and we should have the correct number of planned tests';

can_ok $agg, 'has_problems';
ok $agg->has_problems, '... and it should report true if there are problems';

can_ok $agg, 'has_errors';
ok $agg->has_errors, '... and it should report true if there are errors';

can_ok $agg, 'get_status';
is $agg->get_status, 'FAIL', '... and it should tell us the tests failed';

can_ok $agg, 'all_passed';
ok !$agg->all_passed, '... and it should tell us not all tests passed';

# coverage testing

# _get_parsers
# bad descriptions
# currently the $agg object has descriptions tap1 and tap2
# call _get_parsers with another description.
# $agg will call  its _croak method
my @die;

eval {
    local $SIG{__DIE__} = sub { push @die, @_ };

    $agg->_get_parsers('no_such_parser_for');
};

is @die, 1,
  'coverage tests for missing parsers... and we caught just one death message';
like pop(@die),
  qr/^A parser for \(no_such_parser_for\) could not be found at /,
  '... and it was the expected death message';

# _get_parsers in scalar context

my $gp = $agg->_get_parsers(qw(tap1 tap2))
  ;    # should return ref to array containing parsers for tap1 and tap2

is @$gp, 2,
  'coverage tests for _get_parser in scalar context... and we got the right number of parsers';
isa_ok( $_, 'TAP::Parser' ) foreach (@$gp);

# _get_parsers
# todo_failed - this is a deprecated method, so it  (and these tests)
# can be removed eventually.  However, it is showing up in the coverage
# as never tested.
my @warn;

eval {
    local $SIG{__WARN__} = sub { push @warn, @_ };

    $agg->todo_failed();
};

# check the warning, making sure to capture the fullstops correctly (not
# as "any char" matches)
is @warn, 1,
  'coverage tests for deprecated todo_failed... and just one warning caught';
like pop(@warn),
  qr/^"todo_failed" is deprecated[.]  Please use "todo_passed"[.]  See the docs[.] at/,
  '... and it was the expected warning';

# has_problems
# this has a large number of conditions 'OR'd together, so the tests get
# a little complicated here

# currently, we have covered the cases of failed() being true and none
# of the summary methods failing

# we need to set up test cases for
# 1. !failed && todo_passed
# 2. !failed && !todo_passed && parse_errors
# 3. !failed && !todo_passed && !parse_errors && exit
# 4. !failed && !todo_passed && !parse_errors && !exit && wait

# note there is nothing wrong per se with the has_problems logic, these
# are simply coverage tests

# 1. !failed && todo_passed

$agg = TAP::Parser::Aggregator->new();
isa_ok $agg, 'TAP::Parser::Aggregator';

$tap = <<'END_TAP';
1..1
ok 1 - you shall not pass! # TODO should have failed
END_TAP

my $parser3 = TAP::Parser->new( { tap => $tap } );
isa_ok $parser3, 'TAP::Parser';
$parser3->run;

$agg->add( 'tap3', $parser3 );

is $agg->passed, 1,
  'coverage tests for !failed && todo_passed... and we should have the correct number of passed tests';
is $agg->failed, 0,
  '... and we should have the correct number of failed tests';
is $agg->todo_passed, 1,
  '... and the correct number of unexpectedly succeeded tests';
ok $agg->has_problems,
  '... and it should report true that there are problems';
is $agg->get_status, 'PASS', '... and the status should be passing';
ok !$agg->has_errors, '.... but it should not report any errors';
ok $agg->all_passed, '... bonus tests should be passing tests, too';

# 2. !failed && !todo_passed && parse_errors

$agg = TAP::Parser::Aggregator->new();

$tap = <<'END_TAP';
1..-1
END_TAP

my $parser4 = TAP::Parser->new( { tap => $tap } );
isa_ok $parser4, 'TAP::Parser';
$parser4->run;

$agg->add( 'tap4', $parser4 );

is $agg->passed, 0,
  'coverage tests for !failed && !todo_passed && parse_errors... and we should have the correct number of passed tests';
is $agg->failed, 0,
  '... and we should have the correct number of failed tests';
is $agg->todo_passed, 0,
  '... and the correct number of unexpectedly succeeded tests';
is $agg->parse_errors, 1, '... and the correct number of parse errors';
ok $agg->has_problems,
  '... and it should report true that there are problems';

# 3. !failed && !todo_passed && !parse_errors && exit
# now this is a little harder to emulate cleanly through creating tap
# fragments and parsing, as exit and wait collect OS-status codes.
# so we'll get a little funky with $agg and push exit and wait descriptions
# in it - not very friendly to internal rep changes.

$agg = TAP::Parser::Aggregator->new();

$tap = <<'END_TAP';
1..1
ok 1 - you shall not pass!
END_TAP

my $parser5 = TAP::Parser->new( { tap => $tap } );
$parser5->run;

$agg->add( 'tap', $parser5 );

push @{ $agg->{descriptions_for_exit} }, 'one possible reason';
$agg->{exit}++;

is $agg->passed, 1,
  'coverage tests for !failed && !todo_passed && !parse_errors... and we should have the correct number of passed tests';
is $agg->failed, 0,
  '... and we should have the correct number of failed tests';
is $agg->todo_passed, 0,
  '... and the correct number of unexpectedly succeeded tests';
is $agg->parse_errors, 0, '... and the correct number of parse errors';

my @exits = $agg->exit;

is @exits, 1, '... and the correct number of exits';
is pop(@exits), 'one possible reason',
  '... and we collected the right exit reason';

ok $agg->has_problems,
  '... and it should report true that there are problems';

# 4. !failed && !todo_passed && !parse_errors && !exit && wait

$agg = TAP::Parser::Aggregator->new();

$agg->add( 'tap', $parser5 );

push @{ $agg->{descriptions_for_wait} }, 'another possible reason';
$agg->{wait}++;

is $agg->passed, 1,
  'coverage tests for !failed && !todo_passed && !parse_errors && !exit... and we should have the correct number of passed tests';
is $agg->failed, 0,
  '... and we should have the correct number of failed tests';
is $agg->todo_passed, 0,
  '... and the correct number of unexpectedly succeeded tests';
is $agg->parse_errors, 0, '... and the correct number of parse errors';
is $agg->exit,         0, '... and the correct number of exits';

my @waits = $agg->wait;

is @waits, 1, '... and the correct number of waits';
is pop(@waits), 'another possible reason',
  '... and we collected the right wait reason';

ok $agg->has_problems,
  '... and it should report true that there are problems';
Commit	Line	Data
b965d173	1	#!/usr/bin/perl -wT
b965d173	2
b965d173	3	use strict;
	4	use lib 't/lib';
	5
bdaf8c65	6	use Test::More tests => 81;
b965d173	7
b965d173	8	use TAP::Parser;
f7c69158	9	use TAP::Parser::IteratorFactory;
b965d173	10	use TAP::Parser::Aggregator;
	11
	12	my $tap = <<'END_TAP';
	13	1..5
	14	ok 1 - input file opened
	15	... this is junk
	16	not ok first line of the input valid # todo some data
	17	# this is a comment
	18	ok 3 - read the rest of the file
	19	not ok 4 - this is a real failure
	20	ok 5 # skip we have no description
	21	END_TAP
	22
f7c69158	23	my $factory = TAP::Parser::IteratorFactory->new;
f7c69158	24	my $stream = $factory->make_iterator( [ split /\n/ => $tap ] );
b965d173	25	isa_ok $stream, 'TAP::Parser::Iterator';
	26
	27	my $parser1 = TAP::Parser->new( { stream => $stream } );
	28	isa_ok $parser1, 'TAP::Parser';
	29
	30	$parser1->run;
	31
	32	$tap = <<'END_TAP';
	33	1..7
	34	ok 1 - gentlemen, start your engines
	35	not ok first line of the input valid # todo some data
	36	# this is a comment
	37	ok 3 - read the rest of the file
	38	not ok 4 - this is a real failure
	39	ok 5
	40	ok 6 - you shall not pass! # TODO should have failed
	41	not ok 7 - Gandalf wins. Game over. # TODO 'bout time!
	42	END_TAP
	43
	44	my $parser2 = TAP::Parser->new( { tap => $tap } );
	45	isa_ok $parser2, 'TAP::Parser';
	46	$parser2->run;
	47
	48	can_ok 'TAP::Parser::Aggregator', 'new';
	49	my $agg = TAP::Parser::Aggregator->new;
	50	isa_ok $agg, 'TAP::Parser::Aggregator';
	51
	52	can_ok $agg, 'add';
	53	ok $agg->add( 'tap1', $parser1 ), '... and calling it should succeed';
	54	ok $agg->add( 'tap2', $parser2 ), '... even if we add more than one parser';
	55	eval { $agg->add( 'tap1', $parser1 ) };
	56	like $@, qr/^You already have a parser for \Q(tap1)/,
	57	'... but trying to reuse a description should be fatal';
	58
	59	can_ok $agg, 'parsers';
	60	is scalar $agg->parsers, 2,
	61	'... and it should report how many parsers it has';
	62	is_deeply [ $agg->parsers ], [ $parser1, $parser2 ],
	63	'... or which parsers it has';
	64	is_deeply $agg->parsers('tap2'), $parser2, '... or reporting a single parser';
	65	is_deeply [ $agg->parsers(qw(tap2 tap1)) ], [ $parser2, $parser1 ],
	66	'... or a group';
	67
	68	# test aggregate results
	69
	70	can_ok $agg, 'passed';
	71	is $agg->passed, 10,
	72	'... and we should have the correct number of passed tests';
	73	is_deeply [ $agg->passed ], [qw(tap1 tap2)],
	74	'... and be able to get their descriptions';
	75
	76	can_ok $agg, 'failed';
	77	is $agg->failed, 2,
	78	'... and we should have the correct number of failed tests';
	79	is_deeply [ $agg->failed ], [qw(tap1 tap2)],
	80	'... and be able to get their descriptions';
	81
	82	can_ok $agg, 'todo';
	83	is $agg->todo, 4, '... and we should have the correct number of todo tests';
	84	is_deeply [ $agg->todo ], [qw(tap1 tap2)],
	85	'... and be able to get their descriptions';
	86
	87	can_ok $agg, 'skipped';
	88	is $agg->skipped, 1,
89	'... and we should have the correct number of skipped tests';
90	is_deeply [ $agg->skipped ], [qw(tap1)],
91	'... and be able to get their descriptions';
92
93	can_ok $agg, 'parse_errors';
94	is $agg->parse_errors, 0, '... and the correct number of parse errors';
95	is_deeply [ $agg->parse_errors ], [],
96	'... and be able to get their descriptions';
97
98	can_ok $agg, 'todo_passed';
99	is $agg->todo_passed, 1,
100	'... and the correct number of unexpectedly succeeded tests';
101	is_deeply [ $agg->todo_passed ], [qw(tap2)],
102	'... and be able to get their descriptions';
103
104	can_ok $agg, 'total';
105	is $agg->total, $agg->passed + $agg->failed,
106	'... and we should have the correct number of total tests';
107
bdaf8c65	108	can_ok $agg, 'planned';
	109	is $agg->planned, $agg->passed + $agg->failed,
	110	'... and we should have the correct number of planned tests';
	111
b965d173	112	can_ok $agg, 'has_problems';
	113	ok $agg->has_problems, '... and it should report true if there are problems';
	114
	115	can_ok $agg, 'has_errors';
	116	ok $agg->has_errors, '... and it should report true if there are errors';
	117
	118	can_ok $agg, 'get_status';
	119	is $agg->get_status, 'FAIL', '... and it should tell us the tests failed';
	120
	121	can_ok $agg, 'all_passed';
	122	ok !$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
	131	my @die;
	132
	133	eval {
	134	local $SIG{__DIE__} = sub { push @die, @_ };
	135
	136	$agg->_get_parsers('no_such_parser_for');
	137	};
	138
	139	is @die, 1,
	140	'coverage tests for missing parsers... and we caught just one death message';
	141	like 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
	147	my $gp = $agg->_get_parsers(qw(tap1 tap2))
	148	; # should return ref to array containing parsers for tap1 and tap2
	149
	150	is @$gp, 2,
	151	'coverage tests for _get_parser in scalar context... and we got the right number of parsers';
	152	isa_ok( $_, 'TAP::Parser' ) foreach (@$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.
	158	my @warn;
	159
	160	eval {
	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)
	168	is @warn, 1,
	169	'coverage tests for deprecated todo_failed... and just one warning caught';
	170	like 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();
193	isa_ok $agg, 'TAP::Parser::Aggregator';
194
195	$tap = <<'END_TAP';
196	1..1
197	ok 1 - you shall not pass! # TODO should have failed
198	END_TAP
199
200	my $parser3 = TAP::Parser->new( { tap => $tap } );
201	isa_ok $parser3, 'TAP::Parser';
202	$parser3->run;
203
204	$agg->add( 'tap3', $parser3 );
205
206	is $agg->passed, 1,
207	'coverage tests for !failed && todo_passed... and we should have the correct number of passed tests';
208	is $agg->failed, 0,
209	'... and we should have the correct number of failed tests';
210	is $agg->todo_passed, 1,
211	'... and the correct number of unexpectedly succeeded tests';
212	ok $agg->has_problems,
213	'... and it should report true that there are problems';
f7c69158	214	is $agg->get_status, 'PASS', '... and the status should be passing';
	215	ok !$agg->has_errors, '.... but it should not report any errors';
	216	ok $agg->all_passed, '... bonus tests should be passing tests, too';
b965d173	217
	218	# 2. !failed && !todo_passed && parse_errors
	219
	220	$agg = TAP::Parser::Aggregator->new();
	221
	222	$tap = <<'END_TAP';
	223	1..-1
	224	END_TAP
	225
	226	my $parser4 = TAP::Parser->new( { tap => $tap } );
	227	isa_ok $parser4, 'TAP::Parser';
	228	$parser4->run;
	229
	230	$agg->add( 'tap4', $parser4 );
	231
	232	is $agg->passed, 0,
	233	'coverage tests for !failed && !todo_passed && parse_errors... and we should have the correct number of passed tests';
	234	is $agg->failed, 0,
	235	'... and we should have the correct number of failed tests';
	236	is $agg->todo_passed, 0,
	237	'... and the correct number of unexpectedly succeeded tests';
	238	is $agg->parse_errors, 1, '... and the correct number of parse errors';
	239	ok $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';
	251	1..1
	252	ok 1 - you shall not pass!
	253	END_TAP
	254
	255	my $parser5 = TAP::Parser->new( { tap => $tap } );
	256	$parser5->run;
	257
	258	$agg->add( 'tap', $parser5 );
	259
	260	push @{ $agg->{descriptions_for_exit} }, 'one possible reason';
	261	$agg->{exit}++;
	262
	263	is $agg->passed, 1,
	264	'coverage tests for !failed && !todo_passed && !parse_errors... and we should have the correct number of passed tests';
	265	is $agg->failed, 0,
	266	'... and we should have the correct number of failed tests';
	267	is $agg->todo_passed, 0,
	268	'... and the correct number of unexpectedly succeeded tests';
	269	is $agg->parse_errors, 0, '... and the correct number of parse errors';
	270
	271	my @exits = $agg->exit;
	272
	273	is @exits, 1, '... and the correct number of exits';
	274	is pop(@exits), 'one possible reason',
	275	'... and we collected the right exit reason';
	276
	277	ok $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
286	push @{ $agg->{descriptions_for_wait} }, 'another possible reason';
287	$agg->{wait}++;
288
289	is $agg->passed, 1,
290	'coverage tests for !failed && !todo_passed && !parse_errors && !exit... and we should have the correct number of passed tests';
291	is $agg->failed, 0,
292	'... and we should have the correct number of failed tests';
293	is $agg->todo_passed, 0,
294	'... and the correct number of unexpectedly succeeded tests';
295	is $agg->parse_errors, 0, '... and the correct number of parse errors';
296	is $agg->exit, 0, '... and the correct number of exits';
297
298	my @waits = $agg->wait;
299
300	is @waits, 1, '... and the correct number of waits';
301	is pop(@waits), 'another possible reason',
302	'... and we collected the right wait reason';
303
304	ok $agg->has_problems,
305	'... and it should report true that there are problems';