This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade to Storable-2.21
[perl5.git] / cpan / Test-Simple / lib / Test / Builder.pm
CommitLineData
33459055
MS
1package Test::Builder;
2
cd06ac21 3use 5.006;
33459055 4use strict;
ccbd73a4 5use warnings;
cd06ac21 6
3e887aae 7our $VERSION = '0.92';
ccbd73a4 8$VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval)
33459055 9
3e887aae
DM
10BEGIN {
11 if( $] < 5.008 ) {
12 require Test::Builder::IO::Scalar;
13 }
14}
15
16
a344be10
MS
17# Make Test::Builder thread-safe for ithreads.
18BEGIN {
19 use Config;
b7f9bbeb
SP
20 # Load threads::shared when threads are turned on.
21 # 5.8.0's threads are so busted we no longer support them.
ccbd73a4 22 if( $] >= 5.008001 && $Config{useithreads} && $INC{'threads.pm'} ) {
a344be10 23 require threads::shared;
7483b81c 24
ccbd73a4 25 # Hack around YET ANOTHER threads::shared bug. It would
7483b81c
RGS
26 # occassionally forget the contents of the variable when sharing it.
27 # So we first copy the data, then share, then put our copy back.
28 *share = sub (\[$@%]) {
29 my $type = ref $_[0];
30 my $data;
31
32 if( $type eq 'HASH' ) {
ccbd73a4 33 %$data = %{ $_[0] };
7483b81c
RGS
34 }
35 elsif( $type eq 'ARRAY' ) {
ccbd73a4 36 @$data = @{ $_[0] };
7483b81c
RGS
37 }
38 elsif( $type eq 'SCALAR' ) {
ccbd73a4 39 $$data = ${ $_[0] };
7483b81c
RGS
40 }
41 else {
ccbd73a4 42 die( "Unknown type: " . $type );
7483b81c
RGS
43 }
44
ccbd73a4 45 $_[0] = &threads::shared::share( $_[0] );
7483b81c
RGS
46
47 if( $type eq 'HASH' ) {
ccbd73a4 48 %{ $_[0] } = %$data;
7483b81c
RGS
49 }
50 elsif( $type eq 'ARRAY' ) {
ccbd73a4 51 @{ $_[0] } = @$data;
7483b81c
RGS
52 }
53 elsif( $type eq 'SCALAR' ) {
ccbd73a4 54 ${ $_[0] } = $$data;
7483b81c
RGS
55 }
56 else {
ccbd73a4 57 die( "Unknown type: " . $type );
7483b81c
RGS
58 }
59
60 return $_[0];
61 };
a344be10 62 }
b7f9bbeb
SP
63 # 5.8.0's threads::shared is busted when threads are off
64 # and earlier Perls just don't have that module at all.
a344be10 65 else {
30e302f8 66 *share = sub { return $_[0] };
60ffb308 67 *lock = sub { 0 };
a344be10
MS
68 }
69}
70
33459055
MS
71=head1 NAME
72
73Test::Builder - Backend for building test libraries
74
75=head1 SYNOPSIS
76
77 package My::Test::Module;
04955c14 78 use base 'Test::Builder::Module';
33459055 79
04955c14 80 my $CLASS = __PACKAGE__;
33459055
MS
81
82 sub ok {
83 my($test, $name) = @_;
04955c14 84 my $tb = $CLASS->builder;
33459055 85
04955c14 86 $tb->ok($test, $name);
33459055
MS
87 }
88
89
90=head1 DESCRIPTION
91
33459055 92Test::Simple and Test::More have proven to be popular testing modules,
a9153838
MS
93but they're not always flexible enough. Test::Builder provides the a
94building block upon which to write your own test libraries I<which can
95work together>.
33459055
MS
96
97=head2 Construction
98
99=over 4
100
101=item B<new>
102
103 my $Test = Test::Builder->new;
104
105Returns a Test::Builder object representing the current state of the
106test.
107
5143c659 108Since you only run one test per program C<new> always returns the same
3e887aae 109Test::Builder object. No matter how many times you call C<new()>, you're
5143c659
RGS
110getting the same object. This is called a singleton. This is done so that
111multiple modules share such global information as the test counter and
112where test output is going.
113
114If you want a completely new Test::Builder object different from the
115singleton, use C<create>.
33459055
MS
116
117=cut
118
30e302f8 119my $Test = Test::Builder->new;
ccbd73a4 120
33459055
MS
121sub new {
122 my($class) = shift;
5143c659 123 $Test ||= $class->create;
33459055
MS
124 return $Test;
125}
126
5143c659
RGS
127=item B<create>
128
129 my $Test = Test::Builder->create;
130
131Ok, so there can be more than one Test::Builder object and this is how
132you get it. You might use this instead of C<new()> if you're testing
133a Test::Builder based module, but otherwise you probably want C<new>.
134
135B<NOTE>: the implementation is not complete. C<level>, for example, is
136still shared amongst B<all> Test::Builder objects, even ones created using
137this method. Also, the method name may change in the future.
138
139=cut
140
141sub create {
142 my $class = shift;
143
144 my $self = bless {}, $class;
145 $self->reset;
146
147 return $self;
148}
149
30e302f8
NC
150=item B<reset>
151
152 $Test->reset;
153
154Reinitializes the Test::Builder singleton to its original state.
155Mostly useful for tests run in persistent environments where the same
156test might be run multiple times in the same process.
157
158=cut
159
ccbd73a4 160our $Level;
30e302f8 161
ccbd73a4
SP
162sub reset { ## no critic (Subroutines::ProhibitBuiltinHomonyms)
163 my($self) = @_;
30e302f8 164
5143c659
RGS
165 # We leave this a global because it has to be localized and localizing
166 # hash keys is just asking for pain. Also, it was documented.
167 $Level = 1;
168
5143c659
RGS
169 $self->{Have_Plan} = 0;
170 $self->{No_Plan} = 0;
3e887aae
DM
171 $self->{Have_Output_Plan} = 0;
172
5143c659 173 $self->{Original_Pid} = $$;
30e302f8 174
ccbd73a4
SP
175 share( $self->{Curr_Test} );
176 $self->{Curr_Test} = 0;
177 $self->{Test_Results} = &share( [] );
30e302f8 178
5143c659
RGS
179 $self->{Exported_To} = undef;
180 $self->{Expected_Tests} = 0;
30e302f8 181
ccbd73a4 182 $self->{Skip_All} = 0;
30e302f8 183
ccbd73a4 184 $self->{Use_Nums} = 1;
5143c659 185
ccbd73a4
SP
186 $self->{No_Header} = 0;
187 $self->{No_Ending} = 0;
30e302f8 188
ccbd73a4
SP
189 $self->{Todo} = undef;
190 $self->{Todo_Stack} = [];
191 $self->{Start_Todo} = 0;
3e887aae 192 $self->{Opened_Testhandles} = 0;
04955c14 193
ccbd73a4 194 $self->_dup_stdhandles;
30e302f8 195
705e6672 196 return;
30e302f8
NC
197}
198
33459055
MS
199=back
200
201=head2 Setting up tests
202
203These methods are for setting up tests and declaring how many there
204are. You usually only want to call one of these methods.
205
206=over 4
207
33459055
MS
208=item B<plan>
209
210 $Test->plan('no_plan');
211 $Test->plan( skip_all => $reason );
212 $Test->plan( tests => $num_tests );
213
214A convenient way to set up your tests. Call this and Test::Builder
215will print the appropriate headers and take the appropriate actions.
216
3e887aae 217If you call C<plan()>, don't call any of the other methods below.
33459055
MS
218
219=cut
220
3e887aae
DM
221my %plan_cmds = (
222 no_plan => \&no_plan,
223 skip_all => \&skip_all,
224 tests => \&_plan_tests,
225);
226
33459055 227sub plan {
ccbd73a4 228 my( $self, $cmd, $arg ) = @_;
33459055
MS
229
230 return unless $cmd;
231
004caa16
RGS
232 local $Level = $Level + 1;
233
3e887aae 234 $self->croak("You tried to plan twice") if $self->{Have_Plan};
a344be10 235
3e887aae
DM
236 if( my $method = $plan_cmds{$cmd} ) {
237 local $Level = $Level + 1;
238 $self->$method($arg);
33459055 239 }
89c1e84a 240 else {
ccbd73a4 241 my @args = grep { defined } ( $cmd, $arg );
b7f9bbeb 242 $self->croak("plan() doesn't understand @args");
89c1e84a 243 }
a344be10
MS
244
245 return 1;
33459055
MS
246}
247
3e887aae
DM
248
249sub _plan_tests {
250 my($self, $arg) = @_;
251
252 if($arg) {
253 local $Level = $Level + 1;
254 return $self->expected_tests($arg);
255 }
256 elsif( !defined $arg ) {
257 $self->croak("Got an undefined number of tests");
258 }
259 else {
260 $self->croak("You said to run 0 tests");
261 }
262
263 return;
264}
265
266
33459055
MS
267=item B<expected_tests>
268
269 my $max = $Test->expected_tests;
270 $Test->expected_tests($max);
271
3e887aae 272Gets/sets the number of tests we expect this test to run and prints out
33459055
MS
273the appropriate headers.
274
275=cut
276
33459055 277sub expected_tests {
7483b81c
RGS
278 my $self = shift;
279 my($max) = @_;
280
ccbd73a4 281 if(@_) {
b7f9bbeb 282 $self->croak("Number of tests must be a positive integer. You gave it '$max'")
ccbd73a4 283 unless $max =~ /^\+?\d+$/;
33459055 284
5143c659
RGS
285 $self->{Expected_Tests} = $max;
286 $self->{Have_Plan} = 1;
33459055 287
3e887aae 288 $self->_output_plan($max) unless $self->no_header;
33459055 289 }
5143c659 290 return $self->{Expected_Tests};
33459055
MS
291}
292
33459055
MS
293=item B<no_plan>
294
295 $Test->no_plan;
296
3e887aae 297Declares that this test will run an indeterminate number of tests.
33459055
MS
298
299=cut
300
33459055 301sub no_plan {
3e887aae
DM
302 my($self, $arg) = @_;
303
304 $self->carp("no_plan takes no arguments") if $arg;
5143c659
RGS
305
306 $self->{No_Plan} = 1;
307 $self->{Have_Plan} = 1;
ccbd73a4
SP
308
309 return 1;
33459055
MS
310}
311
3e887aae
DM
312
313=begin private
314
315=item B<_output_plan>
316
317 $tb->_output_plan($max);
318 $tb->_output_plan($max, $directive);
319 $tb->_output_plan($max, $directive => $reason);
320
321Handles displaying the test plan.
322
323If a C<$directive> and/or C<$reason> are given they will be output with the
324plan. So here's what skipping all tests looks like:
325
326 $tb->_output_plan(0, "SKIP", "Because I said so");
327
328It sets C<< $tb->{Have_Output_Plan} >> and will croak if the plan was already
329output.
330
331=end private
332
333=cut
334
335sub _output_plan {
336 my($self, $max, $directive, $reason) = @_;
337
338 $self->carp("The plan was already output") if $self->{Have_Output_Plan};
339
340 my $plan = "1..$max";
341 $plan .= " # $directive" if defined $directive;
342 $plan .= " $reason" if defined $reason;
343
344 $self->_print("$plan\n");
345
346 $self->{Have_Output_Plan} = 1;
347
348 return;
349}
350
351=item B<done_testing>
352
353 $Test->done_testing();
354 $Test->done_testing($num_tests);
355
356Declares that you are done testing, no more tests will be run after this point.
357
358If a plan has not yet been output, it will do so.
359
360$num_tests is the number of tests you planned to run. If a numbered
361plan was already declared, and if this contradicts, a failing test
362will be run to reflect the planning mistake. If C<no_plan> was declared,
363this will override.
364
365If C<done_testing()> is called twice, the second call will issue a
366failing test.
367
368If C<$num_tests> is omitted, the number of tests run will be used, like
369no_plan.
370
371C<done_testing()> is, in effect, used when you'd want to use C<no_plan>, but
372safer. You'd use it like so:
373
374 $Test->ok($a == $b);
375 $Test->done_testing();
376
377Or to plan a variable number of tests:
378
379 for my $test (@tests) {
380 $Test->ok($test);
381 }
382 $Test->done_testing(@tests);
383
384=cut
385
386sub done_testing {
387 my($self, $num_tests) = @_;
388
389 # If done_testing() specified the number of tests, shut off no_plan.
390 if( defined $num_tests ) {
391 $self->{No_Plan} = 0;
392 }
393 else {
394 $num_tests = $self->current_test;
395 }
396
397 if( $self->{Done_Testing} ) {
398 my($file, $line) = @{$self->{Done_Testing}}[1,2];
399 $self->ok(0, "done_testing() was already called at $file line $line");
400 return;
401 }
402
403 $self->{Done_Testing} = [caller];
404
405 if( $self->expected_tests && $num_tests != $self->expected_tests ) {
406 $self->ok(0, "planned to run @{[ $self->expected_tests ]} ".
407 "but done_testing() expects $num_tests");
408 }
409 else {
410 $self->{Expected_Tests} = $num_tests;
411 }
412
413 $self->_output_plan($num_tests) unless $self->{Have_Output_Plan};
414
415 $self->{Have_Plan} = 1;
416
417 return 1;
418}
419
420
60ffb308
MS
421=item B<has_plan>
422
423 $plan = $Test->has_plan
5143c659 424
3e887aae
DM
425Find out whether a plan has been defined. C<$plan> is either C<undef> (no plan
426has been set), C<no_plan> (indeterminate # of tests) or an integer (the number
427of expected tests).
60ffb308
MS
428
429=cut
430
431sub has_plan {
5143c659
RGS
432 my $self = shift;
433
ccbd73a4 434 return( $self->{Expected_Tests} ) if $self->{Expected_Tests};
5143c659
RGS
435 return('no_plan') if $self->{No_Plan};
436 return(undef);
ccbd73a4 437}
60ffb308 438
33459055
MS
439=item B<skip_all>
440
441 $Test->skip_all;
442 $Test->skip_all($reason);
443
3e887aae 444Skips all the tests, using the given C<$reason>. Exits immediately with 0.
33459055
MS
445
446=cut
447
33459055 448sub skip_all {
ccbd73a4 449 my( $self, $reason ) = @_;
33459055 450
5143c659 451 $self->{Skip_All} = 1;
33459055 452
3e887aae 453 $self->_output_plan(0, "SKIP", $reason) unless $self->no_header;
33459055
MS
454 exit(0);
455}
456
04955c14
SP
457=item B<exported_to>
458
459 my $pack = $Test->exported_to;
460 $Test->exported_to($pack);
461
462Tells Test::Builder what package you exported your functions to.
463
464This method isn't terribly useful since modules which share the same
465Test::Builder object might get exported to different packages and only
466the last one will be honored.
467
468=cut
469
470sub exported_to {
ccbd73a4 471 my( $self, $pack ) = @_;
04955c14
SP
472
473 if( defined $pack ) {
474 $self->{Exported_To} = $pack;
475 }
476 return $self->{Exported_To};
477}
478
33459055
MS
479=back
480
481=head2 Running tests
482
c00d8759
SP
483These actually run the tests, analogous to the functions in Test::More.
484
485They all return true if the test passed, false if the test failed.
33459055 486
3e887aae 487C<$name> is always optional.
33459055
MS
488
489=over 4
490
491=item B<ok>
492
493 $Test->ok($test, $name);
494
3e887aae
DM
495Your basic test. Pass if C<$test> is true, fail if $test is false. Just
496like Test::Simple's C<ok()>.
33459055
MS
497
498=cut
499
500sub ok {
ccbd73a4 501 my( $self, $test, $name ) = @_;
33459055 502
60ffb308
MS
503 # $test might contain an object which we don't want to accidentally
504 # store, so we turn it into a boolean.
505 $test = $test ? 1 : 0;
506
5143c659
RGS
507 lock $self->{Curr_Test};
508 $self->{Curr_Test}++;
a344be10 509
30e302f8 510 # In case $name is a string overloaded object, force it to stringify.
ccbd73a4 511 $self->_unoverload_str( \$name );
30e302f8 512
ccbd73a4 513 $self->diag(<<"ERR") if defined $name and $name =~ /^[\d\s]+$/;
a9153838
MS
514 You named your test '$name'. You shouldn't use numbers for your test names.
515 Very confusing.
33459055
MS
516ERR
517
04955c14
SP
518 # Capture the value of $TODO for the rest of this ok() call
519 # so it can more easily be found by other routines.
ccbd73a4
SP
520 my $todo = $self->todo();
521 my $in_todo = $self->in_todo;
522 local $self->{Todo} = $todo if $in_todo;
04955c14 523
ccbd73a4 524 $self->_unoverload_str( \$todo );
33459055
MS
525
526 my $out;
ccbd73a4 527 my $result = &share( {} );
60ffb308 528
ccbd73a4 529 unless($test) {
33459055 530 $out .= "not ";
ccbd73a4 531 @$result{ 'ok', 'actual_ok' } = ( ( $self->in_todo ? 1 : 0 ), 0 );
33459055
MS
532 }
533 else {
60ffb308 534 @$result{ 'ok', 'actual_ok' } = ( 1, $test );
33459055
MS
535 }
536
537 $out .= "ok";
5143c659 538 $out .= " $self->{Curr_Test}" if $self->use_numbers;
33459055
MS
539
540 if( defined $name ) {
ccbd73a4
SP
541 $name =~ s|#|\\#|g; # # in a name can confuse Test::Harness.
542 $out .= " - $name";
7483b81c 543 $result->{name} = $name;
60ffb308
MS
544 }
545 else {
546 $result->{name} = '';
33459055
MS
547 }
548
ccbd73a4
SP
549 if( $self->in_todo ) {
550 $out .= " # TODO $todo";
7483b81c 551 $result->{reason} = $todo;
60ffb308
MS
552 $result->{type} = 'todo';
553 }
554 else {
555 $result->{reason} = '';
556 $result->{type} = '';
33459055
MS
557 }
558
ccbd73a4 559 $self->{Test_Results}[ $self->{Curr_Test} - 1 ] = $result;
33459055
MS
560 $out .= "\n";
561
562 $self->_print($out);
563
ccbd73a4
SP
564 unless($test) {
565 my $msg = $self->in_todo ? "Failed (TODO)" : "Failed";
566 $self->_print_to_fh( $self->_diag_fh, "\n" ) if $ENV{HARNESS_ACTIVE};
b1ddf169 567
ccbd73a4 568 my( undef, $file, $line ) = $self->caller;
705e6672
SP
569 if( defined $name ) {
570 $self->diag(qq[ $msg test '$name'\n]);
571 $self->diag(qq[ at $file line $line.\n]);
572 }
573 else {
574 $self->diag(qq[ $msg test at $file line $line.\n]);
575 }
ccbd73a4 576 }
33459055
MS
577
578 return $test ? 1 : 0;
579}
580
7483b81c 581sub _unoverload {
ccbd73a4
SP
582 my $self = shift;
583 my $type = shift;
7483b81c 584
8f70d4fd 585 $self->_try(sub { require overload; }, die_on_fail => 1);
7483b81c
RGS
586
587 foreach my $thing (@_) {
c00d8759 588 if( $self->_is_object($$thing) ) {
ccbd73a4 589 if( my $string_meth = overload::Method( $$thing, $type ) ) {
c00d8759 590 $$thing = $$thing->$string_meth();
7483b81c 591 }
c00d8759 592 }
7483b81c 593 }
7483b81c 594
ccbd73a4
SP
595 return;
596}
7483b81c 597
b1ddf169 598sub _is_object {
ccbd73a4 599 my( $self, $thing ) = @_;
b1ddf169 600
ccbd73a4 601 return $self->_try( sub { ref $thing && $thing->isa('UNIVERSAL') } ) ? 1 : 0;
b1ddf169
RGS
602}
603
b1ddf169
RGS
604sub _unoverload_str {
605 my $self = shift;
606
ccbd73a4
SP
607 return $self->_unoverload( q[""], @_ );
608}
b1ddf169
RGS
609
610sub _unoverload_num {
611 my $self = shift;
612
ccbd73a4 613 $self->_unoverload( '0+', @_ );
b1ddf169
RGS
614
615 for my $val (@_) {
616 next unless $self->_is_dualvar($$val);
ccbd73a4 617 $$val = $$val + 0;
b1ddf169 618 }
b1ddf169 619
ccbd73a4
SP
620 return;
621}
b1ddf169
RGS
622
623# This is a hack to detect a dualvar such as $!
624sub _is_dualvar {
ccbd73a4 625 my( $self, $val ) = @_;
b1ddf169 626
82d700dc
SH
627 # Objects are not dualvars.
628 return 0 if ref $val;
629
ccbd73a4
SP
630 no warnings 'numeric';
631 my $numval = $val + 0;
632 return $numval != 0 and $numval ne $val ? 1 : 0;
b1ddf169
RGS
633}
634
33459055
MS
635=item B<is_eq>
636
637 $Test->is_eq($got, $expected, $name);
638
3e887aae 639Like Test::More's C<is()>. Checks if C<$got eq $expected>. This is the
33459055
MS
640string version.
641
642=item B<is_num>
643
a9153838 644 $Test->is_num($got, $expected, $name);
33459055 645
3e887aae 646Like Test::More's C<is()>. Checks if C<$got == $expected>. This is the
33459055
MS
647numeric version.
648
649=cut
650
651sub is_eq {
ccbd73a4 652 my( $self, $got, $expect, $name ) = @_;
33459055 653 local $Level = $Level + 1;
a9153838 654
ccbd73a4 655 $self->_unoverload_str( \$got, \$expect );
b1ddf169 656
a9153838
MS
657 if( !defined $got || !defined $expect ) {
658 # undef only matches undef and nothing else
659 my $test = !defined $got && !defined $expect;
660
ccbd73a4
SP
661 $self->ok( $test, $name );
662 $self->_is_diag( $got, 'eq', $expect ) unless $test;
a9153838
MS
663 return $test;
664 }
665
ccbd73a4 666 return $self->cmp_ok( $got, 'eq', $expect, $name );
33459055
MS
667}
668
669sub is_num {
ccbd73a4 670 my( $self, $got, $expect, $name ) = @_;
33459055 671 local $Level = $Level + 1;
a9153838 672
ccbd73a4 673 $self->_unoverload_num( \$got, \$expect );
b1ddf169 674
a9153838
MS
675 if( !defined $got || !defined $expect ) {
676 # undef only matches undef and nothing else
677 my $test = !defined $got && !defined $expect;
678
ccbd73a4
SP
679 $self->ok( $test, $name );
680 $self->_is_diag( $got, '==', $expect ) unless $test;
a9153838
MS
681 return $test;
682 }
683
ccbd73a4 684 return $self->cmp_ok( $got, '==', $expect, $name );
33459055
MS
685}
686
ccbd73a4
SP
687sub _diag_fmt {
688 my( $self, $type, $val ) = @_;
a9153838 689
ccbd73a4
SP
690 if( defined $$val ) {
691 if( $type eq 'eq' or $type eq 'ne' ) {
692 # quote and force string context
693 $$val = "'$$val'";
a9153838
MS
694 }
695 else {
ccbd73a4
SP
696 # force numeric context
697 $self->_unoverload_num($val);
a9153838
MS
698 }
699 }
ccbd73a4
SP
700 else {
701 $$val = 'undef';
702 }
703
704 return;
705}
706
707sub _is_diag {
708 my( $self, $got, $type, $expect ) = @_;
709
710 $self->_diag_fmt( $type, $_ ) for \$got, \$expect;
33459055 711
04955c14 712 local $Level = $Level + 1;
ccbd73a4
SP
713 return $self->diag(<<"DIAGNOSTIC");
714 got: $got
715 expected: $expect
a9153838
MS
716DIAGNOSTIC
717
ccbd73a4
SP
718}
719
720sub _isnt_diag {
721 my( $self, $got, $type ) = @_;
722
723 $self->_diag_fmt( $type, \$got );
724
725 local $Level = $Level + 1;
726 return $self->diag(<<"DIAGNOSTIC");
727 got: $got
728 expected: anything else
729DIAGNOSTIC
730}
a9153838
MS
731
732=item B<isnt_eq>
733
734 $Test->isnt_eq($got, $dont_expect, $name);
735
3e887aae 736Like Test::More's C<isnt()>. Checks if C<$got ne $dont_expect>. This is
a9153838
MS
737the string version.
738
739=item B<isnt_num>
740
68938d83 741 $Test->isnt_num($got, $dont_expect, $name);
a9153838 742
3e887aae 743Like Test::More's C<isnt()>. Checks if C<$got ne $dont_expect>. This is
a9153838
MS
744the numeric version.
745
746=cut
747
748sub isnt_eq {
ccbd73a4 749 my( $self, $got, $dont_expect, $name ) = @_;
a9153838
MS
750 local $Level = $Level + 1;
751
752 if( !defined $got || !defined $dont_expect ) {
753 # undef only matches undef and nothing else
754 my $test = defined $got || defined $dont_expect;
755
ccbd73a4
SP
756 $self->ok( $test, $name );
757 $self->_isnt_diag( $got, 'ne' ) unless $test;
a9153838 758 return $test;
33459055 759 }
a9153838 760
ccbd73a4 761 return $self->cmp_ok( $got, 'ne', $dont_expect, $name );
a9153838
MS
762}
763
764sub isnt_num {
ccbd73a4 765 my( $self, $got, $dont_expect, $name ) = @_;
33459055 766 local $Level = $Level + 1;
33459055 767
a9153838
MS
768 if( !defined $got || !defined $dont_expect ) {
769 # undef only matches undef and nothing else
770 my $test = defined $got || defined $dont_expect;
33459055 771
ccbd73a4
SP
772 $self->ok( $test, $name );
773 $self->_isnt_diag( $got, '!=' ) unless $test;
a9153838
MS
774 return $test;
775 }
776
ccbd73a4 777 return $self->cmp_ok( $got, '!=', $dont_expect, $name );
33459055
MS
778}
779
780=item B<like>
781
782 $Test->like($this, qr/$regex/, $name);
783 $Test->like($this, '/$regex/', $name);
784
3e887aae 785Like Test::More's C<like()>. Checks if $this matches the given C<$regex>.
33459055 786
3e887aae 787You'll want to avoid C<qr//> if you want your tests to work before 5.005.
33459055 788
a9153838
MS
789=item B<unlike>
790
791 $Test->unlike($this, qr/$regex/, $name);
792 $Test->unlike($this, '/$regex/', $name);
793
3e887aae
DM
794Like Test::More's C<unlike()>. Checks if $this B<does not match> the
795given C<$regex>.
a9153838 796
33459055
MS
797=cut
798
799sub like {
ccbd73a4 800 my( $self, $this, $regex, $name ) = @_;
33459055
MS
801
802 local $Level = $Level + 1;
ccbd73a4 803 return $self->_regex_ok( $this, $regex, '=~', $name );
a9153838
MS
804}
805
806sub unlike {
ccbd73a4 807 my( $self, $this, $regex, $name ) = @_;
a9153838
MS
808
809 local $Level = $Level + 1;
ccbd73a4 810 return $self->_regex_ok( $this, $regex, '!~', $name );
a9153838
MS
811}
812
a9153838
MS
813=item B<cmp_ok>
814
815 $Test->cmp_ok($this, $type, $that, $name);
816
3e887aae 817Works just like Test::More's C<cmp_ok()>.
a9153838
MS
818
819 $Test->cmp_ok($big_num, '!=', $other_big_num);
820
821=cut
822
ccbd73a4 823my %numeric_cmps = map { ( $_, 1 ) } ( "<", "<=", ">", ">=", "==", "!=", "<=>" );
b1ddf169 824
a9153838 825sub cmp_ok {
ccbd73a4 826 my( $self, $got, $type, $expect, $name ) = @_;
a9153838
MS
827
828 my $test;
82d700dc 829 my $error;
a9153838 830 {
ccbd73a4
SP
831 ## no critic (BuiltinFunctions::ProhibitStringyEval)
832
833 local( $@, $!, $SIG{__DIE__} ); # isolate eval
b1ddf169 834
82d700dc 835 my($pack, $file, $line) = $self->caller();
b1ddf169 836
82d700dc
SH
837 $test = eval qq[
838#line 1 "cmp_ok [from $file line $line]"
839\$got $type \$expect;
840];
841 $error = $@;
a9153838
MS
842 }
843 local $Level = $Level + 1;
ccbd73a4 844 my $ok = $self->ok( $test, $name );
a9153838 845
82d700dc
SH
846 # Treat overloaded objects as numbers if we're asked to do a
847 # numeric comparison.
848 my $unoverload
849 = $numeric_cmps{$type}
850 ? '_unoverload_num'
851 : '_unoverload_str';
852
853 $self->diag(<<"END") if $error;
854An error occurred while using $type:
855------------------------------------
856$error
857------------------------------------
858END
859
ccbd73a4 860 unless($ok) {
82d700dc
SH
861 $self->$unoverload( \$got, \$expect );
862
a9153838 863 if( $type =~ /^(eq|==)$/ ) {
ccbd73a4
SP
864 $self->_is_diag( $got, $type, $expect );
865 }
866 elsif( $type =~ /^(ne|!=)$/ ) {
867 $self->_isnt_diag( $got, $type );
a9153838
MS
868 }
869 else {
ccbd73a4 870 $self->_cmp_diag( $got, $type, $expect );
a9153838
MS
871 }
872 }
873 return $ok;
874}
875
876sub _cmp_diag {
ccbd73a4
SP
877 my( $self, $got, $type, $expect ) = @_;
878
a9153838
MS
879 $got = defined $got ? "'$got'" : 'undef';
880 $expect = defined $expect ? "'$expect'" : 'undef';
ccbd73a4 881
04955c14 882 local $Level = $Level + 1;
ccbd73a4
SP
883 return $self->diag(<<"DIAGNOSTIC");
884 $got
885 $type
886 $expect
a9153838
MS
887DIAGNOSTIC
888}
889
b1ddf169
RGS
890sub _caller_context {
891 my $self = shift;
892
ccbd73a4 893 my( $pack, $file, $line ) = $self->caller(1);
b1ddf169
RGS
894
895 my $code = '';
896 $code .= "#line $line $file\n" if defined $file and defined $line;
897
898 return $code;
899}
900
c00d8759
SP
901=back
902
903
904=head2 Other Testing Methods
905
906These are methods which are used in the course of writing a test but are not themselves tests.
907
908=over 4
b1ddf169
RGS
909
910=item B<BAIL_OUT>
911
912 $Test->BAIL_OUT($reason);
a9153838
MS
913
914Indicates to the Test::Harness that things are going so badly all
915testing should terminate. This includes running any additional test
916scripts.
917
918It will exit with 255.
919
920=cut
921
b1ddf169 922sub BAIL_OUT {
ccbd73a4 923 my( $self, $reason ) = @_;
a9153838 924
b1ddf169 925 $self->{Bailed_Out} = 1;
a9153838
MS
926 $self->_print("Bail out! $reason");
927 exit 255;
928}
929
b1ddf169
RGS
930=for deprecated
931BAIL_OUT() used to be BAILOUT()
932
845d7e37
SP
933=cut
934
b1ddf169
RGS
935*BAILOUT = \&BAIL_OUT;
936
33459055
MS
937=item B<skip>
938
939 $Test->skip;
940 $Test->skip($why);
941
3e887aae 942Skips the current test, reporting C<$why>.
33459055
MS
943
944=cut
945
946sub skip {
ccbd73a4 947 my( $self, $why ) = @_;
33459055 948 $why ||= '';
ccbd73a4 949 $self->_unoverload_str( \$why );
33459055 950
ccbd73a4 951 lock( $self->{Curr_Test} );
5143c659 952 $self->{Curr_Test}++;
33459055 953
ccbd73a4
SP
954 $self->{Test_Results}[ $self->{Curr_Test} - 1 ] = &share(
955 {
956 'ok' => 1,
957 actual_ok => 1,
958 name => '',
959 type => 'skip',
960 reason => $why,
961 }
962 );
33459055
MS
963
964 my $out = "ok";
ccbd73a4
SP
965 $out .= " $self->{Curr_Test}" if $self->use_numbers;
966 $out .= " # skip";
967 $out .= " $why" if length $why;
968 $out .= "\n";
33459055 969
5143c659 970 $self->_print($out);
33459055
MS
971
972 return 1;
973}
974
a9153838
MS
975=item B<todo_skip>
976
977 $Test->todo_skip;
978 $Test->todo_skip($why);
979
3e887aae 980Like C<skip()>, only it will declare the test as failing and TODO. Similar
a9153838
MS
981to
982
983 print "not ok $tnum # TODO $why\n";
984
985=cut
986
987sub todo_skip {
ccbd73a4 988 my( $self, $why ) = @_;
a9153838
MS
989 $why ||= '';
990
ccbd73a4 991 lock( $self->{Curr_Test} );
5143c659 992 $self->{Curr_Test}++;
a9153838 993
ccbd73a4
SP
994 $self->{Test_Results}[ $self->{Curr_Test} - 1 ] = &share(
995 {
996 'ok' => 1,
997 actual_ok => 0,
998 name => '',
999 type => 'todo_skip',
1000 reason => $why,
1001 }
1002 );
a9153838
MS
1003
1004 my $out = "not ok";
ccbd73a4
SP
1005 $out .= " $self->{Curr_Test}" if $self->use_numbers;
1006 $out .= " # TODO & SKIP $why\n";
a9153838 1007
5143c659 1008 $self->_print($out);
a9153838
MS
1009
1010 return 1;
1011}
1012
33459055
MS
1013=begin _unimplemented
1014
1015=item B<skip_rest>
1016
1017 $Test->skip_rest;
1018 $Test->skip_rest($reason);
1019
3e887aae 1020Like C<skip()>, only it skips all the rest of the tests you plan to run
33459055
MS
1021and terminates the test.
1022
3e887aae 1023If you're running under C<no_plan>, it skips once and terminates the
33459055
MS
1024test.
1025
1026=end _unimplemented
1027
1028=back
1029
1030
c00d8759
SP
1031=head2 Test building utility methods
1032
1033These methods are useful when writing your own test methods.
1034
1035=over 4
1036
1037=item B<maybe_regex>
1038
1039 $Test->maybe_regex(qr/$regex/);
1040 $Test->maybe_regex('/$regex/');
1041
1042Convenience method for building testing functions that take regular
1043expressions as arguments, but need to work before perl 5.005.
1044
3e887aae 1045Takes a quoted regular expression produced by C<qr//>, or a string
c00d8759
SP
1046representing a regular expression.
1047
1048Returns a Perl value which may be used instead of the corresponding
3e887aae 1049regular expression, or C<undef> if its argument is not recognised.
c00d8759 1050
3e887aae 1051For example, a version of C<like()>, sans the useful diagnostic messages,
c00d8759
SP
1052could be written as:
1053
1054 sub laconic_like {
1055 my ($self, $this, $regex, $name) = @_;
1056 my $usable_regex = $self->maybe_regex($regex);
1057 die "expecting regex, found '$regex'\n"
1058 unless $usable_regex;
1059 $self->ok($this =~ m/$usable_regex/, $name);
1060 }
1061
1062=cut
1063
c00d8759 1064sub maybe_regex {
ccbd73a4 1065 my( $self, $regex ) = @_;
c00d8759
SP
1066 my $usable_regex = undef;
1067
1068 return $usable_regex unless defined $regex;
1069
ccbd73a4 1070 my( $re, $opts );
c00d8759
SP
1071
1072 # Check for qr/foo/
bdff39c7 1073 if( _is_qr($regex) ) {
c00d8759
SP
1074 $usable_regex = $regex;
1075 }
1076 # Check for '/foo/' or 'm,foo,'
ccbd73a4
SP
1077 elsif(( $re, $opts ) = $regex =~ m{^ /(.*)/ (\w*) $ }sx or
1078 ( undef, $re, $opts ) = $regex =~ m,^ m([^\w\s]) (.+) \1 (\w*) $,sx
1079 )
c00d8759
SP
1080 {
1081 $usable_regex = length $opts ? "(?$opts)$re" : $re;
1082 }
1083
1084 return $usable_regex;
04955c14
SP
1085}
1086
04955c14
SP
1087sub _is_qr {
1088 my $regex = shift;
ccbd73a4 1089
04955c14
SP
1090 # is_regexp() checks for regexes in a robust manner, say if they're
1091 # blessed.
1092 return re::is_regexp($regex) if defined &re::is_regexp;
1093 return ref $regex eq 'Regexp';
1094}
1095
c00d8759 1096sub _regex_ok {
ccbd73a4 1097 my( $self, $this, $regex, $cmp, $name ) = @_;
c00d8759 1098
ccbd73a4 1099 my $ok = 0;
c00d8759 1100 my $usable_regex = $self->maybe_regex($regex);
ccbd73a4
SP
1101 unless( defined $usable_regex ) {
1102 local $Level = $Level + 1;
c00d8759
SP
1103 $ok = $self->ok( 0, $name );
1104 $self->diag(" '$regex' doesn't look much like a regex to me.");
1105 return $ok;
1106 }
1107
1108 {
ccbd73a4
SP
1109 ## no critic (BuiltinFunctions::ProhibitStringyEval)
1110
c00d8759
SP
1111 my $test;
1112 my $code = $self->_caller_context;
1113
ccbd73a4 1114 local( $@, $!, $SIG{__DIE__} ); # isolate eval
c00d8759 1115
ccbd73a4 1116 # Yes, it has to look like this or 5.4.5 won't see the #line
705e6672 1117 # directive.
c00d8759
SP
1118 # Don't ask me, man, I just work here.
1119 $test = eval "
1120$code" . q{$test = $this =~ /$usable_regex/ ? 1 : 0};
1121
1122 $test = !$test if $cmp eq '!~';
1123
1124 local $Level = $Level + 1;
1125 $ok = $self->ok( $test, $name );
1126 }
1127
ccbd73a4 1128 unless($ok) {
c00d8759
SP
1129 $this = defined $this ? "'$this'" : 'undef';
1130 my $match = $cmp eq '=~' ? "doesn't match" : "matches";
04955c14
SP
1131
1132 local $Level = $Level + 1;
ccbd73a4 1133 $self->diag( sprintf <<'DIAGNOSTIC', $this, $match, $regex );
c00d8759
SP
1134 %s
1135 %13s '%s'
1136DIAGNOSTIC
1137
1138 }
1139
1140 return $ok;
1141}
1142
c00d8759
SP
1143# I'm not ready to publish this. It doesn't deal with array return
1144# values from the code or context.
eb820256 1145
c00d8759
SP
1146=begin private
1147
1148=item B<_try>
1149
1150 my $return_from_code = $Test->try(sub { code });
1151 my($return_from_code, $error) = $Test->try(sub { code });
1152
ccbd73a4 1153Works like eval BLOCK except it ensures it has no effect on the rest
3e887aae
DM
1154of the test (ie. C<$@> is not set) nor is effected by outside
1155interference (ie. C<$SIG{__DIE__}>) and works around some quirks in older
ccbd73a4 1156Perls.
c00d8759 1157
3e887aae 1158C<$error> is what would normally be in C<$@>.
c00d8759
SP
1159
1160It is suggested you use this in place of eval BLOCK.
1161
1162=cut
1163
1164sub _try {
82d700dc 1165 my( $self, $code, %opts ) = @_;
ccbd73a4 1166
82d700dc
SH
1167 my $error;
1168 my $return;
1169 {
1170 local $!; # eval can mess up $!
1171 local $@; # don't set $@ in the test
1172 local $SIG{__DIE__}; # don't trip an outside DIE handler.
1173 $return = eval { $code->() };
1174 $error = $@;
1175 }
1176
1177 die $error if $error and $opts{die_on_fail};
ccbd73a4 1178
82d700dc 1179 return wantarray ? ( $return, $error ) : $return;
c00d8759
SP
1180}
1181
1182=end private
1183
1184
1185=item B<is_fh>
1186
1187 my $is_fh = $Test->is_fh($thing);
1188
3e887aae 1189Determines if the given C<$thing> can be used as a filehandle.
c00d8759
SP
1190
1191=cut
1192
1193sub is_fh {
ccbd73a4 1194 my $self = shift;
c00d8759
SP
1195 my $maybe_fh = shift;
1196 return 0 unless defined $maybe_fh;
1197
ccbd73a4
SP
1198 return 1 if ref $maybe_fh eq 'GLOB'; # its a glob ref
1199 return 1 if ref \$maybe_fh eq 'GLOB'; # its a glob
c00d8759 1200
0753bcb5 1201 return eval { $maybe_fh->isa("IO::Handle") } ||
c00d8759 1202 # 5.5.4's tied() and can() doesn't like getting undef
ccbd73a4 1203 eval { ( tied($maybe_fh) || '' )->can('TIEHANDLE') };
c00d8759
SP
1204}
1205
c00d8759
SP
1206=back
1207
1208
33459055
MS
1209=head2 Test style
1210
c00d8759 1211
33459055
MS
1212=over 4
1213
1214=item B<level>
1215
1216 $Test->level($how_high);
1217
3e887aae 1218How far up the call stack should C<$Test> look when reporting where the
33459055
MS
1219test failed.
1220
1221Defaults to 1.
1222
c00d8759 1223Setting L<$Test::Builder::Level> overrides. This is typically useful
33459055
MS
1224localized:
1225
c00d8759
SP
1226 sub my_ok {
1227 my $test = shift;
1228
1229 local $Test::Builder::Level = $Test::Builder::Level + 1;
1230 $TB->ok($test);
33459055
MS
1231 }
1232
c00d8759
SP
1233To be polite to other functions wrapping your own you usually want to increment C<$Level> rather than set it to a constant.
1234
33459055
MS
1235=cut
1236
1237sub level {
ccbd73a4 1238 my( $self, $level ) = @_;
33459055
MS
1239
1240 if( defined $level ) {
1241 $Level = $level;
1242 }
1243 return $Level;
1244}
1245
33459055
MS
1246=item B<use_numbers>
1247
1248 $Test->use_numbers($on_or_off);
1249
1250Whether or not the test should output numbers. That is, this if true:
1251
1252 ok 1
1253 ok 2
1254 ok 3
1255
1256or this if false
1257
1258 ok
1259 ok
1260 ok
1261
1262Most useful when you can't depend on the test output order, such as
1263when threads or forking is involved.
1264
33459055
MS
1265Defaults to on.
1266
1267=cut
1268
33459055 1269sub use_numbers {
ccbd73a4 1270 my( $self, $use_nums ) = @_;
33459055
MS
1271
1272 if( defined $use_nums ) {
5143c659 1273 $self->{Use_Nums} = $use_nums;
33459055 1274 }
5143c659 1275 return $self->{Use_Nums};
33459055
MS
1276}
1277
b1ddf169 1278=item B<no_diag>
33459055 1279
b1ddf169
RGS
1280 $Test->no_diag($no_diag);
1281
1282If set true no diagnostics will be printed. This includes calls to
3e887aae 1283C<diag()>.
33459055
MS
1284
1285=item B<no_ending>
1286
1287 $Test->no_ending($no_ending);
1288
1289Normally, Test::Builder does some extra diagnostics when the test
30e302f8 1290ends. It also changes the exit code as described below.
33459055
MS
1291
1292If this is true, none of that will be done.
1293
b1ddf169
RGS
1294=item B<no_header>
1295
1296 $Test->no_header($no_header);
1297
1298If set to true, no "1..N" header will be printed.
1299
33459055
MS
1300=cut
1301
b1ddf169
RGS
1302foreach my $attribute (qw(No_Header No_Ending No_Diag)) {
1303 my $method = lc $attribute;
33459055 1304
b1ddf169 1305 my $code = sub {
ccbd73a4 1306 my( $self, $no ) = @_;
33459055 1307
b1ddf169
RGS
1308 if( defined $no ) {
1309 $self->{$attribute} = $no;
1310 }
1311 return $self->{$attribute};
1312 };
33459055 1313
ccbd73a4
SP
1314 no strict 'refs'; ## no critic
1315 *{ __PACKAGE__ . '::' . $method } = $code;
33459055
MS
1316}
1317
33459055
MS
1318=back
1319
1320=head2 Output
1321
1322Controlling where the test output goes.
1323
4bd4e70a 1324It's ok for your test to change where STDOUT and STDERR point to,
71373de2 1325Test::Builder's default output settings will not be affected.
4bd4e70a 1326
33459055
MS
1327=over 4
1328
1329=item B<diag>
1330
1331 $Test->diag(@msgs);
1332
3e887aae 1333Prints out the given C<@msgs>. Like C<print>, arguments are simply
7483b81c
RGS
1334appended together.
1335
3e887aae
DM
1336Normally, it uses the C<failure_output()> handle, but if this is for a
1337TODO test, the C<todo_output()> handle is used.
33459055 1338
71373de2 1339Output will be indented and marked with a # so as not to interfere
a9153838
MS
1340with test output. A newline will be put on the end if there isn't one
1341already.
33459055
MS
1342
1343We encourage using this rather than calling print directly.
1344
3e887aae 1345Returns false. Why? Because C<diag()> is often used in conjunction with
89c1e84a
MS
1346a failing test (C<ok() || diag()>) it "passes through" the failure.
1347
1348 return ok(...) || diag(...);
1349
1350=for blame transfer
1351Mark Fowler <mark@twoshortplanks.com>
1352
33459055
MS
1353=cut
1354
1355sub diag {
ccbd73a4
SP
1356 my $self = shift;
1357
1358 $self->_print_comment( $self->_diag_fh, @_ );
1359}
1360
1361=item B<note>
1362
1363 $Test->note(@msgs);
1364
3e887aae 1365Like C<diag()>, but it prints to the C<output()> handle so it will not
ccbd73a4
SP
1366normally be seen by the user except in verbose mode.
1367
1368=cut
1369
1370sub note {
1371 my $self = shift;
1372
1373 $self->_print_comment( $self->output, @_ );
1374}
1375
1376sub _diag_fh {
1377 my $self = shift;
1378
1379 local $Level = $Level + 1;
1380 return $self->in_todo ? $self->todo_output : $self->failure_output;
1381}
1382
1383sub _print_comment {
1384 my( $self, $fh, @msgs ) = @_;
b1ddf169
RGS
1385
1386 return if $self->no_diag;
a9153838 1387 return unless @msgs;
33459055 1388
4bd4e70a 1389 # Prevent printing headers when compiling (i.e. -c)
33459055
MS
1390 return if $^C;
1391
7483b81c
RGS
1392 # Smash args together like print does.
1393 # Convert undef to 'undef' so its readable.
1394 my $msg = join '', map { defined($_) ? $_ : 'undef' } @msgs;
1395
ccbd73a4
SP
1396 # Escape the beginning, _print will take care of the rest.
1397 $msg =~ s/^/# /;
a9153838 1398
33459055 1399 local $Level = $Level + 1;
ccbd73a4 1400 $self->_print_to_fh( $fh, $msg );
89c1e84a
MS
1401
1402 return 0;
33459055
MS
1403}
1404
ccbd73a4
SP
1405=item B<explain>
1406
1407 my @dump = $Test->explain(@msgs);
1408
1409Will dump the contents of any references in a human readable format.
1410Handy for things like...
1411
1412 is_deeply($have, $want) || diag explain $have;
1413
1414or
1415
1416 is_deeply($have, $want) || note explain $have;
1417
1418=cut
1419
1420sub explain {
1421 my $self = shift;
1422
1423 return map {
1424 ref $_
1425 ? do {
82d700dc 1426 $self->_try(sub { require Data::Dumper }, die_on_fail => 1);
ccbd73a4
SP
1427
1428 my $dumper = Data::Dumper->new( [$_] );
1429 $dumper->Indent(1)->Terse(1);
1430 $dumper->Sortkeys(1) if $dumper->can("Sortkeys");
1431 $dumper->Dump;
1432 }
1433 : $_
1434 } @_;
1435}
1436
33459055
MS
1437=begin _private
1438
1439=item B<_print>
1440
1441 $Test->_print(@msgs);
1442
3e887aae 1443Prints to the C<output()> filehandle.
33459055
MS
1444
1445=end _private
1446
1447=cut
1448
1449sub _print {
ccbd73a4
SP
1450 my $self = shift;
1451 return $self->_print_to_fh( $self->output, @_ );
1452}
1453
1454sub _print_to_fh {
1455 my( $self, $fh, @msgs ) = @_;
33459055
MS
1456
1457 # Prevent printing headers when only compiling. Mostly for when
1458 # tests are deparsed with B::Deparse
1459 return if $^C;
1460
7483b81c
RGS
1461 my $msg = join '', @msgs;
1462
ccbd73a4 1463 local( $\, $", $, ) = ( undef, ' ', '' );
89c1e84a
MS
1464
1465 # Escape each line after the first with a # so we don't
1466 # confuse Test::Harness.
82d700dc 1467 $msg =~ s{\n(?!\z)}{\n# }sg;
89c1e84a 1468
7483b81c 1469 # Stick a newline on the end if it needs it.
82d700dc 1470 $msg .= "\n" unless $msg =~ /\n\z/;
89c1e84a 1471
ccbd73a4 1472 return print $fh $msg;
33459055
MS
1473}
1474
33459055
MS
1475=item B<output>
1476
3e887aae 1477=item B<failure_output>
33459055 1478
3e887aae 1479=item B<todo_output>
33459055 1480
3e887aae
DM
1481 my $filehandle = $Test->output;
1482 $Test->output($filehandle);
1483 $Test->output($filename);
1484 $Test->output(\$scalar);
33459055 1485
3e887aae
DM
1486These methods control where Test::Builder will print its output.
1487They take either an open C<$filehandle>, a C<$filename> to open and write to
1488or a C<$scalar> reference to append to. It will always return a C<$filehandle>.
33459055 1489
3e887aae 1490B<output> is where normal "ok/not ok" test output goes.
33459055 1491
3e887aae 1492Defaults to STDOUT.
33459055 1493
3e887aae
DM
1494B<failure_output> is where diagnostic output on test failures and
1495C<diag()> goes. It is normally not read by Test::Harness and instead is
1496displayed to the user.
33459055 1497
3e887aae 1498Defaults to STDERR.
33459055 1499
3e887aae
DM
1500C<todo_output> is used instead of C<failure_output()> for the
1501diagnostics of a failing TODO test. These will not be seen by the
1502user.
33459055
MS
1503
1504Defaults to STDOUT.
1505
1506=cut
1507
33459055 1508sub output {
ccbd73a4 1509 my( $self, $fh ) = @_;
33459055
MS
1510
1511 if( defined $fh ) {
b7f9bbeb 1512 $self->{Out_FH} = $self->_new_fh($fh);
33459055 1513 }
5143c659 1514 return $self->{Out_FH};
33459055
MS
1515}
1516
1517sub failure_output {
ccbd73a4 1518 my( $self, $fh ) = @_;
33459055
MS
1519
1520 if( defined $fh ) {
b7f9bbeb 1521 $self->{Fail_FH} = $self->_new_fh($fh);
33459055 1522 }
5143c659 1523 return $self->{Fail_FH};
33459055
MS
1524}
1525
1526sub todo_output {
ccbd73a4 1527 my( $self, $fh ) = @_;
33459055
MS
1528
1529 if( defined $fh ) {
b7f9bbeb 1530 $self->{Todo_FH} = $self->_new_fh($fh);
33459055 1531 }
5143c659 1532 return $self->{Todo_FH};
33459055
MS
1533}
1534
1535sub _new_fh {
b7f9bbeb 1536 my $self = shift;
33459055
MS
1537 my($file_or_fh) = shift;
1538
1539 my $fh;
c00d8759 1540 if( $self->is_fh($file_or_fh) ) {
0257f296
RGS
1541 $fh = $file_or_fh;
1542 }
3e887aae
DM
1543 elsif( ref $file_or_fh eq 'SCALAR' ) {
1544 # Scalar refs as filehandles was added in 5.8.
1545 if( $] >= 5.008 ) {
1546 open $fh, ">>", $file_or_fh
1547 or $self->croak("Can't open scalar ref $file_or_fh: $!");
1548 }
1549 # Emulate scalar ref filehandles with a tie.
1550 else {
1551 $fh = Test::Builder::IO::Scalar->new($file_or_fh)
1552 or $self->croak("Can't tie scalar ref $file_or_fh");
1553 }
1554 }
0257f296 1555 else {
ccbd73a4
SP
1556 open $fh, ">", $file_or_fh
1557 or $self->croak("Can't open test output log $file_or_fh: $!");
705e6672 1558 _autoflush($fh);
33459055 1559 }
33459055
MS
1560
1561 return $fh;
1562}
1563
30e302f8
NC
1564sub _autoflush {
1565 my($fh) = shift;
1566 my $old_fh = select $fh;
1567 $| = 1;
1568 select $old_fh;
ccbd73a4
SP
1569
1570 return;
30e302f8
NC
1571}
1572
ccbd73a4 1573my( $Testout, $Testerr );
30e302f8 1574
30e302f8
NC
1575sub _dup_stdhandles {
1576 my $self = shift;
1577
5143c659 1578 $self->_open_testhandles;
a9153838
MS
1579
1580 # Set everything to unbuffered else plain prints to STDOUT will
1581 # come out in the wrong order from our own prints.
04955c14 1582 _autoflush($Testout);
ccbd73a4 1583 _autoflush( \*STDOUT );
04955c14 1584 _autoflush($Testerr);
ccbd73a4 1585 _autoflush( \*STDERR );
a9153838 1586
ccbd73a4 1587 $self->reset_outputs;
33459055 1588
ccbd73a4
SP
1589 return;
1590}
5143c659 1591
30e302f8 1592sub _open_testhandles {
04955c14 1593 my $self = shift;
ccbd73a4 1594
3e887aae 1595 return if $self->{Opened_Testhandles};
ccbd73a4 1596
30e302f8
NC
1597 # We dup STDOUT and STDERR so people can change them in their
1598 # test suites while still getting normal test output.
ccbd73a4
SP
1599 open( $Testout, ">&STDOUT" ) or die "Can't dup STDOUT: $!";
1600 open( $Testerr, ">&STDERR" ) or die "Can't dup STDERR: $!";
1601
1602 # $self->_copy_io_layers( \*STDOUT, $Testout );
1603 # $self->_copy_io_layers( \*STDERR, $Testerr );
04955c14 1604
3e887aae 1605 $self->{Opened_Testhandles} = 1;
33459055 1606
ccbd73a4
SP
1607 return;
1608}
33459055 1609
04955c14 1610sub _copy_io_layers {
ccbd73a4
SP
1611 my( $self, $src, $dst ) = @_;
1612
1613 $self->_try(
1614 sub {
1615 require PerlIO;
1616 my @src_layers = PerlIO::get_layers($src);
1617
1618 binmode $dst, join " ", map ":$_", @src_layers if @src_layers;
1619 }
1620 );
1621
1622 return;
1623}
1624
1625=item reset_outputs
1626
1627 $tb->reset_outputs;
1628
1629Resets all the output filehandles back to their defaults.
1630
1631=cut
1632
1633sub reset_outputs {
1634 my $self = shift;
bdff39c7 1635
ccbd73a4
SP
1636 $self->output ($Testout);
1637 $self->failure_output($Testerr);
1638 $self->todo_output ($Testout);
1639
1640 return;
04955c14
SP
1641}
1642
b7f9bbeb
SP
1643=item carp
1644
1645 $tb->carp(@message);
1646
1647Warns with C<@message> but the message will appear to come from the
3e887aae 1648point where the original test function was called (C<< $tb->caller >>).
b7f9bbeb
SP
1649
1650=item croak
1651
1652 $tb->croak(@message);
1653
1654Dies with C<@message> but the message will appear to come from the
3e887aae 1655point where the original test function was called (C<< $tb->caller >>).
b7f9bbeb
SP
1656
1657=cut
1658
1659sub _message_at_caller {
1660 my $self = shift;
1661
004caa16 1662 local $Level = $Level + 1;
ccbd73a4
SP
1663 my( $pack, $file, $line ) = $self->caller;
1664 return join( "", @_ ) . " at $file line $line.\n";
b7f9bbeb
SP
1665}
1666
1667sub carp {
1668 my $self = shift;
ccbd73a4 1669 return warn $self->_message_at_caller(@_);
b7f9bbeb
SP
1670}
1671
1672sub croak {
1673 my $self = shift;
ccbd73a4 1674 return die $self->_message_at_caller(@_);
b7f9bbeb
SP
1675}
1676
b7f9bbeb 1677
33459055
MS
1678=back
1679
1680
1681=head2 Test Status and Info
1682
1683=over 4
1684
1685=item B<current_test>
1686
1687 my $curr_test = $Test->current_test;
1688 $Test->current_test($num);
1689
0257f296
RGS
1690Gets/sets the current test number we're on. You usually shouldn't
1691have to set this.
33459055 1692
0257f296
RGS
1693If set forward, the details of the missing tests are filled in as 'unknown'.
1694if set backward, the details of the intervening tests are deleted. You
1695can erase history if you really want to.
33459055
MS
1696
1697=cut
1698
1699sub current_test {
ccbd73a4 1700 my( $self, $num ) = @_;
33459055 1701
ccbd73a4 1702 lock( $self->{Curr_Test} );
33459055 1703 if( defined $num ) {
5143c659 1704 $self->{Curr_Test} = $num;
0257f296
RGS
1705
1706 # If the test counter is being pushed forward fill in the details.
5143c659
RGS
1707 my $test_results = $self->{Test_Results};
1708 if( $num > @$test_results ) {
1709 my $start = @$test_results ? @$test_results : 0;
ccbd73a4
SP
1710 for( $start .. $num - 1 ) {
1711 $test_results->[$_] = &share(
1712 {
1713 'ok' => 1,
1714 actual_ok => undef,
1715 reason => 'incrementing test number',
1716 type => 'unknown',
1717 name => undef
1718 }
1719 );
6686786d
MS
1720 }
1721 }
0257f296 1722 # If backward, wipe history. Its their funeral.
5143c659
RGS
1723 elsif( $num < @$test_results ) {
1724 $#{$test_results} = $num - 1;
0257f296 1725 }
33459055 1726 }
5143c659 1727 return $self->{Curr_Test};
33459055
MS
1728}
1729
33459055
MS
1730=item B<summary>
1731
1732 my @tests = $Test->summary;
1733
1734A simple summary of the tests so far. True for pass, false for fail.
1735This is a logical pass/fail, so todos are passes.
1736
1737Of course, test #1 is $tests[0], etc...
1738
1739=cut
1740
1741sub summary {
1742 my($self) = shift;
1743
5143c659 1744 return map { $_->{'ok'} } @{ $self->{Test_Results} };
33459055
MS
1745}
1746
60ffb308 1747=item B<details>
33459055
MS
1748
1749 my @tests = $Test->details;
1750
3e887aae 1751Like C<summary()>, but with a lot more detail.
33459055
MS
1752
1753 $tests[$test_num - 1] =
60ffb308 1754 { 'ok' => is the test considered a pass?
33459055
MS
1755 actual_ok => did it literally say 'ok'?
1756 name => name of the test (if any)
60ffb308 1757 type => type of test (if any, see below).
33459055
MS
1758 reason => reason for the above (if any)
1759 };
1760
60ffb308
MS
1761'ok' is true if Test::Harness will consider the test to be a pass.
1762
1763'actual_ok' is a reflection of whether or not the test literally
1764printed 'ok' or 'not ok'. This is for examining the result of 'todo'
3e887aae 1765tests.
60ffb308
MS
1766
1767'name' is the name of the test.
1768
1769'type' indicates if it was a special test. Normal tests have a type
1770of ''. Type can be one of the following:
1771
1772 skip see skip()
1773 todo see todo()
1774 todo_skip see todo_skip()
1775 unknown see below
1776
1777Sometimes the Test::Builder test counter is incremented without it
3e887aae 1778printing any test output, for example, when C<current_test()> is changed.
60ffb308 1779In these cases, Test::Builder doesn't know the result of the test, so
ccbd73a4 1780its type is 'unknown'. These details for these tests are filled in.
3e887aae 1781They are considered ok, but the name and actual_ok is left C<undef>.
60ffb308
MS
1782
1783For example "not ok 23 - hole count # TODO insufficient donuts" would
1784result in this structure:
1785
1786 $tests[22] = # 23 - 1, since arrays start from 0.
3e887aae 1787 { ok => 1, # logically, the test passed since its todo
60ffb308
MS
1788 actual_ok => 0, # in absolute terms, it failed
1789 name => 'hole count',
1790 type => 'todo',
1791 reason => 'insufficient donuts'
1792 };
1793
1794=cut
1795
1796sub details {
5143c659
RGS
1797 my $self = shift;
1798 return @{ $self->{Test_Results} };
60ffb308
MS
1799}
1800
33459055
MS
1801=item B<todo>
1802
1803 my $todo_reason = $Test->todo;
1804 my $todo_reason = $Test->todo($pack);
1805
ccbd73a4 1806If the current tests are considered "TODO" it will return the reason,
3e887aae
DM
1807if any. This reason can come from a C<$TODO> variable or the last call
1808to C<todo_start()>.
ccbd73a4
SP
1809
1810Since a TODO test does not need a reason, this function can return an
3e887aae 1811empty string even when inside a TODO block. Use C<< $Test->in_todo >>
ccbd73a4 1812to determine if you are currently inside a TODO block.
33459055 1813
3e887aae 1814C<todo()> is about finding the right package to look for C<$TODO> in. It's
04955c14
SP
1815pretty good at guessing the right package to look at. It first looks for
1816the caller based on C<$Level + 1>, since C<todo()> is usually called inside
1817a test function. As a last resort it will use C<exported_to()>.
33459055
MS
1818
1819Sometimes there is some confusion about where todo() should be looking
3e887aae 1820for the C<$TODO> variable. If you want to be sure, tell it explicitly
33459055
MS
1821what $pack to use.
1822
1823=cut
1824
1825sub todo {
ccbd73a4
SP
1826 my( $self, $pack ) = @_;
1827
1828 return $self->{Todo} if defined $self->{Todo};
1829
1830 local $Level = $Level + 1;
1831 my $todo = $self->find_TODO($pack);
1832 return $todo if defined $todo;
1833
1834 return '';
1835}
1836
1837=item B<find_TODO>
33459055 1838
ccbd73a4
SP
1839 my $todo_reason = $Test->find_TODO();
1840 my $todo_reason = $Test->find_TODO($pack):
1841
3e887aae
DM
1842Like C<todo()> but only returns the value of C<$TODO> ignoring
1843C<todo_start()>.
ccbd73a4
SP
1844
1845=cut
1846
1847sub find_TODO {
1848 my( $self, $pack ) = @_;
04955c14
SP
1849
1850 $pack = $pack || $self->caller(1) || $self->exported_to;
ccbd73a4 1851 return unless $pack;
33459055 1852
ccbd73a4
SP
1853 no strict 'refs'; ## no critic
1854 return ${ $pack . '::TODO' };
1855}
1856
1857=item B<in_todo>
1858
1859 my $in_todo = $Test->in_todo;
1860
1861Returns true if the test is currently inside a TODO block.
1862
1863=cut
1864
1865sub in_todo {
1866 my $self = shift;
1867
1868 local $Level = $Level + 1;
1869 return( defined $self->{Todo} || $self->find_TODO ) ? 1 : 0;
1870}
1871
1872=item B<todo_start>
1873
1874 $Test->todo_start();
1875 $Test->todo_start($message);
1876
1877This method allows you declare all subsequent tests as TODO tests, up until
1878the C<todo_end> method has been called.
1879
1880The C<TODO:> and C<$TODO> syntax is generally pretty good about figuring out
1881whether or not we're in a TODO test. However, often we find that this is not
1882possible to determine (such as when we want to use C<$TODO> but
1883the tests are being executed in other packages which can't be inferred
1884beforehand).
1885
1886Note that you can use this to nest "todo" tests
1887
1888 $Test->todo_start('working on this');
1889 # lots of code
1890 $Test->todo_start('working on that');
1891 # more code
1892 $Test->todo_end;
1893 $Test->todo_end;
1894
1895This is generally not recommended, but large testing systems often have weird
1896internal needs.
1897
1898We've tried to make this also work with the TODO: syntax, but it's not
1899guaranteed and its use is also discouraged:
1900
1901 TODO: {
1902 local $TODO = 'We have work to do!';
1903 $Test->todo_start('working on this');
1904 # lots of code
1905 $Test->todo_start('working on that');
1906 # more code
1907 $Test->todo_end;
1908 $Test->todo_end;
1909 }
1910
1911Pick one style or another of "TODO" to be on the safe side.
1912
1913=cut
1914
1915sub todo_start {
1916 my $self = shift;
1917 my $message = @_ ? shift : '';
1918
1919 $self->{Start_Todo}++;
1920 if( $self->in_todo ) {
1921 push @{ $self->{Todo_Stack} } => $self->todo;
1922 }
1923 $self->{Todo} = $message;
1924
1925 return;
1926}
1927
1928=item C<todo_end>
1929
1930 $Test->todo_end;
1931
1932Stops running tests as "TODO" tests. This method is fatal if called without a
1933preceding C<todo_start> method call.
1934
1935=cut
1936
1937sub todo_end {
1938 my $self = shift;
1939
1940 if( !$self->{Start_Todo} ) {
1941 $self->croak('todo_end() called without todo_start()');
1942 }
1943
1944 $self->{Start_Todo}--;
1945
1946 if( $self->{Start_Todo} && @{ $self->{Todo_Stack} } ) {
1947 $self->{Todo} = pop @{ $self->{Todo_Stack} };
1948 }
1949 else {
1950 delete $self->{Todo};
1951 }
1952
1953 return;
33459055
MS
1954}
1955
1956=item B<caller>
1957
1958 my $package = $Test->caller;
1959 my($pack, $file, $line) = $Test->caller;
1960 my($pack, $file, $line) = $Test->caller($height);
1961
3e887aae 1962Like the normal C<caller()>, except it reports according to your C<level()>.
33459055 1963
3e887aae 1964C<$height> will be added to the C<level()>.
04955c14 1965
3e887aae 1966If C<caller()> winds up off the top of the stack it report the highest context.
82d700dc 1967
33459055
MS
1968=cut
1969
ccbd73a4
SP
1970sub caller { ## no critic (Subroutines::ProhibitBuiltinHomonyms)
1971 my( $self, $height ) = @_;
33459055 1972 $height ||= 0;
a344be10 1973
82d700dc
SH
1974 my $level = $self->level + $height + 1;
1975 my @caller;
1976 do {
1977 @caller = CORE::caller( $level );
1978 $level--;
1979 } until @caller;
33459055
MS
1980 return wantarray ? @caller : $caller[0];
1981}
1982
1983=back
1984
1985=cut
1986
1987=begin _private
1988
1989=over 4
1990
1991=item B<_sanity_check>
1992
5143c659 1993 $self->_sanity_check();
33459055
MS
1994
1995Runs a bunch of end of test sanity checks to make sure reality came
1996through ok. If anything is wrong it will die with a fairly friendly
1997error message.
1998
1999=cut
2000
2001#'#
2002sub _sanity_check {
5143c659
RGS
2003 my $self = shift;
2004
ccbd73a4 2005 $self->_whoa( $self->{Curr_Test} < 0, 'Says here you ran a negative number of tests!' );
ccbd73a4
SP
2006 $self->_whoa( $self->{Curr_Test} != @{ $self->{Test_Results} },
2007 'Somehow you got a different number of results than tests ran!' );
2008
2009 return;
33459055
MS
2010}
2011
2012=item B<_whoa>
2013
b7f9bbeb 2014 $self->_whoa($check, $description);
33459055 2015
3e887aae
DM
2016A sanity check, similar to C<assert()>. If the C<$check> is true, something
2017has gone horribly wrong. It will die with the given C<$description> and
33459055
MS
2018a note to contact the author.
2019
2020=cut
2021
2022sub _whoa {
ccbd73a4
SP
2023 my( $self, $check, $desc ) = @_;
2024 if($check) {
b7f9bbeb
SP
2025 local $Level = $Level + 1;
2026 $self->croak(<<"WHOA");
33459055
MS
2027WHOA! $desc
2028This should never happen! Please contact the author immediately!
2029WHOA
2030 }
ccbd73a4
SP
2031
2032 return;
33459055
MS
2033}
2034
2035=item B<_my_exit>
2036
2037 _my_exit($exit_num);
2038
3e887aae
DM
2039Perl seems to have some trouble with exiting inside an C<END> block. 5.005_03
2040and 5.6.1 both seem to do odd things. Instead, this function edits C<$?>
2041directly. It should B<only> be called from inside an C<END> block. It
33459055
MS
2042doesn't actually exit, that's your job.
2043
2044=cut
2045
2046sub _my_exit {
ccbd73a4 2047 $? = $_[0]; ## no critic (Variables::RequireLocalizedPunctuationVars)
33459055
MS
2048
2049 return 1;
2050}
2051
33459055
MS
2052=back
2053
2054=end _private
2055
2056=cut
2057
33459055
MS
2058sub _ending {
2059 my $self = shift;
2060
04955c14 2061 my $real_exit_code = $?;
33459055 2062
60ffb308
MS
2063 # Don't bother with an ending if this is a forked copy. Only the parent
2064 # should do the ending.
04955c14
SP
2065 if( $self->{Original_Pid} != $$ ) {
2066 return;
2067 }
ccbd73a4 2068
3e887aae
DM
2069 # Ran tests but never declared a plan or hit done_testing
2070 if( !$self->{Have_Plan} and $self->{Curr_Test} ) {
2071 $self->diag("Tests were run but no plan was declared and done_testing() was not seen.");
2072 }
2073
ccbd73a4 2074 # Exit if plan() was never called. This is so "require Test::Simple"
5143c659 2075 # doesn't puke.
04955c14
SP
2076 if( !$self->{Have_Plan} ) {
2077 return;
2078 }
2079
b1ddf169 2080 # Don't do an ending if we bailed out.
04955c14
SP
2081 if( $self->{Bailed_Out} ) {
2082 return;
5143c659 2083 }
33459055
MS
2084
2085 # Figure out if we passed or failed and print helpful messages.
5143c659 2086 my $test_results = $self->{Test_Results};
ccbd73a4 2087 if(@$test_results) {
33459055 2088 # The plan? We have no plan.
5143c659 2089 if( $self->{No_Plan} ) {
3e887aae 2090 $self->_output_plan($self->{Curr_Test}) unless $self->no_header;
5143c659 2091 $self->{Expected_Tests} = $self->{Curr_Test};
33459055
MS
2092 }
2093
30e302f8
NC
2094 # Auto-extended arrays and elements which aren't explicitly
2095 # filled in with a shared reference will puke under 5.8.0
2096 # ithreads. So we have to fill them in by hand. :(
ccbd73a4
SP
2097 my $empty_result = &share( {} );
2098 for my $idx ( 0 .. $self->{Expected_Tests} - 1 ) {
5143c659
RGS
2099 $test_results->[$idx] = $empty_result
2100 unless defined $test_results->[$idx];
60ffb308 2101 }
a344be10 2102
ccbd73a4 2103 my $num_failed = grep !$_->{'ok'}, @{$test_results}[ 0 .. $self->{Curr_Test} - 1 ];
33459055 2104
b1ddf169
RGS
2105 my $num_extra = $self->{Curr_Test} - $self->{Expected_Tests};
2106
ccbd73a4 2107 if( $num_extra != 0 ) {
5143c659 2108 my $s = $self->{Expected_Tests} == 1 ? '' : 's';
33459055 2109 $self->diag(<<"FAIL");
ccbd73a4 2110Looks like you planned $self->{Expected_Tests} test$s but ran $self->{Curr_Test}.
33459055
MS
2111FAIL
2112 }
b1ddf169 2113
ccbd73a4 2114 if($num_failed) {
b1ddf169 2115 my $num_tests = $self->{Curr_Test};
30e302f8 2116 my $s = $num_failed == 1 ? '' : 's';
b1ddf169
RGS
2117
2118 my $qualifier = $num_extra == 0 ? '' : ' run';
2119
33459055 2120 $self->diag(<<"FAIL");
b1ddf169 2121Looks like you failed $num_failed test$s of $num_tests$qualifier.
33459055
MS
2122FAIL
2123 }
2124
ccbd73a4 2125 if($real_exit_code) {
33459055 2126 $self->diag(<<"FAIL");
ccbd73a4 2127Looks like your test exited with $real_exit_code just after $self->{Curr_Test}.
33459055
MS
2128FAIL
2129
ccbd73a4 2130 _my_exit($real_exit_code) && return;
33459055
MS
2131 }
2132
b1ddf169 2133 my $exit_code;
ccbd73a4 2134 if($num_failed) {
b1ddf169
RGS
2135 $exit_code = $num_failed <= 254 ? $num_failed : 254;
2136 }
2137 elsif( $num_extra != 0 ) {
2138 $exit_code = 255;
2139 }
2140 else {
2141 $exit_code = 0;
2142 }
2143
ccbd73a4 2144 _my_exit($exit_code) && return;
33459055 2145 }
ccbd73a4
SP
2146 elsif( $self->{Skip_All} ) {
2147 _my_exit(0) && return;
33459055 2148 }
ccbd73a4
SP
2149 elsif($real_exit_code) {
2150 $self->diag(<<"FAIL");
2151Looks like your test exited with $real_exit_code before it could output anything.
60ffb308 2152FAIL
ccbd73a4 2153 _my_exit($real_exit_code) && return;
60ffb308 2154 }
33459055 2155 else {
a9153838 2156 $self->diag("No tests run!\n");
ccbd73a4 2157 _my_exit(255) && return;
33459055 2158 }
ccbd73a4
SP
2159
2160 $self->_whoa( 1, "We fell off the end of _ending()" );
33459055
MS
2161}
2162
2163END {
2164 $Test->_ending if defined $Test and !$Test->no_ending;
2165}
2166
30e302f8
NC
2167=head1 EXIT CODES
2168
2169If all your tests passed, Test::Builder will exit with zero (which is
2170normal). If anything failed it will exit with how many failed. If
2171you run less (or more) tests than you planned, the missing (or extras)
2172will be considered failures. If no tests were ever run Test::Builder
2173will throw a warning and exit with 255. If the test died, even after
2174having successfully completed all its tests, it will still be
2175considered a failure and will exit with 255.
2176
2177So the exit codes are...
2178
2179 0 all tests successful
b1ddf169 2180 255 test died or all passed but wrong # of tests run
30e302f8
NC
2181 any other number how many failed (including missing or extras)
2182
2183If you fail more than 254 tests, it will be reported as 254.
2184
a344be10
MS
2185=head1 THREADS
2186
b7f9bbeb 2187In perl 5.8.1 and later, Test::Builder is thread-safe. The test
a344be10 2188number is shared amongst all threads. This means if one thread sets
3e887aae 2189the test number using C<current_test()> they will all be effected.
a344be10 2190
b7f9bbeb
SP
2191While versions earlier than 5.8.1 had threads they contain too many
2192bugs to support.
2193
30e302f8
NC
2194Test::Builder is only thread-aware if threads.pm is loaded I<before>
2195Test::Builder.
2196
3e887aae
DM
2197=head1 MEMORY
2198
2199An informative hash, accessable via C<<details()>>, is stored for each
2200test you perform. So memory usage will scale linearly with each test
2201run. Although this is not a problem for most test suites, it can
2202become an issue if you do large (hundred thousands to million)
2203combinatorics tests in the same run.
2204
2205In such cases, you are advised to either split the test file into smaller
2206ones, or use a reverse approach, doing "normal" (code) compares and
2207triggering fail() should anything go unexpected.
2208
2209Future versions of Test::Builder will have a way to turn history off.
2210
2211
33459055
MS
2212=head1 EXAMPLES
2213
a344be10
MS
2214CPAN can provide the best examples. Test::Simple, Test::More,
2215Test::Exception and Test::Differences all use Test::Builder.
33459055 2216
4bd4e70a
JH
2217=head1 SEE ALSO
2218
2219Test::Simple, Test::More, Test::Harness
2220
2221=head1 AUTHORS
33459055
MS
2222
2223Original code by chromatic, maintained by Michael G Schwern
2224E<lt>schwern@pobox.comE<gt>
2225
4bd4e70a 2226=head1 COPYRIGHT
33459055 2227
ccbd73a4
SP
2228Copyright 2002-2008 by chromatic E<lt>chromatic@wgz.orgE<gt> and
2229 Michael G Schwern E<lt>schwern@pobox.comE<gt>.
4bd4e70a 2230
3e887aae 2231This program is free software; you can redistribute it and/or
4bd4e70a
JH
2232modify it under the same terms as Perl itself.
2233
a9153838 2234See F<http://www.perl.com/perl/misc/Artistic.html>
33459055
MS
2235
2236=cut
2237
22381;
ccbd73a4 2239