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