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);
13 my $IsVMS = $^O eq 'VMS';
15 # Make Test::Builder thread-safe for ithreads.
18 # Load threads::shared when threads are turned on
19 if( $] >= 5.008 && $Config{useithreads} && $INC{'threads.pm'}) {
20 require threads::shared;
21 threads::shared->import;
23 # 5.8.0's threads::shared is busted when threads are off.
26 *share = sub { return $_[0] };
34 Test::Builder - Backend for building test libraries
38 package My::Test::Module;
44 my $Test = Test::Builder->new;
45 $Test->output('my_logfile');
51 $Test->exported_to($pack);
54 $self->export_to_level(1, $self, 'ok');
58 my($test, $name) = @_;
60 $Test->ok($test, $name);
66 Test::Simple and Test::More have proven to be popular testing modules,
67 but they're not always flexible enough. Test::Builder provides the a
68 building block upon which to write your own test libraries I<which can
77 my $Test = Test::Builder->new;
79 Returns a Test::Builder object representing the current state of the
82 Since you only run one test per program, there is B<one and only one>
83 Test::Builder object. No matter how many times you call new(), you're
84 getting the same object. (This is called a singleton).
88 my $Test = Test::Builder->new;
91 $Test ||= bless ['Move along, nothing to see here'], $class;
99 Reinitializes the Test::Builder singleton to its original state.
100 Mostly useful for tests run in persistent environments where the same
101 test might be run multiple times in the same process.
108 my $Curr_Test; share($Curr_Test);
111 my @Test_Results; share(@Test_Results);
112 my @Test_Details; share(@Test_Details);
121 my($No_Header, $No_Ending);
137 $Exported_To = undef;
144 ($No_Header, $No_Ending) = (0,0);
146 $self->_dup_stdhandles unless $^C;
153 =head2 Setting up tests
155 These methods are for setting up tests and declaring how many there
156 are. You usually only want to call one of these methods.
162 my $pack = $Test->exported_to;
163 $Test->exported_to($pack);
165 Tells Test::Builder what package you exported your functions to.
166 This is important for getting TODO tests right.
171 my($self, $pack) = @_;
173 if( defined $pack ) {
174 $Exported_To = $pack;
181 $Test->plan('no_plan');
182 $Test->plan( skip_all => $reason );
183 $Test->plan( tests => $num_tests );
185 A convenient way to set up your tests. Call this and Test::Builder
186 will print the appropriate headers and take the appropriate actions.
188 If you call plan(), don't call any of the other methods below.
193 my($self, $cmd, $arg) = @_;
198 die sprintf "You tried to plan twice! Second plan at %s line %d\n",
199 ($self->caller)[1,2];
202 if( $cmd eq 'no_plan' ) {
205 elsif( $cmd eq 'skip_all' ) {
206 return $self->skip_all($arg);
208 elsif( $cmd eq 'tests' ) {
210 return $self->expected_tests($arg);
212 elsif( !defined $arg ) {
213 die "Got an undefined number of tests. Looks like you tried to ".
214 "say how many tests you plan to run but made a mistake.\n";
217 die "You said to run 0 tests! You've got to run something.\n";
222 my @args = grep { defined } ($cmd, $arg);
223 Carp::croak("plan() doesn't understand @args");
229 =item B<expected_tests>
231 my $max = $Test->expected_tests;
232 $Test->expected_tests($max);
234 Gets/sets the # of tests we expect this test to run and prints out
235 the appropriate headers.
240 my($self, $max) = @_;
243 $Expected_Tests = $max;
246 $self->_print("1..$max\n") unless $self->no_header;
248 return $Expected_Tests;
256 Declares that this test will run an indeterminate # of tests.
267 $plan = $Test->has_plan
269 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).
274 return($Expected_Tests) if $Expected_Tests;
275 return('no_plan') if $No_Plan;
283 $Test->skip_all($reason);
285 Skips all the tests, using the given $reason. Exits immediately with 0.
290 my($self, $reason) = @_;
293 $out .= " # Skip $reason" if $reason;
298 $self->_print($out) unless $self->no_header;
306 These actually run the tests, analogous to the functions in
309 $name is always optional.
315 $Test->ok($test, $name);
317 Your basic test. Pass if $test is true, fail if $test is false. Just
318 like Test::Simple's ok().
323 my($self, $test, $name) = @_;
325 # $test might contain an object which we don't want to accidentally
326 # store, so we turn it into a boolean.
327 $test = $test ? 1 : 0;
329 unless( $Have_Plan ) {
331 Carp::croak("You tried to run a test without a plan! Gotta have a plan.");
337 # In case $name is a string overloaded object, force it to stringify.
340 if( defined $name ) {
342 if( my $string_meth = overload::Method($name, '""') ) {
343 $name = $name->$string_meth();
348 $self->diag(<<ERR) if defined $name and $name =~ /^[\d\s]+$/;
349 You named your test '$name'. You shouldn't use numbers for your test names.
353 my($pack, $file, $line) = $self->caller;
355 my $todo = $self->todo($pack);
358 my $result = &share({});
362 @$result{ 'ok', 'actual_ok' } = ( ( $todo ? 1 : 0 ), 0 );
365 @$result{ 'ok', 'actual_ok' } = ( 1, $test );
369 $out .= " $Curr_Test" if $self->use_numbers;
371 if( defined $name ) {
372 $name =~ s|#|\\#|g; # # in a name can confuse Test::Harness.
374 $result->{name} = "$name";
377 $result->{name} = '';
381 my $what_todo = $todo;
382 $out .= " # TODO $what_todo";
383 $result->{reason} = "$what_todo";
384 $result->{type} = 'todo';
387 $result->{reason} = '';
388 $result->{type} = '';
391 $Test_Results[$Curr_Test-1] = $result;
397 my $msg = $todo ? "Failed (TODO)" : "Failed";
398 $self->_print_diag("\n") if $ENV{HARNESS_ACTIVE};
399 $self->diag(" $msg test ($file at line $line)\n");
402 return $test ? 1 : 0;
407 $Test->is_eq($got, $expected, $name);
409 Like Test::More's is(). Checks if $got eq $expected. This is the
414 $Test->is_num($got, $expected, $name);
416 Like Test::More's is(). Checks if $got == $expected. This is the
422 my($self, $got, $expect, $name) = @_;
423 local $Level = $Level + 1;
425 if( !defined $got || !defined $expect ) {
426 # undef only matches undef and nothing else
427 my $test = !defined $got && !defined $expect;
429 $self->ok($test, $name);
430 $self->_is_diag($got, 'eq', $expect) unless $test;
434 return $self->cmp_ok($got, 'eq', $expect, $name);
438 my($self, $got, $expect, $name) = @_;
439 local $Level = $Level + 1;
441 if( !defined $got || !defined $expect ) {
442 # undef only matches undef and nothing else
443 my $test = !defined $got && !defined $expect;
445 $self->ok($test, $name);
446 $self->_is_diag($got, '==', $expect) unless $test;
450 return $self->cmp_ok($got, '==', $expect, $name);
454 my($self, $got, $type, $expect) = @_;
456 foreach my $val (\$got, \$expect) {
457 if( defined $$val ) {
458 if( $type eq 'eq' ) {
459 # quote and force string context
463 # force numeric context
472 return $self->diag(sprintf <<DIAGNOSTIC, $got, $expect);
481 $Test->isnt_eq($got, $dont_expect, $name);
483 Like Test::More's isnt(). Checks if $got ne $dont_expect. This is
488 $Test->is_num($got, $dont_expect, $name);
490 Like Test::More's isnt(). Checks if $got ne $dont_expect. This is
496 my($self, $got, $dont_expect, $name) = @_;
497 local $Level = $Level + 1;
499 if( !defined $got || !defined $dont_expect ) {
500 # undef only matches undef and nothing else
501 my $test = defined $got || defined $dont_expect;
503 $self->ok($test, $name);
504 $self->_cmp_diag($got, 'ne', $dont_expect) unless $test;
508 return $self->cmp_ok($got, 'ne', $dont_expect, $name);
512 my($self, $got, $dont_expect, $name) = @_;
513 local $Level = $Level + 1;
515 if( !defined $got || !defined $dont_expect ) {
516 # undef only matches undef and nothing else
517 my $test = defined $got || defined $dont_expect;
519 $self->ok($test, $name);
520 $self->_cmp_diag($got, '!=', $dont_expect) unless $test;
524 return $self->cmp_ok($got, '!=', $dont_expect, $name);
530 $Test->like($this, qr/$regex/, $name);
531 $Test->like($this, '/$regex/', $name);
533 Like Test::More's like(). Checks if $this matches the given $regex.
535 You'll want to avoid qr// if you want your tests to work before 5.005.
539 $Test->unlike($this, qr/$regex/, $name);
540 $Test->unlike($this, '/$regex/', $name);
542 Like Test::More's unlike(). Checks if $this B<does not match> the
548 my($self, $this, $regex, $name) = @_;
550 local $Level = $Level + 1;
551 $self->_regex_ok($this, $regex, '=~', $name);
555 my($self, $this, $regex, $name) = @_;
557 local $Level = $Level + 1;
558 $self->_regex_ok($this, $regex, '!~', $name);
563 $Test->maybe_regex(qr/$regex/);
564 $Test->maybe_regex('/$regex/');
566 Convenience method for building testing functions that take regular
567 expressions as arguments, but need to work before perl 5.005.
569 Takes a quoted regular expression produced by qr//, or a string
570 representing a regular expression.
572 Returns a Perl value which may be used instead of the corresponding
573 regular expression, or undef if it's argument is not recognised.
575 For example, a version of like(), sans the useful diagnostic messages,
579 my ($self, $this, $regex, $name) = @_;
580 my $usable_regex = $self->maybe_regex($regex);
581 die "expecting regex, found '$regex'\n"
582 unless $usable_regex;
583 $self->ok($this =~ m/$usable_regex/, $name);
590 my ($self, $regex) = @_;
591 my $usable_regex = undef;
592 if( ref $regex eq 'Regexp' ) {
593 $usable_regex = $regex;
595 # Check if it looks like '/foo/'
596 elsif( my($re, $opts) = $regex =~ m{^ /(.*)/ (\w*) $ }sx ) {
597 $usable_regex = length $opts ? "(?$opts)$re" : $re;
599 return($usable_regex)
603 my($self, $this, $regex, $cmp, $name) = @_;
605 local $Level = $Level + 1;
608 my $usable_regex = $self->maybe_regex($regex);
609 unless (defined $usable_regex) {
610 $ok = $self->ok( 0, $name );
611 $self->diag(" '$regex' doesn't look much like a regex to me.");
617 my $test = $this =~ /$usable_regex/ ? 1 : 0;
618 $test = !$test if $cmp eq '!~';
619 $ok = $self->ok( $test, $name );
623 $this = defined $this ? "'$this'" : 'undef';
624 my $match = $cmp eq '=~' ? "doesn't match" : "matches";
625 $self->diag(sprintf <<DIAGNOSTIC, $this, $match, $regex);
637 $Test->cmp_ok($this, $type, $that, $name);
639 Works just like Test::More's cmp_ok().
641 $Test->cmp_ok($big_num, '!=', $other_big_num);
646 my($self, $got, $type, $expect, $name) = @_;
651 local($@,$!); # don't interfere with $@
652 # eval() sometimes resets $!
653 $test = eval "\$got $type \$expect";
655 local $Level = $Level + 1;
656 my $ok = $self->ok($test, $name);
659 if( $type =~ /^(eq|==)$/ ) {
660 $self->_is_diag($got, $type, $expect);
663 $self->_cmp_diag($got, $type, $expect);
670 my($self, $got, $type, $expect) = @_;
672 $got = defined $got ? "'$got'" : 'undef';
673 $expect = defined $expect ? "'$expect'" : 'undef';
674 return $self->diag(sprintf <<DIAGNOSTIC, $got, $type, $expect);
683 $Test->BAILOUT($reason);
685 Indicates to the Test::Harness that things are going so badly all
686 testing should terminate. This includes running any additional test
689 It will exit with 255.
694 my($self, $reason) = @_;
696 $self->_print("Bail out! $reason");
705 Skips the current test, reporting $why.
710 my($self, $why) = @_;
713 unless( $Have_Plan ) {
715 Carp::croak("You tried to run tests without a plan! Gotta have a plan.");
721 $Test_Results[$Curr_Test-1] = &share({
730 $out .= " $Curr_Test" if $self->use_numbers;
731 $out .= " # skip $why\n";
742 $Test->todo_skip($why);
744 Like skip(), only it will declare the test as failing and TODO. Similar
747 print "not ok $tnum # TODO $why\n";
752 my($self, $why) = @_;
755 unless( $Have_Plan ) {
757 Carp::croak("You tried to run tests without a plan! Gotta have a plan.");
763 $Test_Results[$Curr_Test-1] = &share({
772 $out .= " $Curr_Test" if $self->use_numbers;
773 $out .= " # TODO & SKIP $why\n";
781 =begin _unimplemented
786 $Test->skip_rest($reason);
788 Like skip(), only it skips all the rest of the tests you plan to run
789 and terminates the test.
791 If you're running under no_plan, it skips once and terminates the
805 $Test->level($how_high);
807 How far up the call stack should $Test look when reporting where the
812 Setting $Test::Builder::Level overrides. This is typically useful
816 local $Test::Builder::Level = 2;
823 my($self, $level) = @_;
825 if( defined $level ) {
834 $Test->use_numbers($on_or_off);
836 Whether or not the test should output numbers. That is, this if true:
848 Most useful when you can't depend on the test output order, such as
849 when threads or forking is involved.
851 Test::Harness will accept either, but avoid mixing the two styles.
858 my($self, $use_nums) = @_;
860 if( defined $use_nums ) {
861 $Use_Nums = $use_nums;
868 $Test->no_header($no_header);
870 If set to true, no "1..N" header will be printed.
874 $Test->no_ending($no_ending);
876 Normally, Test::Builder does some extra diagnostics when the test
877 ends. It also changes the exit code as described below.
879 If this is true, none of that will be done.
884 my($self, $no_header) = @_;
886 if( defined $no_header ) {
887 $No_Header = $no_header;
893 my($self, $no_ending) = @_;
895 if( defined $no_ending ) {
896 $No_Ending = $no_ending;
906 Controlling where the test output goes.
908 It's ok for your test to change where STDOUT and STDERR point to,
909 Test::Builder's default output settings will not be affected.
917 Prints out the given $message. Normally, it uses the failure_output()
918 handle, but if this is for a TODO test, the todo_output() handle is
921 Output will be indented and marked with a # so as not to interfere
922 with test output. A newline will be put on the end if there isn't one
925 We encourage using this rather than calling print directly.
927 Returns false. Why? Because diag() is often used in conjunction with
928 a failing test (C<ok() || diag()>) it "passes through" the failure.
930 return ok(...) || diag(...);
933 Mark Fowler <mark@twoshortplanks.com>
938 my($self, @msgs) = @_;
941 # Prevent printing headers when compiling (i.e. -c)
944 # Escape each line with a #.
946 $_ = 'undef' unless defined;
950 push @msgs, "\n" unless $msgs[-1] =~ /\n\Z/;
952 local $Level = $Level + 1;
953 $self->_print_diag(@msgs);
962 $Test->_print(@msgs);
964 Prints to the output() filehandle.
971 my($self, @msgs) = @_;
973 # Prevent printing headers when only compiling. Mostly for when
974 # tests are deparsed with B::Deparse
977 local($\, $", $,) = (undef, ' ', '');
978 my $fh = $self->output;
980 # Escape each line after the first with a # so we don't
981 # confuse Test::Harness.
986 push @msgs, "\n" unless $msgs[-1] =~ /\n\Z/;
994 $Test->_print_diag(@msg);
996 Like _print, but prints to the current diagnostic filehandle.
1003 local($\, $", $,) = (undef, ' ', '');
1004 my $fh = $self->todo ? $self->todo_output : $self->failure_output;
1011 $Test->output($file);
1013 Where normal "ok/not ok" test output should go.
1017 =item B<failure_output>
1019 $Test->failure_output($fh);
1020 $Test->failure_output($file);
1022 Where diagnostic output on test failures and diag() should go.
1026 =item B<todo_output>
1028 $Test->todo_output($fh);
1029 $Test->todo_output($file);
1031 Where diagnostics about todo test failures and diag() should go.
1037 my($Out_FH, $Fail_FH, $Todo_FH);
1039 my($self, $fh) = @_;
1042 $Out_FH = _new_fh($fh);
1047 sub failure_output {
1048 my($self, $fh) = @_;
1051 $Fail_FH = _new_fh($fh);
1057 my($self, $fh) = @_;
1060 $Todo_FH = _new_fh($fh);
1066 my($file_or_fh) = shift;
1069 unless( UNIVERSAL::isa($file_or_fh, 'GLOB') ) {
1070 $fh = do { local *FH };
1071 open $fh, ">$file_or_fh" or
1072 die "Can't open test output log $file_or_fh: $!";
1083 my $old_fh = select $fh;
1089 my $Opened_Testhandles = 0;
1090 sub _dup_stdhandles {
1093 $self->_open_testhandles unless $Opened_Testhandles;
1095 # Set everything to unbuffered else plain prints to STDOUT will
1096 # come out in the wrong order from our own prints.
1097 _autoflush(\*TESTOUT);
1098 _autoflush(\*STDOUT);
1099 _autoflush(\*TESTERR);
1100 _autoflush(\*STDERR);
1102 $Test->output(\*TESTOUT);
1103 $Test->failure_output(\*TESTERR);
1104 $Test->todo_output(\*TESTOUT);
1107 sub _open_testhandles {
1108 # We dup STDOUT and STDERR so people can change them in their
1109 # test suites while still getting normal test output.
1110 open(TESTOUT, ">&STDOUT") or die "Can't dup STDOUT: $!";
1111 open(TESTERR, ">&STDERR") or die "Can't dup STDERR: $!";
1112 $Opened_Testhandles = 1;
1119 =head2 Test Status and Info
1123 =item B<current_test>
1125 my $curr_test = $Test->current_test;
1126 $Test->current_test($num);
1128 Gets/sets the current test # we're on.
1130 You usually shouldn't have to set this.
1135 my($self, $num) = @_;
1138 if( defined $num ) {
1139 unless( $Have_Plan ) {
1141 Carp::croak("Can't change the current test number without a plan!");
1145 if( $num > @Test_Results ) {
1146 my $start = @Test_Results ? $#Test_Results + 1 : 0;
1147 for ($start..$num-1) {
1148 $Test_Results[$_] = &share({
1151 reason => 'incrementing test number',
1164 my @tests = $Test->summary;
1166 A simple summary of the tests so far. True for pass, false for fail.
1167 This is a logical pass/fail, so todos are passes.
1169 Of course, test #1 is $tests[0], etc...
1176 return map { $_->{'ok'} } @Test_Results;
1181 my @tests = $Test->details;
1183 Like summary(), but with a lot more detail.
1185 $tests[$test_num - 1] =
1186 { 'ok' => is the test considered a pass?
1187 actual_ok => did it literally say 'ok'?
1188 name => name of the test (if any)
1189 type => type of test (if any, see below).
1190 reason => reason for the above (if any)
1193 'ok' is true if Test::Harness will consider the test to be a pass.
1195 'actual_ok' is a reflection of whether or not the test literally
1196 printed 'ok' or 'not ok'. This is for examining the result of 'todo'
1199 'name' is the name of the test.
1201 'type' indicates if it was a special test. Normal tests have a type
1202 of ''. Type can be one of the following:
1206 todo_skip see todo_skip()
1209 Sometimes the Test::Builder test counter is incremented without it
1210 printing any test output, for example, when current_test() is changed.
1211 In these cases, Test::Builder doesn't know the result of the test, so
1212 it's type is 'unkown'. These details for these tests are filled in.
1213 They are considered ok, but the name and actual_ok is left undef.
1215 For example "not ok 23 - hole count # TODO insufficient donuts" would
1216 result in this structure:
1218 $tests[22] = # 23 - 1, since arrays start from 0.
1219 { ok => 1, # logically, the test passed since it's todo
1220 actual_ok => 0, # in absolute terms, it failed
1221 name => 'hole count',
1223 reason => 'insufficient donuts'
1229 return @Test_Results;
1234 my $todo_reason = $Test->todo;
1235 my $todo_reason = $Test->todo($pack);
1237 todo() looks for a $TODO variable in your tests. If set, all tests
1238 will be considered 'todo' (see Test::More and Test::Harness for
1239 details). Returns the reason (ie. the value of $TODO) if running as
1240 todo tests, false otherwise.
1242 todo() is pretty part about finding the right package to look for
1243 $TODO in. It uses the exported_to() package to find it. If that's
1244 not set, it's pretty good at guessing the right package to look at.
1246 Sometimes there is some confusion about where todo() should be looking
1247 for the $TODO variable. If you want to be sure, tell it explicitly
1253 my($self, $pack) = @_;
1255 $pack = $pack || $self->exported_to || $self->caller(1);
1258 return defined ${$pack.'::TODO'} ? ${$pack.'::TODO'}
1264 my $package = $Test->caller;
1265 my($pack, $file, $line) = $Test->caller;
1266 my($pack, $file, $line) = $Test->caller($height);
1268 Like the normal caller(), except it reports according to your level().
1273 my($self, $height) = @_;
1276 my @caller = CORE::caller($self->level + $height + 1);
1277 return wantarray ? @caller : $caller[0];
1288 =item B<_sanity_check>
1292 Runs a bunch of end of test sanity checks to make sure reality came
1293 through ok. If anything is wrong it will die with a fairly friendly
1300 _whoa($Curr_Test < 0, 'Says here you ran a negative number of tests!');
1301 _whoa(!$Have_Plan and $Curr_Test,
1302 'Somehow your tests ran without a plan!');
1303 _whoa($Curr_Test != @Test_Results,
1304 'Somehow you got a different number of results than tests ran!');
1309 _whoa($check, $description);
1311 A sanity check, similar to assert(). If the $check is true, something
1312 has gone horribly wrong. It will die with the given $description and
1313 a note to contact the author.
1318 my($check, $desc) = @_;
1322 This should never happen! Please contact the author immediately!
1329 _my_exit($exit_num);
1331 Perl seems to have some trouble with exiting inside an END block. 5.005_03
1332 and 5.6.1 both seem to do odd things. Instead, this function edits $?
1333 directly. It should ONLY be called from inside an END block. It
1334 doesn't actually exit, that's your job.
1351 $SIG{__DIE__} = sub {
1352 # We don't want to muck with death in an eval, but $^S isn't
1353 # totally reliable. 5.005_03 and 5.6.1 both do the wrong thing
1354 # with it. Instead, we use caller. This also means it runs under
1357 for( my $stack = 1; my $sub = (CORE::caller($stack))[3]; $stack++ ) {
1358 $in_eval = 1 if $sub =~ /^\(eval\)/;
1360 $Test_Died = 1 unless $in_eval;
1368 # Don't bother with an ending if this is a forked copy. Only the parent
1369 # should do the ending.
1370 do{ _my_exit($?) && return } if $Original_Pid != $$;
1372 # Bailout if plan() was never called. This is so
1373 # "require Test::Simple" doesn't puke.
1374 do{ _my_exit(0) && return } if !$Have_Plan && !$Test_Died;
1376 # Figure out if we passed or failed and print helpful messages.
1377 if( @Test_Results ) {
1378 # The plan? We have no plan.
1380 $self->_print("1..$Curr_Test\n") unless $self->no_header;
1381 $Expected_Tests = $Curr_Test;
1384 # Auto-extended arrays and elements which aren't explicitly
1385 # filled in with a shared reference will puke under 5.8.0
1386 # ithreads. So we have to fill them in by hand. :(
1387 my $empty_result = &share({});
1388 for my $idx ( 0..$Expected_Tests-1 ) {
1389 $Test_Results[$idx] = $empty_result
1390 unless defined $Test_Results[$idx];
1393 my $num_failed = grep !$_->{'ok'}, @Test_Results[0..$Expected_Tests-1];
1394 $num_failed += abs($Expected_Tests - @Test_Results);
1396 if( $Curr_Test < $Expected_Tests ) {
1397 my $s = $Expected_Tests == 1 ? '' : 's';
1398 $self->diag(<<"FAIL");
1399 Looks like you planned $Expected_Tests test$s but only ran $Curr_Test.
1402 elsif( $Curr_Test > $Expected_Tests ) {
1403 my $num_extra = $Curr_Test - $Expected_Tests;
1404 my $s = $Expected_Tests == 1 ? '' : 's';
1405 $self->diag(<<"FAIL");
1406 Looks like you planned $Expected_Tests test$s but ran $num_extra extra.
1409 elsif ( $num_failed ) {
1410 my $s = $num_failed == 1 ? '' : 's';
1411 $self->diag(<<"FAIL");
1412 Looks like you failed $num_failed test$s of $Expected_Tests.
1417 $self->diag(<<"FAIL");
1418 Looks like your test died just after $Curr_Test.
1421 _my_exit( 255 ) && return;
1424 _my_exit( $num_failed <= 254 ? $num_failed : 254 ) && return;
1426 elsif ( $Skip_All ) {
1427 _my_exit( 0 ) && return;
1429 elsif ( $Test_Died ) {
1430 $self->diag(<<'FAIL');
1431 Looks like your test died before it could output anything.
1433 _my_exit( 255 ) && return;
1436 $self->diag("No tests run!\n");
1437 _my_exit( 255 ) && return;
1442 $Test->_ending if defined $Test and !$Test->no_ending;
1447 If all your tests passed, Test::Builder will exit with zero (which is
1448 normal). If anything failed it will exit with how many failed. If
1449 you run less (or more) tests than you planned, the missing (or extras)
1450 will be considered failures. If no tests were ever run Test::Builder
1451 will throw a warning and exit with 255. If the test died, even after
1452 having successfully completed all its tests, it will still be
1453 considered a failure and will exit with 255.
1455 So the exit codes are...
1457 0 all tests successful
1459 any other number how many failed (including missing or extras)
1461 If you fail more than 254 tests, it will be reported as 254.
1466 In perl 5.8.0 and later, Test::Builder is thread-safe. The test
1467 number is shared amongst all threads. This means if one thread sets
1468 the test number using current_test() they will all be effected.
1470 Test::Builder is only thread-aware if threads.pm is loaded I<before>
1475 CPAN can provide the best examples. Test::Simple, Test::More,
1476 Test::Exception and Test::Differences all use Test::Builder.
1480 Test::Simple, Test::More, Test::Harness
1484 Original code by chromatic, maintained by Michael G Schwern
1485 E<lt>schwern@pobox.comE<gt>
1489 Copyright 2002 by chromatic E<lt>chromatic@wgz.orgE<gt>,
1490 Michael G Schwern E<lt>schwern@pobox.comE<gt>.
1492 This program is free software; you can redistribute it and/or
1493 modify it under the same terms as Perl itself.
1495 See F<http://www.perl.com/perl/misc/Artistic.html>