5 # $^C was only introduced in 5.005-ish. We do this to prevent
6 # use of uninitialized value warnings in older perls.
10 use vars qw($VERSION);
12 $VERSION = eval $VERSION; # make the alpha version come out as a number
14 # Make Test::Builder thread-safe for ithreads.
17 # Load threads::shared when threads are turned on
18 if( $] >= 5.008 && $Config{useithreads} && $INC{'threads.pm'}) {
19 require threads::shared;
21 # Hack around YET ANOTHER threads::shared bug. It would
22 # occassionally forget the contents of the variable when sharing it.
23 # So we first copy the data, then share, then put our copy back.
24 *share = sub (\[$@%]) {
28 if( $type eq 'HASH' ) {
31 elsif( $type eq 'ARRAY' ) {
34 elsif( $type eq 'SCALAR' ) {
38 die "Unknown type: ".$type;
41 $_[0] = &threads::shared::share($_[0]);
43 if( $type eq 'HASH' ) {
46 elsif( $type eq 'ARRAY' ) {
49 elsif( $type eq 'SCALAR' ) {
53 die "Unknown type: ".$type;
59 # 5.8.0's threads::shared is busted when threads are off.
62 *share = sub { return $_[0] };
70 Test::Builder - Backend for building test libraries
74 package My::Test::Module;
80 my $Test = Test::Builder->new;
81 $Test->output('my_logfile');
87 $Test->exported_to($pack);
90 $self->export_to_level(1, $self, 'ok');
94 my($test, $name) = @_;
96 $Test->ok($test, $name);
102 Test::Simple and Test::More have proven to be popular testing modules,
103 but they're not always flexible enough. Test::Builder provides the a
104 building block upon which to write your own test libraries I<which can
113 my $Test = Test::Builder->new;
115 Returns a Test::Builder object representing the current state of the
118 Since you only run one test per program, there is B<one and only one>
119 Test::Builder object. No matter how many times you call new(), you're
120 getting the same object. (This is called a singleton).
124 my $Test = Test::Builder->new;
127 $Test ||= bless ['Move along, nothing to see here'], $class;
135 Reinitializes the Test::Builder singleton to its original state.
136 Mostly useful for tests run in persistent environments where the same
137 test might be run multiple times in the same process.
144 my $Curr_Test; share($Curr_Test);
147 my @Test_Results; share(@Test_Results);
148 my @Test_Details; share(@Test_Details);
157 my($No_Header, $No_Ending);
173 $Exported_To = undef;
180 ($No_Header, $No_Ending) = (0,0);
182 $self->_dup_stdhandles unless $^C;
189 =head2 Setting up tests
191 These methods are for setting up tests and declaring how many there
192 are. You usually only want to call one of these methods.
198 my $pack = $Test->exported_to;
199 $Test->exported_to($pack);
201 Tells Test::Builder what package you exported your functions to.
202 This is important for getting TODO tests right.
207 my($self, $pack) = @_;
209 if( defined $pack ) {
210 $Exported_To = $pack;
217 $Test->plan('no_plan');
218 $Test->plan( skip_all => $reason );
219 $Test->plan( tests => $num_tests );
221 A convenient way to set up your tests. Call this and Test::Builder
222 will print the appropriate headers and take the appropriate actions.
224 If you call plan(), don't call any of the other methods below.
229 my($self, $cmd, $arg) = @_;
234 die sprintf "You tried to plan twice! Second plan at %s line %d\n",
235 ($self->caller)[1,2];
238 if( $cmd eq 'no_plan' ) {
241 elsif( $cmd eq 'skip_all' ) {
242 return $self->skip_all($arg);
244 elsif( $cmd eq 'tests' ) {
246 return $self->expected_tests($arg);
248 elsif( !defined $arg ) {
249 die "Got an undefined number of tests. Looks like you tried to ".
250 "say how many tests you plan to run but made a mistake.\n";
253 die "You said to run 0 tests! You've got to run something.\n";
258 my @args = grep { defined } ($cmd, $arg);
259 Carp::croak("plan() doesn't understand @args");
265 =item B<expected_tests>
267 my $max = $Test->expected_tests;
268 $Test->expected_tests($max);
270 Gets/sets the # of tests we expect this test to run and prints out
271 the appropriate headers.
280 die "Number of tests must be a postive integer. You gave it '$max'.\n"
281 unless $max =~ /^\+?\d+$/ and $max > 0;
283 $Expected_Tests = $max;
286 $self->_print("1..$max\n") unless $self->no_header;
288 return $Expected_Tests;
296 Declares that this test will run an indeterminate # of tests.
307 $plan = $Test->has_plan
309 Find out whether a plan has been defined. $plan is either C<undef> (no plan has been set), C<no_plan> (indeterminate # of tests) or an integer (the number of expected tests).
314 return($Expected_Tests) if $Expected_Tests;
315 return('no_plan') if $No_Plan;
323 $Test->skip_all($reason);
325 Skips all the tests, using the given $reason. Exits immediately with 0.
330 my($self, $reason) = @_;
333 $out .= " # Skip $reason" if $reason;
338 $self->_print($out) unless $self->no_header;
346 These actually run the tests, analogous to the functions in
349 $name is always optional.
355 $Test->ok($test, $name);
357 Your basic test. Pass if $test is true, fail if $test is false. Just
358 like Test::Simple's ok().
363 my($self, $test, $name) = @_;
365 # $test might contain an object which we don't want to accidentally
366 # store, so we turn it into a boolean.
367 $test = $test ? 1 : 0;
369 unless( $Have_Plan ) {
371 Carp::croak("You tried to run a test without a plan! Gotta have a plan.");
377 # In case $name is a string overloaded object, force it to stringify.
378 $self->_unoverload(\$name);
380 $self->diag(<<ERR) if defined $name and $name =~ /^[\d\s]+$/;
381 You named your test '$name'. You shouldn't use numbers for your test names.
385 my($pack, $file, $line) = $self->caller;
387 my $todo = $self->todo($pack);
388 $self->_unoverload(\$todo);
391 my $result = &share({});
395 @$result{ 'ok', 'actual_ok' } = ( ( $todo ? 1 : 0 ), 0 );
398 @$result{ 'ok', 'actual_ok' } = ( 1, $test );
402 $out .= " $Curr_Test" if $self->use_numbers;
404 if( defined $name ) {
405 $name =~ s|#|\\#|g; # # in a name can confuse Test::Harness.
407 $result->{name} = $name;
410 $result->{name} = '';
414 $out .= " # TODO $todo";
415 $result->{reason} = $todo;
416 $result->{type} = 'todo';
419 $result->{reason} = '';
420 $result->{type} = '';
423 $Test_Results[$Curr_Test-1] = $result;
429 my $msg = $todo ? "Failed (TODO)" : "Failed";
430 $self->_print_diag("\n") if $ENV{HARNESS_ACTIVE};
431 $self->diag(" $msg test ($file at line $line)\n");
434 return $test ? 1 : 0;
443 eval { require overload } || return;
445 foreach my $thing (@_) {
447 if( defined $$thing ) {
448 if( my $string_meth = overload::Method($$thing, '""') ) {
449 $$thing = $$thing->$string_meth();
459 $Test->is_eq($got, $expected, $name);
461 Like Test::More's is(). Checks if $got eq $expected. This is the
466 $Test->is_num($got, $expected, $name);
468 Like Test::More's is(). Checks if $got == $expected. This is the
474 my($self, $got, $expect, $name) = @_;
475 local $Level = $Level + 1;
477 if( !defined $got || !defined $expect ) {
478 # undef only matches undef and nothing else
479 my $test = !defined $got && !defined $expect;
481 $self->ok($test, $name);
482 $self->_is_diag($got, 'eq', $expect) unless $test;
486 return $self->cmp_ok($got, 'eq', $expect, $name);
490 my($self, $got, $expect, $name) = @_;
491 local $Level = $Level + 1;
493 if( !defined $got || !defined $expect ) {
494 # undef only matches undef and nothing else
495 my $test = !defined $got && !defined $expect;
497 $self->ok($test, $name);
498 $self->_is_diag($got, '==', $expect) unless $test;
502 return $self->cmp_ok($got, '==', $expect, $name);
506 my($self, $got, $type, $expect) = @_;
508 foreach my $val (\$got, \$expect) {
509 if( defined $$val ) {
510 if( $type eq 'eq' ) {
511 # quote and force string context
515 # force numeric context
524 return $self->diag(sprintf <<DIAGNOSTIC, $got, $expect);
533 $Test->isnt_eq($got, $dont_expect, $name);
535 Like Test::More's isnt(). Checks if $got ne $dont_expect. This is
540 $Test->is_num($got, $dont_expect, $name);
542 Like Test::More's isnt(). Checks if $got ne $dont_expect. This is
548 my($self, $got, $dont_expect, $name) = @_;
549 local $Level = $Level + 1;
551 if( !defined $got || !defined $dont_expect ) {
552 # undef only matches undef and nothing else
553 my $test = defined $got || defined $dont_expect;
555 $self->ok($test, $name);
556 $self->_cmp_diag($got, 'ne', $dont_expect) unless $test;
560 return $self->cmp_ok($got, 'ne', $dont_expect, $name);
564 my($self, $got, $dont_expect, $name) = @_;
565 local $Level = $Level + 1;
567 if( !defined $got || !defined $dont_expect ) {
568 # undef only matches undef and nothing else
569 my $test = defined $got || defined $dont_expect;
571 $self->ok($test, $name);
572 $self->_cmp_diag($got, '!=', $dont_expect) unless $test;
576 return $self->cmp_ok($got, '!=', $dont_expect, $name);
582 $Test->like($this, qr/$regex/, $name);
583 $Test->like($this, '/$regex/', $name);
585 Like Test::More's like(). Checks if $this matches the given $regex.
587 You'll want to avoid qr// if you want your tests to work before 5.005.
591 $Test->unlike($this, qr/$regex/, $name);
592 $Test->unlike($this, '/$regex/', $name);
594 Like Test::More's unlike(). Checks if $this B<does not match> the
600 my($self, $this, $regex, $name) = @_;
602 local $Level = $Level + 1;
603 $self->_regex_ok($this, $regex, '=~', $name);
607 my($self, $this, $regex, $name) = @_;
609 local $Level = $Level + 1;
610 $self->_regex_ok($this, $regex, '!~', $name);
615 $Test->maybe_regex(qr/$regex/);
616 $Test->maybe_regex('/$regex/');
618 Convenience method for building testing functions that take regular
619 expressions as arguments, but need to work before perl 5.005.
621 Takes a quoted regular expression produced by qr//, or a string
622 representing a regular expression.
624 Returns a Perl value which may be used instead of the corresponding
625 regular expression, or undef if it's argument is not recognised.
627 For example, a version of like(), sans the useful diagnostic messages,
631 my ($self, $this, $regex, $name) = @_;
632 my $usable_regex = $self->maybe_regex($regex);
633 die "expecting regex, found '$regex'\n"
634 unless $usable_regex;
635 $self->ok($this =~ m/$usable_regex/, $name);
642 my ($self, $regex) = @_;
643 my $usable_regex = undef;
644 if( ref $regex eq 'Regexp' ) {
645 $usable_regex = $regex;
647 # Check if it looks like '/foo/'
648 elsif( my($re, $opts) = $regex =~ m{^ /(.*)/ (\w*) $ }sx ) {
649 $usable_regex = length $opts ? "(?$opts)$re" : $re;
651 return($usable_regex)
655 my($self, $this, $regex, $cmp, $name) = @_;
657 local $Level = $Level + 1;
660 my $usable_regex = $self->maybe_regex($regex);
661 unless (defined $usable_regex) {
662 $ok = $self->ok( 0, $name );
663 $self->diag(" '$regex' doesn't look much like a regex to me.");
669 my $test = $this =~ /$usable_regex/ ? 1 : 0;
670 $test = !$test if $cmp eq '!~';
671 $ok = $self->ok( $test, $name );
675 $this = defined $this ? "'$this'" : 'undef';
676 my $match = $cmp eq '=~' ? "doesn't match" : "matches";
677 $self->diag(sprintf <<DIAGNOSTIC, $this, $match, $regex);
689 $Test->cmp_ok($this, $type, $that, $name);
691 Works just like Test::More's cmp_ok().
693 $Test->cmp_ok($big_num, '!=', $other_big_num);
698 my($self, $got, $type, $expect, $name) = @_;
703 local($@,$!); # don't interfere with $@
704 # eval() sometimes resets $!
705 $test = eval "\$got $type \$expect";
707 local $Level = $Level + 1;
708 my $ok = $self->ok($test, $name);
711 if( $type =~ /^(eq|==)$/ ) {
712 $self->_is_diag($got, $type, $expect);
715 $self->_cmp_diag($got, $type, $expect);
722 my($self, $got, $type, $expect) = @_;
724 $got = defined $got ? "'$got'" : 'undef';
725 $expect = defined $expect ? "'$expect'" : 'undef';
726 return $self->diag(sprintf <<DIAGNOSTIC, $got, $type, $expect);
735 $Test->BAILOUT($reason);
737 Indicates to the Test::Harness that things are going so badly all
738 testing should terminate. This includes running any additional test
741 It will exit with 255.
746 my($self, $reason) = @_;
748 $self->_print("Bail out! $reason");
757 Skips the current test, reporting $why.
762 my($self, $why) = @_;
764 $self->_unoverload(\$why);
766 unless( $Have_Plan ) {
768 Carp::croak("You tried to run tests without a plan! Gotta have a plan.");
774 $Test_Results[$Curr_Test-1] = &share({
783 $out .= " $Curr_Test" if $self->use_numbers;
784 $out .= " # skip $why\n";
795 $Test->todo_skip($why);
797 Like skip(), only it will declare the test as failing and TODO. Similar
800 print "not ok $tnum # TODO $why\n";
805 my($self, $why) = @_;
808 unless( $Have_Plan ) {
810 Carp::croak("You tried to run tests without a plan! Gotta have a plan.");
816 $Test_Results[$Curr_Test-1] = &share({
825 $out .= " $Curr_Test" if $self->use_numbers;
826 $out .= " # TODO & SKIP $why\n";
834 =begin _unimplemented
839 $Test->skip_rest($reason);
841 Like skip(), only it skips all the rest of the tests you plan to run
842 and terminates the test.
844 If you're running under no_plan, it skips once and terminates the
858 $Test->level($how_high);
860 How far up the call stack should $Test look when reporting where the
865 Setting $Test::Builder::Level overrides. This is typically useful
869 local $Test::Builder::Level = 2;
876 my($self, $level) = @_;
878 if( defined $level ) {
887 $Test->use_numbers($on_or_off);
889 Whether or not the test should output numbers. That is, this if true:
901 Most useful when you can't depend on the test output order, such as
902 when threads or forking is involved.
904 Test::Harness will accept either, but avoid mixing the two styles.
911 my($self, $use_nums) = @_;
913 if( defined $use_nums ) {
914 $Use_Nums = $use_nums;
921 $Test->no_header($no_header);
923 If set to true, no "1..N" header will be printed.
927 $Test->no_ending($no_ending);
929 Normally, Test::Builder does some extra diagnostics when the test
930 ends. It also changes the exit code as described below.
932 If this is true, none of that will be done.
937 my($self, $no_header) = @_;
939 if( defined $no_header ) {
940 $No_Header = $no_header;
946 my($self, $no_ending) = @_;
948 if( defined $no_ending ) {
949 $No_Ending = $no_ending;
959 Controlling where the test output goes.
961 It's ok for your test to change where STDOUT and STDERR point to,
962 Test::Builder's default output settings will not be affected.
970 Prints out the given @msgs. Like C<print>, arguments are simply
973 Normally, it uses the failure_output() handle, but if this is for a
974 TODO test, the todo_output() handle is used.
976 Output will be indented and marked with a # so as not to interfere
977 with test output. A newline will be put on the end if there isn't one
980 We encourage using this rather than calling print directly.
982 Returns false. Why? Because diag() is often used in conjunction with
983 a failing test (C<ok() || diag()>) it "passes through" the failure.
985 return ok(...) || diag(...);
988 Mark Fowler <mark@twoshortplanks.com>
993 my($self, @msgs) = @_;
996 # Prevent printing headers when compiling (i.e. -c)
999 # Smash args together like print does.
1000 # Convert undef to 'undef' so its readable.
1001 my $msg = join '', map { defined($_) ? $_ : 'undef' } @msgs;
1003 # Escape each line with a #.
1006 # Stick a newline on the end if it needs it.
1007 $msg .= "\n" unless $msg =~ /\n\Z/;
1009 local $Level = $Level + 1;
1010 $self->_print_diag($msg);
1019 $Test->_print(@msgs);
1021 Prints to the output() filehandle.
1028 my($self, @msgs) = @_;
1030 # Prevent printing headers when only compiling. Mostly for when
1031 # tests are deparsed with B::Deparse
1034 my $msg = join '', @msgs;
1036 local($\, $", $,) = (undef, ' ', '');
1037 my $fh = $self->output;
1039 # Escape each line after the first with a # so we don't
1040 # confuse Test::Harness.
1041 $msg =~ s/\n(.)/\n# $1/sg;
1043 # Stick a newline on the end if it needs it.
1044 $msg .= "\n" unless $msg =~ /\n\Z/;
1050 =item B<_print_diag>
1052 $Test->_print_diag(@msg);
1054 Like _print, but prints to the current diagnostic filehandle.
1061 local($\, $", $,) = (undef, ' ', '');
1062 my $fh = $self->todo ? $self->todo_output : $self->failure_output;
1069 $Test->output($file);
1071 Where normal "ok/not ok" test output should go.
1075 =item B<failure_output>
1077 $Test->failure_output($fh);
1078 $Test->failure_output($file);
1080 Where diagnostic output on test failures and diag() should go.
1084 =item B<todo_output>
1086 $Test->todo_output($fh);
1087 $Test->todo_output($file);
1089 Where diagnostics about todo test failures and diag() should go.
1095 my($Out_FH, $Fail_FH, $Todo_FH);
1097 my($self, $fh) = @_;
1100 $Out_FH = _new_fh($fh);
1105 sub failure_output {
1106 my($self, $fh) = @_;
1109 $Fail_FH = _new_fh($fh);
1115 my($self, $fh) = @_;
1118 $Todo_FH = _new_fh($fh);
1124 my($file_or_fh) = shift;
1127 unless( UNIVERSAL::isa($file_or_fh, 'GLOB') ) {
1128 $fh = do { local *FH };
1129 open $fh, ">$file_or_fh" or
1130 die "Can't open test output log $file_or_fh: $!";
1141 my $old_fh = select $fh;
1147 my $Opened_Testhandles = 0;
1148 sub _dup_stdhandles {
1151 $self->_open_testhandles unless $Opened_Testhandles;
1153 # Set everything to unbuffered else plain prints to STDOUT will
1154 # come out in the wrong order from our own prints.
1155 _autoflush(\*TESTOUT);
1156 _autoflush(\*STDOUT);
1157 _autoflush(\*TESTERR);
1158 _autoflush(\*STDERR);
1160 $Test->output(\*TESTOUT);
1161 $Test->failure_output(\*TESTERR);
1162 $Test->todo_output(\*TESTOUT);
1165 sub _open_testhandles {
1166 # We dup STDOUT and STDERR so people can change them in their
1167 # test suites while still getting normal test output.
1168 open(TESTOUT, ">&STDOUT") or die "Can't dup STDOUT: $!";
1169 open(TESTERR, ">&STDERR") or die "Can't dup STDERR: $!";
1170 $Opened_Testhandles = 1;
1177 =head2 Test Status and Info
1181 =item B<current_test>
1183 my $curr_test = $Test->current_test;
1184 $Test->current_test($num);
1186 Gets/sets the current test # we're on.
1188 You usually shouldn't have to set this.
1193 my($self, $num) = @_;
1196 if( defined $num ) {
1197 unless( $Have_Plan ) {
1199 Carp::croak("Can't change the current test number without a plan!");
1203 if( $num > @Test_Results ) {
1204 my $start = @Test_Results ? $#Test_Results + 1 : 0;
1205 for ($start..$num-1) {
1206 $Test_Results[$_] = &share({
1209 reason => 'incrementing test number',
1222 my @tests = $Test->summary;
1224 A simple summary of the tests so far. True for pass, false for fail.
1225 This is a logical pass/fail, so todos are passes.
1227 Of course, test #1 is $tests[0], etc...
1234 return map { $_->{'ok'} } @Test_Results;
1239 my @tests = $Test->details;
1241 Like summary(), but with a lot more detail.
1243 $tests[$test_num - 1] =
1244 { 'ok' => is the test considered a pass?
1245 actual_ok => did it literally say 'ok'?
1246 name => name of the test (if any)
1247 type => type of test (if any, see below).
1248 reason => reason for the above (if any)
1251 'ok' is true if Test::Harness will consider the test to be a pass.
1253 'actual_ok' is a reflection of whether or not the test literally
1254 printed 'ok' or 'not ok'. This is for examining the result of 'todo'
1257 'name' is the name of the test.
1259 'type' indicates if it was a special test. Normal tests have a type
1260 of ''. Type can be one of the following:
1264 todo_skip see todo_skip()
1267 Sometimes the Test::Builder test counter is incremented without it
1268 printing any test output, for example, when current_test() is changed.
1269 In these cases, Test::Builder doesn't know the result of the test, so
1270 it's type is 'unkown'. These details for these tests are filled in.
1271 They are considered ok, but the name and actual_ok is left undef.
1273 For example "not ok 23 - hole count # TODO insufficient donuts" would
1274 result in this structure:
1276 $tests[22] = # 23 - 1, since arrays start from 0.
1277 { ok => 1, # logically, the test passed since it's todo
1278 actual_ok => 0, # in absolute terms, it failed
1279 name => 'hole count',
1281 reason => 'insufficient donuts'
1287 return @Test_Results;
1292 my $todo_reason = $Test->todo;
1293 my $todo_reason = $Test->todo($pack);
1295 todo() looks for a $TODO variable in your tests. If set, all tests
1296 will be considered 'todo' (see Test::More and Test::Harness for
1297 details). Returns the reason (ie. the value of $TODO) if running as
1298 todo tests, false otherwise.
1300 todo() is pretty part about finding the right package to look for
1301 $TODO in. It uses the exported_to() package to find it. If that's
1302 not set, it's pretty good at guessing the right package to look at.
1304 Sometimes there is some confusion about where todo() should be looking
1305 for the $TODO variable. If you want to be sure, tell it explicitly
1311 my($self, $pack) = @_;
1313 $pack = $pack || $self->exported_to || $self->caller(1);
1316 return defined ${$pack.'::TODO'} ? ${$pack.'::TODO'}
1322 my $package = $Test->caller;
1323 my($pack, $file, $line) = $Test->caller;
1324 my($pack, $file, $line) = $Test->caller($height);
1326 Like the normal caller(), except it reports according to your level().
1331 my($self, $height) = @_;
1334 my @caller = CORE::caller($self->level + $height + 1);
1335 return wantarray ? @caller : $caller[0];
1346 =item B<_sanity_check>
1350 Runs a bunch of end of test sanity checks to make sure reality came
1351 through ok. If anything is wrong it will die with a fairly friendly
1358 _whoa($Curr_Test < 0, 'Says here you ran a negative number of tests!');
1359 _whoa(!$Have_Plan and $Curr_Test,
1360 'Somehow your tests ran without a plan!');
1361 _whoa($Curr_Test != @Test_Results,
1362 'Somehow you got a different number of results than tests ran!');
1367 _whoa($check, $description);
1369 A sanity check, similar to assert(). If the $check is true, something
1370 has gone horribly wrong. It will die with the given $description and
1371 a note to contact the author.
1376 my($check, $desc) = @_;
1380 This should never happen! Please contact the author immediately!
1387 _my_exit($exit_num);
1389 Perl seems to have some trouble with exiting inside an END block. 5.005_03
1390 and 5.6.1 both seem to do odd things. Instead, this function edits $?
1391 directly. It should ONLY be called from inside an END block. It
1392 doesn't actually exit, that's your job.
1409 $SIG{__DIE__} = sub {
1410 # We don't want to muck with death in an eval, but $^S isn't
1411 # totally reliable. 5.005_03 and 5.6.1 both do the wrong thing
1412 # with it. Instead, we use caller. This also means it runs under
1415 for( my $stack = 1; my $sub = (CORE::caller($stack))[3]; $stack++ ) {
1416 $in_eval = 1 if $sub =~ /^\(eval\)/;
1418 $Test_Died = 1 unless $in_eval;
1426 # Don't bother with an ending if this is a forked copy. Only the parent
1427 # should do the ending.
1428 do{ _my_exit($?) && return } if $Original_Pid != $$;
1430 # Bailout if plan() was never called. This is so
1431 # "require Test::Simple" doesn't puke.
1432 do{ _my_exit(0) && return } if !$Have_Plan && !$Test_Died;
1434 # Figure out if we passed or failed and print helpful messages.
1435 if( @Test_Results ) {
1436 # The plan? We have no plan.
1438 $self->_print("1..$Curr_Test\n") unless $self->no_header;
1439 $Expected_Tests = $Curr_Test;
1442 # Auto-extended arrays and elements which aren't explicitly
1443 # filled in with a shared reference will puke under 5.8.0
1444 # ithreads. So we have to fill them in by hand. :(
1445 my $empty_result = &share({});
1446 for my $idx ( 0..$Expected_Tests-1 ) {
1447 $Test_Results[$idx] = $empty_result
1448 unless defined $Test_Results[$idx];
1451 my $num_failed = grep !$_->{'ok'}, @Test_Results[0..$Expected_Tests-1];
1452 $num_failed += abs($Expected_Tests - @Test_Results);
1454 if( $Curr_Test < $Expected_Tests ) {
1455 my $s = $Expected_Tests == 1 ? '' : 's';
1456 $self->diag(<<"FAIL");
1457 Looks like you planned $Expected_Tests test$s but only ran $Curr_Test.
1460 elsif( $Curr_Test > $Expected_Tests ) {
1461 my $num_extra = $Curr_Test - $Expected_Tests;
1462 my $s = $Expected_Tests == 1 ? '' : 's';
1463 $self->diag(<<"FAIL");
1464 Looks like you planned $Expected_Tests test$s but ran $num_extra extra.
1467 elsif ( $num_failed ) {
1468 my $s = $num_failed == 1 ? '' : 's';
1469 $self->diag(<<"FAIL");
1470 Looks like you failed $num_failed test$s of $Expected_Tests.
1475 $self->diag(<<"FAIL");
1476 Looks like your test died just after $Curr_Test.
1479 _my_exit( 255 ) && return;
1482 _my_exit( $num_failed <= 254 ? $num_failed : 254 ) && return;
1484 elsif ( $Skip_All ) {
1485 _my_exit( 0 ) && return;
1487 elsif ( $Test_Died ) {
1488 $self->diag(<<'FAIL');
1489 Looks like your test died before it could output anything.
1491 _my_exit( 255 ) && return;
1494 $self->diag("No tests run!\n");
1495 _my_exit( 255 ) && return;
1500 $Test->_ending if defined $Test and !$Test->no_ending;
1505 If all your tests passed, Test::Builder will exit with zero (which is
1506 normal). If anything failed it will exit with how many failed. If
1507 you run less (or more) tests than you planned, the missing (or extras)
1508 will be considered failures. If no tests were ever run Test::Builder
1509 will throw a warning and exit with 255. If the test died, even after
1510 having successfully completed all its tests, it will still be
1511 considered a failure and will exit with 255.
1513 So the exit codes are...
1515 0 all tests successful
1517 any other number how many failed (including missing or extras)
1519 If you fail more than 254 tests, it will be reported as 254.
1524 In perl 5.8.0 and later, Test::Builder is thread-safe. The test
1525 number is shared amongst all threads. This means if one thread sets
1526 the test number using current_test() they will all be effected.
1528 Test::Builder is only thread-aware if threads.pm is loaded I<before>
1533 CPAN can provide the best examples. Test::Simple, Test::More,
1534 Test::Exception and Test::Differences all use Test::Builder.
1538 Test::Simple, Test::More, Test::Harness
1542 Original code by chromatic, maintained by Michael G Schwern
1543 E<lt>schwern@pobox.comE<gt>
1547 Copyright 2002, 2004 by chromatic E<lt>chromatic@wgz.orgE<gt> and
1548 Michael G Schwern E<lt>schwern@pobox.comE<gt>.
1550 This program is free software; you can redistribute it and/or
1551 modify it under the same terms as Perl itself.
1553 See F<http://www.perl.com/perl/misc/Artistic.html>