lib/Test/Harness.pm

   1 # -*- Mode: cperl; cperl-indent-level: 4 -*-
   2 package Test::Harness;
   3
   4 use 5.005_64;
   5 use Exporter;
   6 use Benchmark;
   7 use Config;
   8 use strict;
   9
  10 our($VERSION, $Verbose, $Switches, $Have_Devel_Corestack, $Curtest,
  11     $Columns, $verbose, $switches,
  12     @ISA, @EXPORT, @EXPORT_OK
  13    );
  14
  15 # Backwards compatibility for exportable variable names.
  16 *verbose  = \$Verbose;
  17 *switches = \$Switches;
  18
  19 $Have_Devel_Corestack = 0;
  20
  21 $VERSION = "1.1702";
  22
  23 $ENV{HARNESS_ACTIVE} = 1;
  24
  25 # Some experimental versions of OS/2 build have broken $?
  26 my $Ignore_Exitcode = $ENV{HARNESS_IGNORE_EXITCODE};
  27
  28 my $Files_In_Dir = $ENV{HARNESS_FILELEAK_IN_DIR};
  29
  30
  31 @ISA = ('Exporter');
  32 @EXPORT    = qw(&runtests);
  33 @EXPORT_OK = qw($verbose $switches);
  34
  35 $Verbose  = 0;
  36 $Switches = "-w";
  37 $Columns  = $ENV{HARNESS_COLUMNS} || $ENV{COLUMNS} || 80;
  38
  39
  40 sub globdir { opendir DIRH, shift; my @f = readdir DIRH; closedir DIRH; @f }
  41
  42 sub runtests {
  43     my(@tests) = @_;
  44
  45     my($tot, $failedtests) = _runtests(@tests);
  46     _show_results($tot, $failedtests);
  47
  48     return ($tot->{bad} == 0 && $tot->{max}) ;
  49 }
  50
  51
  52 sub _runtests {
  53     my(@tests) = @_;
  54     local($|) = 1;
  55     my(%failedtests);
  56
  57     # Test-wide totals.
  58     my(%tot) = (
  59                 bonus    => 0,
  60                 max      => 0,
  61                 ok       => 0,
  62                 files    => 0,
  63                 bad      => 0,
  64                 good     => 0,
  65                 tests    => scalar @tests,
  66                 sub_skipped  => 0,
  67                 skipped  => 0,
  68                 bench    => 0
  69                );
  70
  71     # pass -I flags to children
  72     my $old5lib = $ENV{PERL5LIB};
  73
  74     # VMS has a 255-byte limit on the length of %ENV entries, so
  75     # toss the ones that involve perl_root, the install location
  76     # for VMS
  77     my $new5lib;
  78     if ($^O eq 'VMS') {
  79         $new5lib = join($Config{path_sep}, grep {!/perl_root/i;} @INC);
  80         $Switches =~ s/-(\S*[A-Z]\S*)/"-$1"/g;
  81     }
  82     else {
  83         $new5lib = join($Config{path_sep}, @INC);
  84     }
  85
  86     local($ENV{'PERL5LIB'}) = $new5lib;
  87
  88     my @dir_files = globdir $Files_In_Dir if defined $Files_In_Dir;
  89     my $t_start = new Benchmark;
  90
  91     foreach my $test (@tests) {
  92         my $te = $test;
  93         chop($te);      # XXX chomp?
  94
  95         if ($^O eq 'VMS') { $te =~ s/^.*\.t\./[.t./s; }
  96         my $blank = (' ' x 77);
  97         my $leader = "$te" . '.' x (20 - length($te));
  98         my $ml = "";
  99         $ml = "\r$blank\r$leader"
 100             if -t STDOUT and not $ENV{HARNESS_NOTTY} and not $Verbose;
 101         print $leader;
 102
 103          my $s = _set_switches($test);
 104
 105         my $cmd = ($ENV{'HARNESS_COMPILE_TEST'})
 106                 ? "./perl -I../lib ../utils/perlcc $test "
 107                   . "-r 2>> ./compilelog |"
 108                 : "$^X $s $test|";
 109         $cmd = "MCR $cmd" if $^O eq 'VMS';
 110         open(my $fh, $cmd) or print "can't run $test. $!\n";
 111
 112         # state of the current test.
 113         my %test = (
 114                     ok          => 0,
 115                     next        => 0,
 116                     max         => 0,
 117                     failed      => [],
 118                     todo        => {},
 119                     bonus       => 0,
 120                     skipped     => 0,
 121                     skip_reason => undef,
 122                     ml          => $ml,
 123                    );
 124
 125         my($seen_header, $tests_seen) = (0,0);
 126         while (<$fh>) {
 127             if( _parse_header($_, \%test, \%tot) ) {
 128                 warn "Test header seen twice!\n" if $seen_header;
 129
 130                 $seen_header = 1;
 131
 132                 warn "1..M can only appear at the beginning or end of tests\n"
 133                   if $tests_seen && $test{max} < $tests_seen;
 134             }
 135             elsif( _parse_test_line($_, \%test, \%tot) ) {
 136                 $tests_seen++;
 137             }
 138             # else, ignore it.
 139         }
 140
 141         my($estatus, $wstatus) = _close_fh($fh);
 142
 143         if ($wstatus) {
 144             $failedtests{$test} = _dubious_return(\%test, \%tot,
 145                                                   $estatus, $wstatus);
 146             $failedtests{$test}{name} = $test;
 147         }
 148         elsif ($test{ok} == $test{max} && $test{next} == $test{max}+1) {
 149             if ($test{max} and $test{skipped} + $test{bonus}) {
 150                 my @msg;
 151                 push(@msg, "$test{skipped}/$test{max} skipped: $test{skip_reason}")
 152                     if $test{skipped};
 153                 push(@msg, "$test{bonus}/$test{max} unexpectedly succeeded")
 154                     if $test{bonus};
 155                 print "$test{ml}ok, ".join(', ', @msg)."\n";
 156             } elsif ($test{max}) {
 157                 print "$test{ml}ok\n";
 158             } elsif (defined $test{skip_reason}) {
 159                 print "skipped: $test{skip_reason}\n";
 160                 $tot{skipped}++;
 161             } else {
 162                 print "skipped test on this platform\n";
 163                 $tot{skipped}++;
 164             }
 165             $tot{good}++;
 166         } elsif ($test{max}) {
 167             if ($test{next} <= $test{max}) {
 168                 push @{$test{failed}}, $test{next}..$test{max};
 169             }
 170             if (@{$test{failed}}) {
 171                 my ($txt, $canon) = canonfailed($test{max},$test{skipped},
 172                                                 @{$test{failed}});
 173                 print "$test{ml}$txt";
 174                 $failedtests{$test} = { canon   => $canon,
 175                                         max     => $test{max},
 176                                         failed  => scalar @{$test{failed}},
 177                                         name    => $test,
 178                                         percent => 100*(scalar @{$test{failed}})/$test{max},
 179                                         estat   => '',
 180                                         wstat   => '',
 181                                       };
 182             } else {
 183                 print "Don't know which tests failed: got $test{ok} ok, ".
 184                       "expected $test{max}\n";
 185                 $failedtests{$test} = { canon   => '??',
 186                                         max     => $test{max},
 187                                         failed  => '??',
 188                                         name    => $test,
 189                                         percent => undef,
 190                                         estat   => '',
 191                                         wstat   => '',
 192                                       };
 193             }
 194             $tot{bad}++;
 195         } elsif ($test{next} == 0) {
 196             print "FAILED before any test output arrived\n";
 197             $tot{bad}++;
 198             $failedtests{$test} = { canon       => '??',
 199                                     max         => '??',
 200                                     failed      => '??',
 201                                     name        => $test,
 202                                     percent     => undef,
 203                                     estat       => '',
 204                                     wstat       => '',
 205                                   };
 206         }
 207         $tot{sub_skipped} += $test{skipped};
 208
 209         if (defined $Files_In_Dir) {
 210             my @new_dir_files = globdir $Files_In_Dir;
 211             if (@new_dir_files != @dir_files) {
 212                 my %f;
 213                 @f{@new_dir_files} = (1) x @new_dir_files;
 214                 delete @f{@dir_files};
 215                 my @f = sort keys %f;
 216                 print "LEAKED FILES: @f\n";
 217                 @dir_files = @new_dir_files;
 218             }
 219         }
 220     }
 221     $tot{bench} = timediff(new Benchmark, $t_start);
 222
 223     if ($^O eq 'VMS') {
 224         if (defined $old5lib) {
 225             $ENV{PERL5LIB} = $old5lib;
 226         } else {
 227             delete $ENV{PERL5LIB};
 228         }
 229     }
 230
 231     return(\%tot, \%failedtests);
 232 }
 233
 234
 235 sub _show_results {
 236     my($tot, $failedtests) = @_;
 237
 238     my $pct;
 239     my $bonusmsg = _bonusmsg($tot);
 240
 241     if ($tot->{bad} == 0 && $tot->{max}) {
 242         print "All tests successful$bonusmsg.\n";
 243     } elsif ($tot->{tests}==0){
 244         die "FAILED--no tests were run for some reason.\n";
 245     } elsif ($tot->{max} == 0) {
 246         my $blurb = $tot->{tests}==1 ? "script" : "scripts";
 247         die "FAILED--$tot->{tests} test $blurb could be run, ".
 248             "alas--no output ever seen\n";
 249     } else {
 250         $pct = sprintf("%.2f", $tot->{good} / $tot->{tests} * 100);
 251         my $subpct = sprintf " %d/%d subtests failed, %.2f%% okay.",
 252                               $tot->{max} - $tot->{ok}, $tot->{max},
 253                               100*$tot->{ok}/$tot->{max};
 254
 255         my($fmt_top, $fmt) = _create_fmts($failedtests);
 256
 257         # Now write to formats
 258         for my $script (sort keys %$failedtests) {
 259           $Curtest = $failedtests->{$script};
 260           write;
 261         }
 262         if ($tot->{bad}) {
 263             $bonusmsg =~ s/^,\s*//;
 264             print "$bonusmsg.\n" if $bonusmsg;
 265             die "Failed $tot->{bad}/$tot->{tests} test scripts, $pct% okay.".
 266                 "$subpct\n";
 267         }
 268     }
 269
 270     printf("Files=%d, Tests=%d, %s\n",
 271            $tot->{files}, $tot->{max}, timestr($tot->{bench}, 'nop'));
 272 }
 273
 274
 275 sub _parse_header {
 276     my($line, $test, $tot) = @_;
 277
 278     my $is_header = 0;
 279
 280     print $line if $Verbose;
 281
 282     # 1..10 todo 4 7 10;
 283     if ($line =~ /^1\.\.([0-9]+) todo([\d\s]+);?/i) {
 284         $test->{max} = $1;
 285         for (split(/\s+/, $2)) { $test->{todo}{$_} = 1; }
 286
 287         $tot->{max} += $test->{max};
 288         $tot->{files}++;
 289
 290         $is_header = 1;
 291     }
 292     # 1..10
 293     # 1..0 # skip  Why?  Because I said so!
 294     elsif ($line =~ /^1\.\.([0-9]+)
 295                       (\s*\#\s*[Ss]kip\S*(?>\s+) (.+))?
 296                     /x
 297           )
 298     {
 299         $test->{max} = $1;
 300         $tot->{max} += $test->{max};
 301         $tot->{files}++;
 302         $test->{next} = 1 unless $test->{next};
 303         $test->{skip_reason} = $3 if not $test->{max} and defined $3;
 304
 305         $is_header = 1;
 306     }
 307     else {
 308         $is_header = 0;
 309     }
 310
 311     return $is_header;
 312 }
 313
 314
 315 sub _parse_test_line {
 316     my($line, $test, $tot) = @_;
 317
 318     if ($line =~ /^(not\s+)?ok\b/i) {
 319         my $this = $test->{next} || 1;
 320         # "not ok 23"
 321         if ($line =~ /^(not )?ok\s*(\d*)(\s*#.*)?/) {
 322             my($not, $tnum, $extra) = ($1, $2, $3);
 323
 324             $this = $tnum if $tnum;
 325
 326             my($type, $reason) = $extra =~ /^\s*#\s*([Ss]kip\S*|TODO)(\s+.+)?/
 327               if defined $extra;
 328
 329             my($istodo, $isskip);
 330             if( defined $type ) {
 331                 $istodo = $type =~ /TODO/;
 332                 $isskip = $type =~ /skip/i;
 333             }
 334
 335             $test->{todo}{$tnum} = 1 if $istodo;
 336
 337             if( $not ) {
 338                 print "$test->{ml}NOK $this" if $test->{ml};
 339                 if (!$test->{todo}{$this}) {
 340                     push @{$test->{failed}}, $this;
 341                 } else {
 342                     $test->{ok}++;
 343                     $tot->{ok}++;
 344                 }
 345             }
 346             else {
 347                 print "$test->{ml}ok $this/$test->{max}" if $test->{ml};
 348                 $test->{ok}++;
 349                 $tot->{ok}++;
 350                 $test->{skipped}++ if $isskip;
 351
 352                 if (defined $reason and defined $test->{skip_reason}) {
 353                     # print "was: '$skip_reason' new '$reason'\n";
 354                     $test->{skip_reason} = 'various reasons'
 355                       if $test->{skip_reason} ne $reason;
 356                 } elsif (defined $reason) {
 357                     $test->{skip_reason} = $reason;
 358                 }
 359
 360                 $test->{bonus}++, $tot->{bonus}++ if $test->{todo}{$this};
 361             }
 362         }
 363         # XXX ummm... dunno
 364         elsif ($line =~ /^ok\s*(\d*)\s*\#([^\r]*)$/) { # XXX multiline ok?
 365             $this = $1 if $1 > 0;
 366             print "$test->{ml}ok $this/$test->{max}" if $test->{ml};
 367             $test->{ok}++;
 368             $tot->{ok}++;
 369         }
 370         else {
 371             # an ok or not ok not matching the 3 cases above...
 372             # just ignore it for compatibility with TEST
 373             next;
 374         }
 375
 376         if ($this > $test->{next}) {
 377             # print "Test output counter mismatch [test $this]\n";
 378             # no need to warn probably
 379             push @{$test->{failed}}, $test->{next}..$this-1;
 380         }
 381         elsif ($this < $test->{next}) {
 382             #we have seen more "ok" lines than the number suggests
 383             print "Confused test output: test $this answered after ".
 384                   "test ", $test->{next}-1, "\n";
 385             $test->{next} = $this;
 386         }
 387         $test->{next} = $this + 1;
 388
 389     }
 390     elsif ($line =~ /^Bail out!\s*(.*)/i) { # magic words
 391         die "FAILED--Further testing stopped" .
 392             ($1 ? ": $1\n" : ".\n");
 393     }
 394 }
 395
 396
 397 sub _bonusmsg {
 398     my($tot) = @_;
 399
 400     my $bonusmsg = '';
 401     $bonusmsg = (" ($tot->{bonus} subtest".($tot->{bonus} > 1 ? 's' : '').
 402                " UNEXPECTEDLY SUCCEEDED)")
 403         if $tot->{bonus};
 404
 405     if ($tot->{skipped}) {
 406         $bonusmsg .= ", $tot->{skipped} test"
 407                      . ($tot->{skipped} != 1 ? 's' : '');
 408         if ($tot->{sub_skipped}) {
 409             $bonusmsg .= " and $tot->{sub_skipped} subtest"
 410                          . ($tot->{sub_skipped} != 1 ? 's' : '');
 411         }
 412         $bonusmsg .= ' skipped';
 413     }
 414     elsif ($tot->{sub_skipped}) {
 415         $bonusmsg .= ", $tot->{sub_skipped} subtest"
 416                      . ($tot->{sub_skipped} != 1 ? 's' : '')
 417                      . " skipped";
 418     }
 419
 420     return $bonusmsg;
 421 }
 422
 423 # VMS has some subtle nastiness with closing the test files.
 424 sub _close_fh {
 425     my($fh) = shift;
 426
 427     close($fh); # must close to reap child resource values
 428
 429     my $wstatus = $Ignore_Exitcode ? 0 : $?;    # Can trust $? ?
 430     my $estatus;
 431     $estatus = ($^O eq 'VMS'
 432                   ? eval 'use vmsish "status"; $estatus = $?'
 433                   : $wstatus >> 8);
 434
 435     return($estatus, $wstatus);
 436 }
 437
 438
 439 # Set up the command-line switches to run perl as.
 440 sub _set_switches {
 441     my($test) = shift;
 442
 443     open(my $fh, $test) or print "can't open $test. $!\n";
 444     my $first = <$fh>;
 445     my $s = $Switches;
 446     $s .= " $ENV{'HARNESS_PERL_SWITCHES'}"
 447       if exists $ENV{'HARNESS_PERL_SWITCHES'};
 448     $s .= join " ", q[ "-T"], map {qq["-I$_"]} @INC
 449       if $first =~ /^#!.*\bperl.*-\w*T/;
 450
 451     close($fh) or print "can't close $test. $!\n";
 452
 453     return $s;
 454 }
 455
 456
 457 # Test program go boom.
 458 sub _dubious_return {
 459     my($test, $tot, $estatus, $wstatus) = @_;
 460     my ($failed, $canon, $percent) = ('??', '??');
 461
 462     printf "$test->{ml}dubious\n\tTest returned status $estatus ".
 463            "(wstat %d, 0x%x)\n",
 464            $wstatus,$wstatus;
 465     print "\t\t(VMS status is $estatus)\n" if $^O eq 'VMS';
 466
 467     if (corestatus($wstatus)) { # until we have a wait module
 468         if ($Have_Devel_Corestack) {
 469             Devel::CoreStack::stack($^X);
 470         } else {
 471             print "\ttest program seems to have generated a core\n";
 472         }
 473     }
 474
 475     $tot->{bad}++;
 476
 477     if ($test->{max}) {
 478         if ($test->{next} == $test->{max} + 1 and not @{$test->{failed}}) {
 479             print "\tafter all the subtests completed successfully\n";
 480             $percent = 0;
 481             $failed = 0;        # But we do not set $canon!
 482         }
 483         else {
 484             push @{$test->{failed}}, $test->{next}..$test->{max};
 485             $failed = @{$test->{failed}};
 486             (my $txt, $canon) = canonfailed($test->{max},$test->{skipped},@{$test->{failed}});
 487             $percent = 100*(scalar @{$test->{failed}})/$test->{max};
 488             print "DIED. ",$txt;
 489         }
 490     }
 491
 492     return { canon => $canon,  max => $test->{max} || '??',
 493              failed => $failed,
 494              percent => $percent,
 495              estat => $estatus, wstat => $wstatus,
 496            };
 497 }
 498
 499
 500 sub _garbled_output {
 501     my($gibberish) = shift;
 502     warn "Confusing test output:  '$gibberish'\n";
 503 }
 504
 505
 506 sub _create_fmts {
 507     my($failedtests) = @_;
 508
 509     my $failed_str = "Failed Test";
 510     my $middle_str = " Status Wstat Total Fail  Failed  ";
 511     my $list_str = "List of Failed";
 512
 513     # Figure out our longest name string for formatting purposes.
 514     my $max_namelen = length($failed_str);
 515     foreach my $script (keys %$failedtests) {
 516         my $namelen = length $failedtests->{$script}->{name};
 517         $max_namelen = $namelen if $namelen > $max_namelen;
 518     }
 519
 520     my $list_len = $Columns - length($middle_str) - $max_namelen;
 521     if ($list_len < length($list_str)) {
 522         $list_len = length($list_str);
 523         $max_namelen = $Columns - length($middle_str) - $list_len;
 524         if ($max_namelen < length($failed_str)) {
 525             $max_namelen = length($failed_str);
 526             $Columns = $max_namelen + length($middle_str) + $list_len;
 527         }
 528     }
 529
 530     my $fmt_top = "format STDOUT_TOP =\n"
 531                   . sprintf("%-${max_namelen}s", $failed_str)
 532                   . $middle_str
 533                   . $list_str . "\n"
 534                   . "-" x $Columns
 535                   . "\n.\n";
 536
 537     my $fmt = "format STDOUT =\n"
 538               . "@" . "<" x ($max_namelen - 1)
 539               . "        @>> @>>>> @>>>> @>>> ^##.##%  "
 540               . "^" . "<" x ($list_len - 1) . "\n"
 541               . '{ $Curtest->{name}, $Curtest->{estat},'
 542               . '  $Curtest->{wstat}, $Curtest->{max},'
 543               . '  $Curtest->{failed}, $Curtest->{percent},'
 544               . '  $Curtest->{canon}'
 545               . "\n}\n"
 546               . "~~" . " " x ($Columns - $list_len - 2) . "^"
 547               . "<" x ($list_len - 1) . "\n"
 548               . '$Curtest->{canon}'
 549               . "\n.\n";
 550
 551     eval $fmt_top;
 552     die $@ if $@;
 553     eval $fmt;
 554     die $@ if $@;
 555
 556     return($fmt_top, $fmt);
 557 }
 558
 559
 560 my $tried_devel_corestack;
 561 sub corestatus {
 562     my($st) = @_;
 563
 564     eval {require 'wait.ph'};
 565     my $ret = defined &WCOREDUMP ? WCOREDUMP($st) : $st & 0200;
 566
 567     eval { require Devel::CoreStack; $Have_Devel_Corestack++ }
 568       unless $tried_devel_corestack++;
 569
 570     $ret;
 571 }
 572
 573 sub canonfailed ($@) {
 574     my($max,$skipped,@failed) = @_;
 575     my %seen;
 576     @failed = sort {$a <=> $b} grep !$seen{$_}++, @failed;
 577     my $failed = @failed;
 578     my @result = ();
 579     my @canon = ();
 580     my $min;
 581     my $last = $min = shift @failed;
 582     my $canon;
 583     if (@failed) {
 584         for (@failed, $failed[-1]) { # don't forget the last one
 585             if ($_ > $last+1 || $_ == $last) {
 586                 if ($min == $last) {
 587                     push @canon, $last;
 588                 } else {
 589                     push @canon, "$min-$last";
 590                 }
 591                 $min = $_;
 592             }
 593             $last = $_;
 594         }
 595         local $" = ", ";
 596         push @result, "FAILED tests @canon\n";
 597         $canon = "@canon";
 598     } else {
 599         push @result, "FAILED test $last\n";
 600         $canon = $last;
 601     }
 602
 603     push @result, "\tFailed $failed/$max tests, ";
 604     push @result, sprintf("%.2f",100*(1-$failed/$max)), "% okay";
 605     my $ender = 's' x ($skipped > 1);
 606     my $good = $max - $failed - $skipped;
 607     my $goodper = sprintf("%.2f",100*($good/$max));
 608     push @result, " (-$skipped skipped test$ender: $good okay, ".
 609                   "$goodper%)"
 610          if $skipped;
 611     push @result, "\n";
 612     my $txt = join "", @result;
 613     ($txt, $canon);
 614 }
 615
 616 1;
 617 __END__
 618
 619 =head1 NAME
 620
 621 Test::Harness - run perl standard test scripts with statistics
 622
 623 =head1 SYNOPSIS
 624
 625   use Test::Harness;
 626
 627   runtests(@test_files);
 628
 629 =head1 DESCRIPTION
 630
 631 (By using the Test module, you can write test scripts without
 632 knowing the exact output this module expects.  However, if you need to
 633 know the specifics, read on!)
 634
 635 Perl test scripts print to standard output C<"ok N"> for each single
 636 test, where C<N> is an increasing sequence of integers. The first line
 637 output by a standard test script is C<"1..M"> with C<M> being the
 638 number of tests that should be run within the test
 639 script. Test::Harness::runtests(@tests) runs all the testscripts
 640 named as arguments and checks standard output for the expected
 641 C<"ok N"> strings.
 642
 643 After all tests have been performed, runtests() prints some
 644 performance statistics that are computed by the Benchmark module.
 645
 646 =head2 The test script output
 647
 648 The following explains how Test::Harness interprets the output of your
 649 test program.
 650
 651 =over 4
 652
 653 =item B<1..M>
 654
 655 This header tells how many tests there will be.  It should be the
 656 first line output by your test program (but its okay if its preceded
 657 by comments).
 658
 659 In certain instanced, you may not know how many tests you will
 660 ultimately be running.  In this case, it is permitted (but not
 661 encouraged) for the 1..M header to appear as the B<last> line output
 662 by your test (again, it can be followed by further comments).  But we
 663 strongly encourage you to put it first.
 664
 665 Under B<no> circumstances should 1..M appear in the middle of your
 666 output or more than once.
 667
 668
 669 =item B<'ok', 'not ok'.  Ok?>
 670
 671 Any output from the testscript to standard error is ignored and
 672 bypassed, thus will be seen by the user. Lines written to standard
 673 output containing C</^(not\s+)?ok\b/> are interpreted as feedback for
 674 runtests().  All other lines are discarded.
 675
 676 C</^not ok/> indicates a failed test.  C</^ok/> is a successful test.
 677
 678
 679 =item B<test numbers>
 680
 681 Perl normally expects the 'ok' or 'not ok' to be followed by a test
 682 number.  It is tolerated if the test numbers after 'ok' are
 683 omitted. In this case Test::Harness maintains temporarily its own
 684 counter until the script supplies test numbers again. So the following
 685 test script
 686
 687     print <<END;
 688     1..6
 689     not ok
 690     ok
 691     not ok
 692     ok
 693     ok
 694     END
 695
 696 will generate
 697
 698     FAILED tests 1, 3, 6
 699     Failed 3/6 tests, 50.00% okay
 700
 701
 702 =item B<$Test::Harness::verbose>
 703
 704 The global variable $Test::Harness::verbose is exportable and can be
 705 used to let runtests() display the standard output of the script
 706 without altering the behavior otherwise.
 707
 708 =item B<$Test::Harness::switches>
 709
 710 The global variable $Test::Harness::switches is exportable and can be
 711 used to set perl command line options used for running the test
 712 script(s). The default value is C<-w>.
 713
 714 =item B<Skipping tests>
 715
 716 If the standard output line contains the substring C< # Skip> (with
 717 variations in spacing and case) after C<ok> or C<ok NUMBER>, it is
 718 counted as a skipped test.  If the whole testscript succeeds, the
 719 count of skipped tests is included in the generated output.
 720 C<Test::Harness> reports the text after C< # Skip\S*\s+> as a reason
 721 for skipping.
 722
 723   ok 23 # skip Insufficient flogiston pressure.
 724
 725 Similarly, one can include a similar explanation in a C<1..0> line
 726 emitted if the test script is skipped completely:
 727
 728   1..0 # Skipped: no leverage found
 729
 730 =item B<Todo tests>
 731
 732 If the standard output line contains the substring C< # TODO> after
 733 C<not ok> or C<not ok NUMBER>, it is counted as a todo test.  The text
 734 afterwards is the thing that has to be done before this test will
 735 succeed.
 736
 737   not ok 13 # TODO harness the power of the atom
 738
 739 These tests represent a feature to be implemented or a bug to be fixed
 740 and act as something of an executable "thing to do" list.  They are
 741 B<not> expected to succeed.  Should a todo test begin succeeding,
 742 Test::Harness will report it as a bonus.  This indicates that whatever
 743 you were supposed to do has been done and you should promote this to a
 744 normal test.
 745
 746 =item B<Bail out!>
 747
 748 As an emergency measure, a test script can decide that further tests
 749 are useless (e.g. missing dependencies) and testing should stop
 750 immediately. In that case the test script prints the magic words
 751
 752   Bail out!
 753
 754 to standard output. Any message after these words will be displayed by
 755 C<Test::Harness> as the reason why testing is stopped.
 756
 757 =item B<Comments>
 758
 759 Additional comments may be put into the testing output on their own
 760 lines.  Comment lines should begin with a '#', Test::Harness will
 761 ignore them.
 762
 763   ok 1
 764   # Life is good, the sun is shining, RAM is cheap.
 765   not ok 2
 766   # got 'Bush' expected 'Gore'
 767
 768
 769 =head1 EXPORT
 770
 771 C<&runtests> is exported by Test::Harness per default.
 772
 773 C<$verbose> and C<$switches> are exported upon request.
 774
 775
 776 =head1 DIAGNOSTICS
 777
 778 =over 4
 779
 780 =item C<All tests successful.\nFiles=%d,  Tests=%d, %s>
 781
 782 If all tests are successful some statistics about the performance are
 783 printed.
 784
 785 =item C<FAILED tests %s\n\tFailed %d/%d tests, %.2f%% okay.>
 786
 787 For any single script that has failing subtests statistics like the
 788 above are printed.
 789
 790 =item C<Test returned status %d (wstat %d)>
 791
 792 Scripts that return a non-zero exit status, both C<$? E<gt>E<gt> 8>
 793 and C<$?> are printed in a message similar to the above.
 794
 795 =item C<Failed 1 test, %.2f%% okay. %s>
 796
 797 =item C<Failed %d/%d tests, %.2f%% okay. %s>
 798
 799 If not all tests were successful, the script dies with one of the
 800 above messages.
 801
 802 =item C<FAILED--Further testing stopped%s>
 803
 804 If a single subtest decides that further testing will not make sense,
 805 the script dies with this message.
 806
 807 =back
 808
 809 =head1 ENVIRONMENT
 810
 811 =over 4
 812
 813 =item C<HARNESS_IGNORE_EXITCODE>
 814
 815 Makes harness ignore the exit status of child processes when defined.
 816
 817 =item C<HARNESS_NOTTY>
 818
 819 When set to a true value, forces it to behave as though STDOUT were
 820 not a console.  You may need to set this if you don't want harness to
 821 output more frequent progress messages using carriage returns.  Some
 822 consoles may not handle carriage returns properly (which results in a
 823 somewhat messy output).
 824
 825 =item C<HARNESS_COMPILE_TEST>
 826
 827 When true it will make harness attempt to compile the test using
 828 C<perlcc> before running it.
 829
 830 =item C<HARNESS_FILELEAK_IN_DIR>
 831
 832 When set to the name of a directory, harness will check after each
 833 test whether new files appeared in that directory, and report them as
 834
 835   LEAKED FILES: scr.tmp 0 my.db
 836
 837 If relative, directory name is with respect to the current directory at
 838 the moment runtests() was called.  Putting absolute path into
 839 C<HARNESS_FILELEAK_IN_DIR> may give more predicatable results.
 840
 841 =item C<HARNESS_PERL_SWITCHES>
 842
 843 Its value will be prepended to the switches used to invoke perl on
 844 each test.  For example, setting C<HARNESS_PERL_SWITCHES> to "-W" will
 845 run all tests with all warnings enabled.
 846
 847 =item C<HARNESS_COLUMNS>
 848
 849 This value will be used for the width of the terminal. If it is not
 850 set then it will default to C<COLUMNS>. If this is not set, it will
 851 default to 80. Note that users of Bourne-sh based shells will need to
 852 C<export COLUMNS> for this module to use that variable.
 853
 854 =item C<HARNESS_ACTIVE>
 855
 856 Harness sets this before executing the individual tests.  This allows
 857 the tests to determine if they are being executed through the harness
 858 or by any other means.
 859
 860 =back
 861
 862
 863 =head1 SEE ALSO
 864
 865 L<Test> for writing test scripts, L<Benchmark> for the underlying
 866 timing routines and L<Devel::Coverage> for test coverage analysis.
 867
 868 =head1 AUTHORS
 869
 870 Either Tim Bunce or Andreas Koenig, we don't know. What we know for
 871 sure is, that it was inspired by Larry Wall's TEST script that came
 872 with perl distributions for ages. Numerous anonymous contributors
 873 exist.
 874
 875 Current maintainers are Andreas Koenig <andreas.koenig@anima.de> and
 876 Michael G Schwern <schwern@pobox.com>
 877
 878 =head1 BUGS
 879
 880 Test::Harness uses $^X to determine the perl binary to run the tests
 881 with. Test scripts running via the shebang (C<#!>) line may not be
 882 portable because $^X is not consistent for shebang scripts across
 883 platforms. This is no problem when Test::Harness is run with an
 884 absolute path to the perl binary or when $^X can be found in the path.
 885
 886 =cut