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