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 $Columns--; # Do no write into the last column
  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   "; # Borrow up to 3 chars from Status
 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 $failed_len = $max_namelen - 3;
 531     my $fmt_top = "format STDOUT_TOP =\n"
 532                   . sprintf("%-${failed_len}s", "Failed Test")
 533                   . $middle_str
 534                   . $list_str . "\n"
 535                   . "-" x $Columns
 536                   . "\n.\n";
 537
 538     my $fmt = "format STDOUT =\n"
 539               . "@" . "<" x ($max_namelen - 1)
 540               . " @>> @>>>> @>>>> @>>> ^##.##%  "
 541               . "^" . "<" x ($list_len - 1) . "\n"
 542               . '{ $Curtest->{name}, $Curtest->{estat},'
 543               . '  $Curtest->{wstat}, $Curtest->{max},'
 544               . '  $Curtest->{failed}, $Curtest->{percent},'
 545               . '  $Curtest->{canon}'
 546               . "\n}\n"
 547               . "~~" . " " x ($Columns - $list_len - 2) . "^"
 548               . "<" x ($list_len - 1) . "\n"
 549               . '$Curtest->{canon}'
 550               . "\n.\n";
 551
 552     eval $fmt_top;
 553     die $@ if $@;
 554     eval $fmt;
 555     die $@ if $@;
 556
 557     return($fmt_top, $fmt);
 558 }
 559
 560
 561 my $tried_devel_corestack;
 562 sub corestatus {
 563     my($st) = @_;
 564
 565     eval {require 'wait.ph'};
 566     my $ret = defined &WCOREDUMP ? WCOREDUMP($st) : $st & 0200;
 567
 568     eval { require Devel::CoreStack; $Have_Devel_Corestack++ }
 569       unless $tried_devel_corestack++;
 570
 571     $ret;
 572 }
 573
 574 sub canonfailed ($@) {
 575     my($max,$skipped,@failed) = @_;
 576     my %seen;
 577     @failed = sort {$a <=> $b} grep !$seen{$_}++, @failed;
 578     my $failed = @failed;
 579     my @result = ();
 580     my @canon = ();
 581     my $min;
 582     my $last = $min = shift @failed;
 583     my $canon;
 584     if (@failed) {
 585         for (@failed, $failed[-1]) { # don't forget the last one
 586             if ($_ > $last+1 || $_ == $last) {
 587                 if ($min == $last) {
 588                     push @canon, $last;
 589                 } else {
 590                     push @canon, "$min-$last";
 591                 }
 592                 $min = $_;
 593             }
 594             $last = $_;
 595         }
 596         local $" = ", ";
 597         push @result, "FAILED tests @canon\n";
 598         $canon = "@canon";
 599     } else {
 600         push @result, "FAILED test $last\n";
 601         $canon = $last;
 602     }
 603
 604     push @result, "\tFailed $failed/$max tests, ";
 605     push @result, sprintf("%.2f",100*(1-$failed/$max)), "% okay";
 606     my $ender = 's' x ($skipped > 1);
 607     my $good = $max - $failed - $skipped;
 608     my $goodper = sprintf("%.2f",100*($good/$max));
 609     push @result, " (-$skipped skipped test$ender: $good okay, ".
 610                   "$goodper%)"
 611          if $skipped;
 612     push @result, "\n";
 613     my $txt = join "", @result;
 614     ($txt, $canon);
 615 }
 616
 617 1;
 618 __END__
 619
 620 =head1 NAME
 621
 622 Test::Harness - run perl standard test scripts with statistics
 623
 624 =head1 SYNOPSIS
 625
 626   use Test::Harness;
 627
 628   runtests(@test_files);
 629
 630 =head1 DESCRIPTION
 631
 632 (By using the Test module, you can write test scripts without
 633 knowing the exact output this module expects.  However, if you need to
 634 know the specifics, read on!)
 635
 636 Perl test scripts print to standard output C<"ok N"> for each single
 637 test, where C<N> is an increasing sequence of integers. The first line
 638 output by a standard test script is C<"1..M"> with C<M> being the
 639 number of tests that should be run within the test
 640 script. Test::Harness::runtests(@tests) runs all the testscripts
 641 named as arguments and checks standard output for the expected
 642 C<"ok N"> strings.
 643
 644 After all tests have been performed, runtests() prints some
 645 performance statistics that are computed by the Benchmark module.
 646
 647 =head2 The test script output
 648
 649 The following explains how Test::Harness interprets the output of your
 650 test program.
 651
 652 =over 4
 653
 654 =item B<'1..M'>
 655
 656 This header tells how many tests there will be.  It should be the
 657 first line output by your test program (but its okay if its preceded
 658 by comments).
 659
 660 In certain instanced, you may not know how many tests you will
 661 ultimately be running.  In this case, it is permitted (but not
 662 encouraged) for the 1..M header to appear as the B<last> line output
 663 by your test (again, it can be followed by further comments).  But we
 664 strongly encourage you to put it first.
 665
 666 Under B<no> circumstances should 1..M appear in the middle of your
 667 output or more than once.
 668
 669
 670 =item B<'ok', 'not ok'.  Ok?>
 671
 672 Any output from the testscript to standard error is ignored and
 673 bypassed, thus will be seen by the user. Lines written to standard
 674 output containing C</^(not\s+)?ok\b/> are interpreted as feedback for
 675 runtests().  All other lines are discarded.
 676
 677 C</^not ok/> indicates a failed test.  C</^ok/> is a successful test.
 678
 679
 680 =item B<test numbers>
 681
 682 Perl normally expects the 'ok' or 'not ok' to be followed by a test
 683 number.  It is tolerated if the test numbers after 'ok' are
 684 omitted. In this case Test::Harness maintains temporarily its own
 685 counter until the script supplies test numbers again. So the following
 686 test script
 687
 688     print <<END;
 689     1..6
 690     not ok
 691     ok
 692     not ok
 693     ok
 694     ok
 695     END
 696
 697 will generate
 698
 699     FAILED tests 1, 3, 6
 700     Failed 3/6 tests, 50.00% okay
 701
 702
 703 =item B<$Test::Harness::verbose>
 704
 705 The global variable $Test::Harness::verbose is exportable and can be
 706 used to let runtests() display the standard output of the script
 707 without altering the behavior otherwise.
 708
 709 =item B<$Test::Harness::switches>
 710
 711 The global variable $Test::Harness::switches is exportable and can be
 712 used to set perl command line options used for running the test
 713 script(s). The default value is C<-w>.
 714
 715 =item B<Skipping tests>
 716
 717 If the standard output line contains the substring C< # Skip> (with
 718 variations in spacing and case) after C<ok> or C<ok NUMBER>, it is
 719 counted as a skipped test.  If the whole testscript succeeds, the
 720 count of skipped tests is included in the generated output.
 721 C<Test::Harness> reports the text after C< # Skip\S*\s+> as a reason
 722 for skipping.
 723
 724   ok 23 # skip Insufficient flogiston pressure.
 725
 726 Similarly, one can include a similar explanation in a C<1..0> line
 727 emitted if the test script is skipped completely:
 728
 729   1..0 # Skipped: no leverage found
 730
 731 =item B<Todo tests>
 732
 733 If the standard output line contains the substring C< # TODO> after
 734 C<not ok> or C<not ok NUMBER>, it is counted as a todo test.  The text
 735 afterwards is the thing that has to be done before this test will
 736 succeed.
 737
 738   not ok 13 # TODO harness the power of the atom
 739
 740 These tests represent a feature to be implemented or a bug to be fixed
 741 and act as something of an executable "thing to do" list.  They are
 742 B<not> expected to succeed.  Should a todo test begin succeeding,
 743 Test::Harness will report it as a bonus.  This indicates that whatever
 744 you were supposed to do has been done and you should promote this to a
 745 normal test.
 746
 747 =item B<Bail out!>
 748
 749 As an emergency measure, a test script can decide that further tests
 750 are useless (e.g. missing dependencies) and testing should stop
 751 immediately. In that case the test script prints the magic words
 752
 753   Bail out!
 754
 755 to standard output. Any message after these words will be displayed by
 756 C<Test::Harness> as the reason why testing is stopped.
 757
 758 =item B<Comments>
 759
 760 Additional comments may be put into the testing output on their own
 761 lines.  Comment lines should begin with a '#', Test::Harness will
 762 ignore them.
 763
 764   ok 1
 765   # Life is good, the sun is shining, RAM is cheap.
 766   not ok 2
 767   # got 'Bush' expected 'Gore'
 768
 769 =back
 770
 771 =head1 EXPORT
 772
 773 C<&runtests> is exported by Test::Harness per default.
 774
 775 C<$verbose> and C<$switches> are exported upon request.
 776
 777
 778 =head1 DIAGNOSTICS
 779
 780 =over 4
 781
 782 =item C<All tests successful.\nFiles=%d,  Tests=%d, %s>
 783
 784 If all tests are successful some statistics about the performance are
 785 printed.
 786
 787 =item C<FAILED tests %s\n\tFailed %d/%d tests, %.2f%% okay.>
 788
 789 For any single script that has failing subtests statistics like the
 790 above are printed.
 791
 792 =item C<Test returned status %d (wstat %d)>
 793
 794 Scripts that return a non-zero exit status, both C<$? E<gt>E<gt> 8>
 795 and C<$?> are printed in a message similar to the above.
 796
 797 =item C<Failed 1 test, %.2f%% okay. %s>
 798
 799 =item C<Failed %d/%d tests, %.2f%% okay. %s>
 800
 801 If not all tests were successful, the script dies with one of the
 802 above messages.
 803
 804 =item C<FAILED--Further testing stopped%s>
 805
 806 If a single subtest decides that further testing will not make sense,
 807 the script dies with this message.
 808
 809 =back
 810
 811 =head1 ENVIRONMENT
 812
 813 =over 4
 814
 815 =item C<HARNESS_IGNORE_EXITCODE>
 816
 817 Makes harness ignore the exit status of child processes when defined.
 818
 819 =item C<HARNESS_NOTTY>
 820
 821 When set to a true value, forces it to behave as though STDOUT were
 822 not a console.  You may need to set this if you don't want harness to
 823 output more frequent progress messages using carriage returns.  Some
 824 consoles may not handle carriage returns properly (which results in a
 825 somewhat messy output).
 826
 827 =item C<HARNESS_COMPILE_TEST>
 828
 829 When true it will make harness attempt to compile the test using
 830 C<perlcc> before running it.
 831
 832 =item C<HARNESS_FILELEAK_IN_DIR>
 833
 834 When set to the name of a directory, harness will check after each
 835 test whether new files appeared in that directory, and report them as
 836
 837   LEAKED FILES: scr.tmp 0 my.db
 838
 839 If relative, directory name is with respect to the current directory at
 840 the moment runtests() was called.  Putting absolute path into
 841 C<HARNESS_FILELEAK_IN_DIR> may give more predicatable results.
 842
 843 =item C<HARNESS_PERL_SWITCHES>
 844
 845 Its value will be prepended to the switches used to invoke perl on
 846 each test.  For example, setting C<HARNESS_PERL_SWITCHES> to "-W" will
 847 run all tests with all warnings enabled.
 848
 849 =item C<HARNESS_COLUMNS>
 850
 851 This value will be used for the width of the terminal. If it is not
 852 set then it will default to C<COLUMNS>. If this is not set, it will
 853 default to 80. Note that users of Bourne-sh based shells will need to
 854 C<export COLUMNS> for this module to use that variable.
 855
 856 =item C<HARNESS_ACTIVE>
 857
 858 Harness sets this before executing the individual tests.  This allows
 859 the tests to determine if they are being executed through the harness
 860 or by any other means.
 861
 862 =back
 863
 864
 865 =head1 SEE ALSO
 866
 867 L<Test> for writing test scripts, L<Benchmark> for the underlying
 868 timing routines and L<Devel::Coverage> for test coverage analysis.
 869
 870 =head1 AUTHORS
 871
 872 Either Tim Bunce or Andreas Koenig, we don't know. What we know for
 873 sure is, that it was inspired by Larry Wall's TEST script that came
 874 with perl distributions for ages. Numerous anonymous contributors
 875 exist.
 876
 877 Current maintainers are Andreas Koenig <andreas.koenig@anima.de> and
 878 Michael G Schwern <schwern@pobox.com>
 879
 880 =head1 BUGS
 881
 882 Test::Harness uses $^X to determine the perl binary to run the tests
 883 with. Test scripts running via the shebang (C<#!>) line may not be
 884 portable because $^X is not consistent for shebang scripts across
 885 platforms. This is no problem when Test::Harness is run with an
 886 absolute path to the perl binary or when $^X can be found in the path.
 887
 888 =cut