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