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