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.
547 It's ok for your test to change where STDOUT and STDERR point to,
548 Test::Builder's default output settings will not be affected.
556 Prints out the given $message. Normally, it uses the failure_output()
557 handle, but if this is for a TODO test, the todo_output() handle is
560 Output will be indented and marked with a # so as not to interfere
563 We encourage using this rather than calling print directly.
568 my($self, @msgs) = @_;
570 # Prevent printing headers when compiling (i.e. -c)
573 # Escape each line with a #.
579 local $Level = $Level + 1;
580 my $fh = $self->todo ? $self->todo_output : $self->failure_output;
581 local($\, $", $,) = (undef, ' ', '');
589 $Test->_print(@msgs);
591 Prints to the output() filehandle.
598 my($self, @msgs) = @_;
600 # Prevent printing headers when only compiling. Mostly for when
601 # tests are deparsed with B::Deparse
604 local($\, $", $,) = (undef, ' ', '');
605 my $fh = $self->output;
613 $Test->output($file);
615 Where normal "ok/not ok" test output should go.
619 =item B<failure_output>
621 $Test->failure_output($fh);
622 $Test->failure_output($file);
624 Where diagnostic output on test failures and diag() should go.
630 $Test->todo_output($fh);
631 $Test->todo_output($file);
633 Where diagnostics about todo test failures and diag() should go.
639 my($Out_FH, $Fail_FH, $Todo_FH);
644 $Out_FH = _new_fh($fh);
653 $Fail_FH = _new_fh($fh);
662 $Todo_FH = _new_fh($fh);
668 my($file_or_fh) = shift;
671 unless( UNIVERSAL::isa($file_or_fh, 'GLOB') ) {
672 $fh = do { local *FH };
673 open $fh, ">$file_or_fh" or
674 die "Can't open test output log $file_or_fh: $!";
684 # We dup STDOUT and STDERR so people can change them in their
685 # test suites while still getting normal test output.
686 open(TESTOUT, ">&STDOUT") or die "Can't dup STDOUT: $!";
687 open(TESTERR, ">&STDERR") or die "Can't dup STDERR: $!";
688 _autoflush(\*TESTOUT);
689 _autoflush(\*TESTERR);
690 $CLASS->output(\*TESTOUT);
691 $CLASS->failure_output(\*TESTERR);
692 $CLASS->todo_output(\*TESTOUT);
697 my $old_fh = select $fh;
706 =head2 Test Status and Info
710 =item B<current_test>
712 my $curr_test = $Test->current_test;
713 $Test->current_test($num);
715 Gets/sets the current test # we're on.
717 You usually shouldn't have to set this.
722 my($self, $num) = @_;
733 my @tests = $Test->summary;
735 A simple summary of the tests so far. True for pass, false for fail.
736 This is a logical pass/fail, so todos are passes.
738 Of course, test #1 is $tests[0], etc...
745 return @Test_Results;
748 =item B<details> I<UNIMPLEMENTED>
750 my @tests = $Test->details;
752 Like summary(), but with a lot more detail.
754 $tests[$test_num - 1] =
755 { ok => is the test considered ok?
756 actual_ok => did it literally say 'ok'?
757 name => name of the test (if any)
758 type => 'skip' or 'todo' (if any)
759 reason => reason for the above (if any)
764 my $todo_reason = $Test->todo;
765 my $todo_reason = $Test->todo($pack);
767 todo() looks for a $TODO variable in your tests. If set, all tests
768 will be considered 'todo' (see Test::More and Test::Harness for
769 details). Returns the reason (ie. the value of $TODO) if running as
770 todo tests, false otherwise.
772 todo() is pretty part about finding the right package to look for
773 $TODO in. It uses the exported_to() package to find it. If that's
774 not set, it's pretty good at guessing the right package to look at.
776 Sometimes there is some confusion about where todo() should be looking
777 for the $TODO variable. If you want to be sure, tell it explicitly
783 my($self, $pack) = @_;
785 $pack = $pack || $self->exported_to || $self->caller(1);
788 return defined ${$pack.'::TODO'} ? ${$pack.'::TODO'}
794 my $package = $Test->caller;
795 my($pack, $file, $line) = $Test->caller;
796 my($pack, $file, $line) = $Test->caller($height);
798 Like the normal caller(), except it reports according to your level().
803 my($self, $height) = @_;
806 my @caller = CORE::caller($self->level + $height + 1);
807 return wantarray ? @caller : $caller[0];
818 =item B<_sanity_check>
822 Runs a bunch of end of test sanity checks to make sure reality came
823 through ok. If anything is wrong it will die with a fairly friendly
830 _whoa($Curr_Test < 0, 'Says here you ran a negative number of tests!');
831 _whoa(!$Have_Plan and $Curr_Test,
832 'Somehow your tests ran without a plan!');
833 _whoa($Curr_Test != @Test_Results,
834 'Somehow you got a different number of results than tests ran!');
839 _whoa($check, $description);
841 A sanity check, similar to assert(). If the $check is true, something
842 has gone horribly wrong. It will die with the given $description and
843 a note to contact the author.
848 my($check, $desc) = @_;
852 This should never happen! Please contact the author immediately!
861 Perl seems to have some trouble with exiting inside an END block. 5.005_03
862 and 5.6.1 both seem to do odd things. Instead, this function edits $?
863 directly. It should ONLY be called from inside an END block. It
864 doesn't actually exit, that's your job.
881 $SIG{__DIE__} = sub {
882 # We don't want to muck with death in an eval, but $^S isn't
883 # totally reliable. 5.005_03 and 5.6.1 both do the wrong thing
884 # with it. Instead, we use caller. This also means it runs under
887 for( my $stack = 1; my $sub = (CORE::caller($stack))[3]; $stack++ ) {
888 $in_eval = 1 if $sub =~ /^\(eval\)/;
890 $Test_Died = 1 unless $in_eval;
898 # Bailout if plan() was never called. This is so
899 # "require Test::Simple" doesn't puke.
900 do{ _my_exit(0) && return } if !$Have_Plan;
902 # Figure out if we passed or failed and print helpful messages.
903 if( @Test_Results ) {
904 # The plan? We have no plan.
906 $self->_print("1..$Curr_Test\n") unless $self->no_header;
907 $Expected_Tests = $Curr_Test;
910 my $num_failed = grep !$_, @Test_Results[0..$Expected_Tests-1];
911 $num_failed += abs($Expected_Tests - @Test_Results);
913 if( $Curr_Test < $Expected_Tests ) {
914 $self->diag(<<"FAIL");
915 # Looks like you planned $Expected_Tests tests but only ran $Curr_Test.
918 elsif( $Curr_Test > $Expected_Tests ) {
919 my $num_extra = $Curr_Test - $Expected_Tests;
920 $self->diag(<<"FAIL");
921 # Looks like you planned $Expected_Tests tests but ran $num_extra extra.
924 elsif ( $num_failed ) {
925 $self->diag(<<"FAIL");
926 # Looks like you failed $num_failed tests of $Expected_Tests.
931 $self->diag(<<"FAIL");
932 # Looks like your test died just after $Curr_Test.
935 _my_exit( 255 ) && return;
938 _my_exit( $num_failed <= 254 ? $num_failed : 254 ) && return;
940 elsif ( $Skip_All ) {
941 _my_exit( 0 ) && return;
944 $self->diag("# No tests run!\n");
945 _my_exit( 255 ) && return;
950 $Test->_ending if defined $Test and !$Test->no_ending;
955 At this point, Test::Simple and Test::More are your best examples.
959 Test::Simple, Test::More, Test::Harness
963 Original code by chromatic, maintained by Michael G Schwern
964 E<lt>schwern@pobox.comE<gt>
968 Copyright 2001 by chromatic E<lt>chromatic@wgz.orgE<gt>,
969 Michael G Schwern E<lt>schwern@pobox.comE<gt>.
971 This program is free software; you can redistribute it and/or
972 modify it under the same terms as Perl itself.
974 See L<http://www.perl.com/perl/misc/Artistic.html>