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 $CLASS);
14 my $IsVMS = $^O eq 'VMS';
17 my @Test_Results = ();
18 my @Test_Details = ();
26 Test::Builder - Backend for building test libraries
30 package My::Test::Module;
36 my $Test = Test::Builder->new;
37 $Test->output('my_logfile');
43 $Test->exported_to($pack);
46 $self->export_to_level(1, $self, 'ok');
50 my($test, $name) = @_;
52 $Test->ok($test, $name);
58 I<THIS IS ALPHA GRADE SOFTWARE> The interface will change.
60 Test::Simple and Test::More have proven to be popular testing modules,
61 but they're not always flexible enough. Test::Builder provides the
62 a building block upon which to write your own test libraries.
70 my $Test = Test::Builder->new;
72 Returns a Test::Builder object representing the current state of the
75 Since you only run one test per program, there is B<one and only one>
76 Test::Builder object. No matter how many times you call new(), you're
77 getting the same object. (This is called a singleton).
84 $Test ||= bless ['Move along, nothing to see here'], $class;
90 =head2 Setting up tests
92 These methods are for setting up tests and declaring how many there
93 are. You usually only want to call one of these methods.
99 my $pack = $Test->exported_to;
100 $Test->exported_to($pack);
102 Tells Test::Builder what package you exported your functions to.
103 This is important for getting TODO tests right.
109 my($self, $pack) = @_;
111 if( defined $pack ) {
112 $Exported_To = $pack;
119 $Test->plan('no_plan');
120 $Test->plan( skip_all => $reason );
121 $Test->plan( tests => $num_tests );
123 A convenient way to set up your tests. Call this and Test::Builder
124 will print the appropriate headers and take the appropriate actions.
126 If you call plan(), don't call any of the other methods below.
131 my($self, $cmd, $arg) = @_;
135 if( $cmd eq 'no_plan' ) {
138 elsif( $cmd eq 'skip_all' ) {
139 return $self->skip_all($arg);
141 elsif( $cmd eq 'tests' ) {
143 return $self->expected_tests($arg);
145 elsif( !defined $arg ) {
146 die "Got an undefined number of tests. Looks like you tried to ".
147 "say how many tests you plan to run but made a mistake.\n";
150 die "You said to run 0 tests! You've got to run something.\n";
155 =item B<expected_tests>
157 my $max = $Test->expected_tests;
158 $Test->expected_tests($max);
160 Gets/sets the # of tests we expect this test to run and prints out
161 the appropriate headers.
165 my $Expected_Tests = 0;
167 my($self, $max) = @_;
170 $Expected_Tests = $max;
173 $self->_print("1..$max\n") unless $self->no_header;
175 return $Expected_Tests;
183 Declares that this test will run an indeterminate # of tests.
196 $Test->skip_all($reason);
198 Skips all the tests, using the given $reason. Exits immediately with 0.
204 my($self, $reason) = @_;
207 $out .= " # Skip $reason" if $reason;
212 $self->_print($out) unless $self->no_header;
220 These actually run the tests, analogous to the functions in
223 $name is always optional.
229 $Test->ok($test, $name);
231 Your basic test. Pass if $test is true, fail if $test is false. Just
232 like Test::Simple's ok().
237 my($self, $test, $name) = @_;
239 unless( $Have_Plan ) {
240 die "You tried to run a test without a plan! Gotta have a plan.\n";
245 $self->diag(<<ERR) if defined $name and $name =~ /^[\d\s]+$/;
246 You named your test '$name'. You shouldn't use numbers for your test names.
250 my($pack, $file, $line) = $self->caller;
252 my $todo = $self->todo($pack);
257 $Test_Results[$Curr_Test-1] = $todo ? 1 : 0;
260 $Test_Results[$Curr_Test-1] = 1;
264 $out .= " $Curr_Test" if $self->use_numbers;
266 if( defined $name ) {
267 $name =~ s|#|\\#|g; # # in a name can confuse Test::Harness.
272 my $what_todo = $todo;
273 $out .= " # TODO $what_todo";
281 my $msg = $todo ? "Failed (TODO)" : "Failed";
282 $self->diag("$msg test ($file at line $line)\n");
285 return $test ? 1 : 0;
290 $Test->is_eq($got, $expected, $name);
292 Like Test::More's is(). Checks if $got eq $expected. This is the
297 $Test->is_num($get, $expected, $name);
299 Like Test::More's is(). Checks if $got == $expected. This is the
306 local $Level = $Level + 1;
307 return $self->_is('eq', @_);
312 local $Level = $Level + 1;
313 return $self->_is('==', @_);
317 my($self, $type, $got, $expect, $name) = @_;
321 local $^W = 0; # so we can compare undef quietly
322 $test = $type eq 'eq' ? $got eq $expect
325 local $Level = $Level + 1;
326 my $ok = $self->ok($test, $name);
329 $got = defined $got ? "'$got'" : 'undef';
330 $expect = defined $expect ? "'$expect'" : 'undef';
331 $self->diag(sprintf <<DIAGNOSTIC, $got, $expect);
342 $Test->like($this, qr/$regex/, $name);
343 $Test->like($this, '/$regex/', $name);
345 Like Test::More's like(). Checks if $this matches the given $regex.
347 You'll want to avoid qr// if you want your tests to work before 5.005.
352 my($self, $this, $regex, $name) = @_;
354 local $Level = $Level + 1;
357 if( ref $regex eq 'Regexp' ) {
359 $ok = $self->ok( $this =~ $regex ? 1 : 0, $name );
361 # Check if it looks like '/foo/'
362 elsif( my($re, $opts) = $regex =~ m{^ /(.*)/ (\w*) $ }sx ) {
364 $ok = $self->ok( $this =~ /(?$opts)$re/ ? 1 : 0, $name );
367 $ok = $self->ok( 0, $name );
369 $self->diag("'$regex' doesn't look much like a regex to me.");
375 $this = defined $this ? "'$this'" : 'undef';
376 $self->diag(sprintf <<DIAGNOSTIC, $this);
378 doesn't match '$regex'
391 Skips the current test, reporting $why.
396 my($self, $why) = @_;
399 unless( $Have_Plan ) {
400 die "You tried to run tests without a plan! Gotta have a plan.\n";
405 $Test_Results[$Curr_Test-1] = 1;
408 $out .= " $Curr_Test" if $self->use_numbers;
409 $out .= " # skip $why\n";
416 =begin _unimplemented
421 $Test->skip_rest($reason);
423 Like skip(), only it skips all the rest of the tests you plan to run
424 and terminates the test.
426 If you're running under no_plan, it skips once and terminates the
440 $Test->level($how_high);
442 How far up the call stack should $Test look when reporting where the
447 Setting $Test::Builder::Level overrides. This is typically useful
451 local $Test::Builder::Level = 2;
458 my($self, $level) = @_;
460 if( defined $level ) {
471 $Test->use_numbers($on_or_off);
473 Whether or not the test should output numbers. That is, this if true:
485 Most useful when you can't depend on the test output order, such as
486 when threads or forking is involved.
488 Test::Harness will accept either, but avoid mixing the two styles.
496 my($self, $use_nums) = @_;
498 if( defined $use_nums ) {
499 $Use_Nums = $use_nums;
506 $Test->no_header($no_header);
508 If set to true, no "1..N" header will be printed.
512 $Test->no_ending($no_ending);
514 Normally, Test::Builder does some extra diagnostics when the test
515 ends. It also changes the exit code as described in Test::Simple.
517 If this is true, none of that will be done.
521 my($No_Header, $No_Ending) = (0,0);
523 my($self, $no_header) = @_;
525 if( defined $no_header ) {
526 $No_Header = $no_header;
532 my($self, $no_ending) = @_;
534 if( defined $no_ending ) {
535 $No_Ending = $no_ending;
545 Controlling where the test output goes.
553 Prints out the given $message. Normally, it uses the failure_output()
554 handle, but if this is for a TODO test, the todo_output() handle is
557 Output will be indented and prepended with a # as not to interfere
560 We encourage using this rather than calling print directly.
565 my($self, @msgs) = @_;
567 # Prevent printing headers when compiling (ie. -c)
570 # Escape each line with a #.
576 local $Level = $Level + 1;
577 my $fh = $self->todo ? $self->todo_output : $self->failure_output;
578 local($\, $", $,) = (undef, ' ', '');
586 $Test->_print(@msgs);
588 Prints to the output() filehandle.
595 my($self, @msgs) = @_;
597 # Prevent printing headers when only compiling. Mostly for when
598 # tests are deparsed with B::Deparse
601 local($\, $", $,) = (undef, ' ', '');
602 my $fh = $self->output;
610 $Test->output($file);
612 Where normal "ok/not ok" test output should go.
616 =item B<failure_output>
618 $Test->failure_output($fh);
619 $Test->failure_output($file);
621 Where diagnostic output on test failures and diag() should go.
627 $Test->todo_output($fh);
628 $Test->todo_output($file);
630 Where diagnostics about todo test failures and diag() should go.
636 my($Out_FH, $Fail_FH, $Todo_FH);
641 $Out_FH = _new_fh($fh);
650 $Fail_FH = _new_fh($fh);
659 $Todo_FH = _new_fh($fh);
665 my($file_or_fh) = shift;
668 unless( UNIVERSAL::isa($file_or_fh, 'GLOB') ) {
669 $fh = do { local *FH };
670 open $fh, ">$file_or_fh" or
671 die "Can't open test output log $file_or_fh: $!";
681 # We dup STDOUT and STDERR so people can change them in their
682 # test suites while still getting normal test output.
683 open(TESTOUT, ">&STDOUT") or die "Can't dup STDOUT: $!";
684 open(TESTERR, ">&STDERR") or die "Can't dup STDERR: $!";
685 _autoflush(\*TESTOUT);
686 _autoflush(\*TESTERR);
687 $CLASS->output(\*TESTOUT);
688 $CLASS->failure_output(\*TESTERR);
689 $CLASS->todo_output(\*TESTOUT);
694 my $old_fh = select $fh;
703 =head2 Test Status and Info
707 =item B<current_test>
709 my $curr_test = $Test->current_test;
710 $Test->current_test($num);
712 Gets/sets the current test # we're on.
714 You usually shouldn't have to set this.
719 my($self, $num) = @_;
730 my @tests = $Test->summary;
732 A simple summary of the tests so far. True for pass, false for fail.
733 This is a logical pass/fail, so todos are passes.
735 Of course, test #1 is $tests[0], etc...
742 return @Test_Results;
745 =item B<details> I<UNIMPLEMENTED>
747 my @tests = $Test->details;
749 Like summary(), but with a lot more detail.
751 $tests[$test_num - 1] =
752 { ok => is the test considered ok?
753 actual_ok => did it literally say 'ok'?
754 name => name of the test (if any)
755 type => 'skip' or 'todo' (if any)
756 reason => reason for the above (if any)
761 my $todo_reason = $Test->todo;
762 my $todo_reason = $Test->todo($pack);
764 todo() looks for a $TODO variable in your tests. If set, all tests
765 will be considered 'todo' (see Test::More and Test::Harness for
766 details). Returns the reason (ie. the value of $TODO) if running as
767 todo tests, false otherwise.
769 todo() is pretty part about finding the right package to look for
770 $TODO in. It uses the exported_to() package to find it. If that's
771 not set, it's pretty good at guessing the right package to look at.
773 Sometimes there is some confusion about where todo() should be looking
774 for the $TODO variable. If you want to be sure, tell it explicitly
780 my($self, $pack) = @_;
782 $pack = $pack || $self->exported_to || $self->caller(1);
785 return defined ${$pack.'::TODO'} ? ${$pack.'::TODO'}
791 my $package = $Test->caller;
792 my($pack, $file, $line) = $Test->caller;
793 my($pack, $file, $line) = $Test->caller($height);
795 Like the normal caller(), except it reports according to your level().
800 my($self, $height) = @_;
803 my @caller = CORE::caller($self->level + $height + 1);
804 return wantarray ? @caller : $caller[0];
815 =item B<_sanity_check>
819 Runs a bunch of end of test sanity checks to make sure reality came
820 through ok. If anything is wrong it will die with a fairly friendly
827 _whoa($Curr_Test < 0, 'Says here you ran a negative number of tests!');
828 _whoa(!$Have_Plan and $Curr_Test,
829 'Somehow your tests ran without a plan!');
830 _whoa($Curr_Test != @Test_Results,
831 'Somehow you got a different number of results than tests ran!');
836 _whoa($check, $description);
838 A sanity check, similar to assert(). If the $check is true, something
839 has gone horribly wrong. It will die with the given $description and
840 a note to contact the author.
845 my($check, $desc) = @_;
849 This should never happen! Please contact the author immediately!
858 Perl seems to have some trouble with exiting inside an END block. 5.005_03
859 and 5.6.1 both seem to do odd things. Instead, this function edits $?
860 directly. It should ONLY be called from inside an END block. It
861 doesn't actually exit, that's your job.
878 $SIG{__DIE__} = sub {
879 # We don't want to muck with death in an eval, but $^S isn't
880 # totally reliable. 5.005_03 and 5.6.1 both do the wrong thing
881 # with it. Instead, we use caller. This also means it runs under
884 for( my $stack = 1; my $sub = (CORE::caller($stack))[3]; $stack++ ) {
885 $in_eval = 1 if $sub =~ /^\(eval\)/;
887 $Test_Died = 1 unless $in_eval;
895 # Bailout if plan() was never called. This is so
896 # "require Test::Simple" doesn't puke.
897 do{ _my_exit(0) && return } if !$Have_Plan;
899 # Figure out if we passed or failed and print helpful messages.
900 if( @Test_Results ) {
901 # The plan? We have no plan.
903 $self->_print("1..$Curr_Test\n") unless $self->no_header;
904 $Expected_Tests = $Curr_Test;
907 my $num_failed = grep !$_, @Test_Results[0..$Expected_Tests-1];
908 $num_failed += abs($Expected_Tests - @Test_Results);
910 if( $Curr_Test < $Expected_Tests ) {
911 $self->diag(<<"FAIL");
912 # Looks like you planned $Expected_Tests tests but only ran $Curr_Test.
915 elsif( $Curr_Test > $Expected_Tests ) {
916 my $num_extra = $Curr_Test - $Expected_Tests;
917 $self->diag(<<"FAIL");
918 # Looks like you planned $Expected_Tests tests but ran $num_extra extra.
921 elsif ( $num_failed ) {
922 $self->diag(<<"FAIL");
923 # Looks like you failed $num_failed tests of $Expected_Tests.
928 $self->diag(<<"FAIL");
929 # Looks like your test died just after $Curr_Test.
932 _my_exit( 255 ) && return;
935 _my_exit( $num_failed <= 254 ? $num_failed : 254 ) && return;
937 elsif ( $Skip_All ) {
938 _my_exit( 0 ) && return;
941 $self->diag("# No tests run!\n");
942 _my_exit( 255 ) && return;
947 $Test->_ending if defined $Test and !$Test->no_ending;
952 At this point, Test::Simple and Test::More are your best examples.
956 Original code by chromatic, maintained by Michael G Schwern
957 E<lt>schwern@pobox.comE<gt>
961 Test::Simple, Test::More, Test::Harness