cpan/Test-Harness/t/file.t

   1 #!/usr/bin/perl -w
   2
   3 BEGIN {
   4     unshift @INC, 't/lib';
   5 }
   6
   7 use strict;
   8
   9 use Test::More;
  10
  11 use TAP::Harness;
  12
  13 my $HARNESS = 'TAP::Harness';
  14
  15 my $source_tests = 't/source_tests';
  16 my $sample_tests = 't/sample-tests';
  17
  18 plan tests => 56;
  19
  20 # note that this test will always pass when run through 'prove'
  21 ok $ENV{HARNESS_ACTIVE},  'HARNESS_ACTIVE env variable should be set';
  22 ok $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
 464 sub trim {
 465     $_[0] =~ s/^\s+|\s+$//g;
 466     return $_[0];
 467 }
 468
 469 sub _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