ext/Test-Harness/t/file.t

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