1#!/usr/bin/perl -w 2 3BEGIN { 4 unshift @INC, 't/lib'; 5} 6 7use strict; 8 9use Test::More; 10 11use TAP::Harness; 12 13my $HARNESS = 'TAP::Harness'; 14 15my $source_tests = 't/source_tests'; 16my $sample_tests = 't/sample-tests'; 17 18plan tests => 56; 19 20# note that this test will always pass when run through 'prove' 21ok $ENV{HARNESS_ACTIVE}, 'HARNESS_ACTIVE env variable should be set'; 22ok $ENV{HARNESS_VERSION}, 'HARNESS_VERSION env variable should be set'; 23 24{ 25 my @output; 26 local $^W; 27 require TAP::Formatter::Base; 28 local *TAP::Formatter::Base::_output = sub { 29 my $self = shift; 30 push @output => grep { $_ ne '' } 31 map { 32 local $_ = $_; 33 chomp; 34 trim($_) 35 } map { split /\n/ } @_; 36 }; 37 38 # Make sure verbosity 1 overrides failures and comments. 39 my $harness = TAP::Harness->new( 40 { verbosity => 1, 41 failures => 1, 42 comments => 1, 43 } 44 ); 45 my $harness_whisper = TAP::Harness->new( { verbosity => -1 } ); 46 my $harness_mute = TAP::Harness->new( { verbosity => -2 } ); 47 my $harness_directives = TAP::Harness->new( { directives => 1 } ); 48 my $harness_failures = TAP::Harness->new( { failures => 1 } ); 49 my $harness_comments = TAP::Harness->new( { comments => 1 } ); 50 my $harness_fandc = TAP::Harness->new( 51 { failures => 1, 52 comments => 1 53 } 54 ); 55 56 can_ok $harness, 'runtests'; 57 58 # normal tests in verbose mode 59 60 ok my $aggregate = _runtests( $harness, "$source_tests/harness" ), 61 '... runtests returns the aggregate'; 62 63 isa_ok $aggregate, 'TAP::Parser::Aggregator'; 64 65 chomp(@output); 66 67 my @expected = ( 68 "$source_tests/harness ..", 69 '1..1', 70 'ok 1 - this is a test', 71 'ok', 72 'All tests successful.', 73 ); 74 my $status = pop @output; 75 my $expected_status = qr{^Result: PASS$}; 76 my $summary = pop @output; 77 my $expected_summary = qr{^Files=1, Tests=1, +\d+ wallclock secs}; 78 79 is_deeply \@output, \@expected, '... the output should be correct'; 80 like $status, $expected_status, 81 '... and the status line should be correct'; 82 like $summary, $expected_summary, 83 '... and the report summary should look correct'; 84 85 # use an alias for test name 86 87 @output = (); 88 ok $aggregate 89 = _runtests( $harness, [ "$source_tests/harness", 'My Nice Test' ] ), 90 'runtests returns the aggregate'; 91 92 isa_ok $aggregate, 'TAP::Parser::Aggregator'; 93 94 chomp(@output); 95 96 @expected = ( 97 'My Nice Test ..', 98 '1..1', 99 'ok 1 - this is a test', 100 'ok', 101 'All tests successful.', 102 ); 103 $status = pop @output; 104 $expected_status = qr{^Result: PASS$}; 105 $summary = pop @output; 106 $expected_summary = qr{^Files=1, Tests=1, +\d+ wallclock secs}; 107 108 is_deeply \@output, \@expected, '... the output should be correct'; 109 like $status, $expected_status, 110 '... and the status line should be correct'; 111 like $summary, $expected_summary, 112 '... and the report summary should look correct'; 113 114 # run same test twice 115 116 @output = (); 117 ok $aggregate = _runtests( 118 $harness, [ "$source_tests/harness", 'My Nice Test' ], 119 [ "$source_tests/harness", 'My Nice Test Again' ] 120 ), 121 'runtests labels returns the aggregate'; 122 123 isa_ok $aggregate, 'TAP::Parser::Aggregator'; 124 125 chomp(@output); 126 127 @expected = ( 128 'My Nice Test ........', 129 '1..1', 130 'ok 1 - this is a test', 131 'ok', 132 'My Nice Test Again ..', 133 '1..1', 134 'ok 1 - this is a test', 135 'ok', 136 'All tests successful.', 137 ); 138 $status = pop @output; 139 $expected_status = qr{^Result: PASS$}; 140 $summary = pop @output; 141 $expected_summary = qr{^Files=2, Tests=2, +\d+ wallclock secs}; 142 143 is_deeply \@output, \@expected, '... the output should be correct'; 144 like $status, $expected_status, 145 '... and the status line should be correct'; 146 like $summary, $expected_summary, 147 '... and the report summary should look correct'; 148 149 # normal tests in quiet mode 150 151 @output = (); 152 ok _runtests( $harness_whisper, "$source_tests/harness" ), 153 'Run tests with whisper'; 154 155 chomp(@output); 156 @expected = ( 157 "$source_tests/harness .. ok", 158 'All tests successful.', 159 ); 160 161 $status = pop @output; 162 $expected_status = qr{^Result: PASS$}; 163 $summary = pop @output; 164 $expected_summary = qr/^Files=1, Tests=1, +\d+ wallclock secs/; 165 166 is_deeply \@output, \@expected, '... the output should be correct'; 167 like $status, $expected_status, 168 '... and the status line should be correct'; 169 like $summary, $expected_summary, 170 '... and the report summary should look correct'; 171 172 # normal tests in really_quiet mode 173 174 @output = (); 175 ok _runtests( $harness_mute, "$source_tests/harness" ), 'Run tests mute'; 176 177 chomp(@output); 178 @expected = ( 179 'All tests successful.', 180 ); 181 182 $status = pop @output; 183 $expected_status = qr{^Result: PASS$}; 184 $summary = pop @output; 185 $expected_summary = qr/^Files=1, Tests=1, +\d+ wallclock secs/; 186 187 is_deeply \@output, \@expected, '... the output should be correct'; 188 like $status, $expected_status, 189 '... and the status line should be correct'; 190 like $summary, $expected_summary, 191 '... and the report summary should look correct'; 192 193 # normal tests with failures 194 195 @output = (); 196 ok _runtests( $harness, "$source_tests/harness_failure" ), 197 'Run tests with failures'; 198 199 $status = pop @output; 200 $summary = pop @output; 201 202 like $status, qr{^Result: FAIL$}, '... the status line should be correct'; 203 204 my @summary = @output[ 9 .. $#output ]; 205 @output = @output[ 0 .. 8 ]; 206 207 @expected = ( 208 "$source_tests/harness_failure ..", 209 '1..2', 210 'ok 1 - this is a test', 211 'not ok 2 - this is another test', 212 q{# Failed test 'this is another test'}, 213 '# in harness_failure.t at line 5.', 214 q{# got: 'waffle'}, 215 q{# expected: 'yarblokos'}, 216 'Failed 1/2 subtests', 217 ); 218 219 is_deeply \@output, \@expected, 220 '... and failing test output should be correct'; 221 222 my @expected_summary = ( 223 'Test Summary Report', 224 '-------------------', 225 "$source_tests/harness_failure (Wstat: 0 Tests: 2 Failed: 1)", 226 'Failed test:', 227 '2', 228 ); 229 230 is_deeply \@summary, \@expected_summary, 231 '... and the failure summary should also be correct'; 232 233 # quiet tests with failures 234 235 @output = (); 236 ok _runtests( $harness_whisper, "$source_tests/harness_failure" ), 237 'Run whisper tests with failures'; 238 239 $status = pop @output; 240 $summary = pop @output; 241 @expected = ( 242 "$source_tests/harness_failure ..", 243 'Failed 1/2 subtests', 244 'Test Summary Report', 245 '-------------------', 246 "$source_tests/harness_failure (Wstat: 0 Tests: 2 Failed: 1)", 247 'Failed test:', 248 '2', 249 ); 250 251 like $status, qr{^Result: FAIL$}, '... the status line should be correct'; 252 253 is_deeply \@output, \@expected, 254 '... and failing test output should be correct'; 255 256 # really quiet tests with failures 257 258 @output = (); 259 ok _runtests( $harness_mute, "$source_tests/harness_failure" ), 260 'Run mute tests with failures'; 261 262 $status = pop @output; 263 $summary = pop @output; 264 @expected = ( 265 'Test Summary Report', 266 '-------------------', 267 "$source_tests/harness_failure (Wstat: 0 Tests: 2 Failed: 1)", 268 'Failed test:', 269 '2', 270 ); 271 272 like $status, qr{^Result: FAIL$}, '... the status line should be correct'; 273 274 is_deeply \@output, \@expected, 275 '... and failing test output should be correct'; 276 277 # only show directives 278 279 @output = (); 280 ok _runtests( 281 $harness_directives, 282 "$source_tests/harness_directives" 283 ), 284 'Run tests with directives'; 285 286 chomp(@output); 287 288 @expected = ( 289 "$source_tests/harness_directives ..", 290 'not ok 2 - we have a something # TODO some output', 291 "ok 3 houston, we don't have liftoff # SKIP no funding", 292 'ok', 293 'All tests successful.', 294 295 # ~TODO {{{ this should be an option 296 #'Test Summary Report', 297 #'-------------------', 298 #"$source_tests/harness_directives (Wstat: 0 Tests: 3 Failed: 0)", 299 #'Tests skipped:', 300 #'3', 301 # }}} 302 ); 303 304 $status = pop @output; 305 $summary = pop @output; 306 $expected_summary = qr/^Files=1, Tests=3, +\d+ wallclock secs/; 307 308 is_deeply \@output, \@expected, '... the output should be correct'; 309 like $summary, $expected_summary, 310 '... and the report summary should look correct'; 311 312 like $status, qr{^Result: PASS$}, 313 '... and the status line should be correct'; 314 315 # normal tests with bad tap 316 317 @output = (); 318 ok _runtests( $harness, "$source_tests/harness_badtap" ), 319 'Run tests with bad TAP'; 320 chomp(@output); 321 322 @output = map { trim($_) } @output; 323 $status = pop @output; 324 @summary = @output[ 6 .. ( $#output - 1 ) ]; 325 @output = @output[ 0 .. 5 ]; 326 @expected = ( 327 "$source_tests/harness_badtap ..", 328 '1..2', 329 'ok 1 - this is a test', 330 'not ok 2 - this is another test', 331 '1..2', 332 'Failed 1/2 subtests', 333 ); 334 is_deeply \@output, \@expected, 335 '... failing test output should be correct'; 336 like $status, qr{^Result: FAIL$}, 337 '... and the status line should be correct'; 338 @expected_summary = ( 339 'Test Summary Report', 340 '-------------------', 341 "$source_tests/harness_badtap (Wstat: 0 Tests: 2 Failed: 1)", 342 'Failed test:', 343 '2', 344 'Parse errors: More than one plan found in TAP output', 345 ); 346 is_deeply \@summary, \@expected_summary, 347 '... and the badtap summary should also be correct'; 348 349 # coverage testing for _should_show_failures 350 # only show failures 351 352 @output = (); 353 ok _runtests( $harness_failures, "$source_tests/harness_failure" ), 354 'Run tests with failures only'; 355 356 chomp(@output); 357 358 @expected = ( 359 "$source_tests/harness_failure ..", 360 'not ok 2 - this is another test', 361 'Failed 1/2 subtests', 362 'Test Summary Report', 363 '-------------------', 364 "$source_tests/harness_failure (Wstat: 0 Tests: 2 Failed: 1)", 365 'Failed test:', 366 '2', 367 ); 368 369 $status = pop @output; 370 $summary = pop @output; 371 372 like $status, qr{^Result: FAIL$}, '... the status line should be correct'; 373 $expected_summary = qr/^Files=1, Tests=2, +\d+ wallclock secs/; 374 is_deeply \@output, \@expected, '... and the output should be correct'; 375 376 # check the status output for no tests 377 378 @output = (); 379 ok _runtests( $harness_failures, "$sample_tests/no_output" ), 380 'Run tests with failures'; 381 382 chomp(@output); 383 384 @expected = ( 385 "$sample_tests/no_output ..", 386 'No subtests run', 387 'Test Summary Report', 388 '-------------------', 389 "$sample_tests/no_output (Wstat: 0 Tests: 0 Failed: 0)", 390 'Parse errors: No plan found in TAP output', 391 ); 392 393 $status = pop @output; 394 $summary = pop @output; 395 396 like $status, qr{^Result: FAIL$}, '... the status line should be correct'; 397 $expected_summary = qr/^Files=1, Tests=2, +\d+ wallclock secs/; 398 is_deeply \@output, \@expected, '... and the output should be correct'; 399 400 # coverage testing for _should_show_comments 401 # only show comments 402 403 @output = (); 404 ok _runtests( $harness_comments, "$source_tests/harness_failure" ), 405 'Run tests with comments'; 406 chomp(@output); 407 408 @expected = ( 409 "$source_tests/harness_failure ..", 410 q{# Failed test 'this is another test'}, 411 '# in harness_failure.t at line 5.', 412 q{# got: 'waffle'}, 413 q{# expected: 'yarblokos'}, 414 'Failed 1/2 subtests', 415 'Test Summary Report', 416 '-------------------', 417 "$source_tests/harness_failure (Wstat: 0 Tests: 2 Failed: 1)", 418 'Failed test:', 419 '2', 420 ); 421 422 $status = pop @output; 423 $summary = pop @output; 424 425 like $status, qr{^Result: FAIL$}, '... the status line should be correct'; 426 $expected_summary = qr/^Files=1, Tests=2, +\d+ wallclock secs/; 427 is_deeply \@output, \@expected, '... and the output should be correct'; 428 429 # coverage testing for _should_show_comments and _should_show_failures 430 # only show comments and failures 431 432 @output = (); 433 $ENV{FOO} = 1; 434 ok _runtests( $harness_fandc, "$source_tests/harness_failure" ), 435 'Run tests with failures and comments'; 436 delete $ENV{FOO}; 437 chomp(@output); 438 439 @expected = ( 440 "$source_tests/harness_failure ..", 441 'not ok 2 - this is another test', 442 q{# Failed test 'this is another test'}, 443 '# in harness_failure.t at line 5.', 444 q{# got: 'waffle'}, 445 q{# expected: 'yarblokos'}, 446 'Failed 1/2 subtests', 447 'Test Summary Report', 448 '-------------------', 449 "$source_tests/harness_failure (Wstat: 0 Tests: 2 Failed: 1)", 450 'Failed test:', 451 '2', 452 ); 453 454 $status = pop @output; 455 $summary = pop @output; 456 457 like $status, qr{^Result: FAIL$}, '... the status line should be correct'; 458 $expected_summary = qr/^Files=1, Tests=2, +\d+ wallclock secs/; 459 is_deeply \@output, \@expected, '... and the output should be correct'; 460 461 #XXXX 462} 463 464sub trim { 465 $_[0] =~ s/^\s+|\s+$//g; 466 return $_[0]; 467} 468 469sub _runtests { 470 my ( $harness, @tests ) = @_; 471 local $ENV{PERL_TEST_HARNESS_DUMP_TAP} = 0; 472 my $aggregate = $harness->runtests(@tests); 473 return $aggregate; 474} 475 476