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> Meaning the underlying code is well
59 tested, yet the interface is subject to change.
61 Test::Simple and Test::More have proven to be popular testing modules,
62 but they're not always flexible enough. Test::Builder provides the a
63 building block upon which to write your own test libraries I<which can
72 my $Test = Test::Builder->new;
74 Returns a Test::Builder object representing the current state of the
77 Since you only run one test per program, there is B<one and only one>
78 Test::Builder object. No matter how many times you call new(), you're
79 getting the same object. (This is called a singleton).
86 $Test ||= bless ['Move along, nothing to see here'], $class;
92 =head2 Setting up tests
94 These methods are for setting up tests and declaring how many there
95 are. You usually only want to call one of these methods.
101 my $pack = $Test->exported_to;
102 $Test->exported_to($pack);
104 Tells Test::Builder what package you exported your functions to.
105 This is important for getting TODO tests right.
111 my($self, $pack) = @_;
113 if( defined $pack ) {
114 $Exported_To = $pack;
121 $Test->plan('no_plan');
122 $Test->plan( skip_all => $reason );
123 $Test->plan( tests => $num_tests );
125 A convenient way to set up your tests. Call this and Test::Builder
126 will print the appropriate headers and take the appropriate actions.
128 If you call plan(), don't call any of the other methods below.
133 my($self, $cmd, $arg) = @_;
137 if( $cmd eq 'no_plan' ) {
140 elsif( $cmd eq 'skip_all' ) {
141 return $self->skip_all($arg);
143 elsif( $cmd eq 'tests' ) {
145 return $self->expected_tests($arg);
147 elsif( !defined $arg ) {
148 die "Got an undefined number of tests. Looks like you tried to ".
149 "say how many tests you plan to run but made a mistake.\n";
152 die "You said to run 0 tests! You've got to run something.\n";
157 =item B<expected_tests>
159 my $max = $Test->expected_tests;
160 $Test->expected_tests($max);
162 Gets/sets the # of tests we expect this test to run and prints out
163 the appropriate headers.
167 my $Expected_Tests = 0;
169 my($self, $max) = @_;
172 $Expected_Tests = $max;
175 $self->_print("1..$max\n") unless $self->no_header;
177 return $Expected_Tests;
185 Declares that this test will run an indeterminate # of tests.
198 $Test->skip_all($reason);
200 Skips all the tests, using the given $reason. Exits immediately with 0.
206 my($self, $reason) = @_;
209 $out .= " # Skip $reason" if $reason;
214 $self->_print($out) unless $self->no_header;
222 These actually run the tests, analogous to the functions in
225 $name is always optional.
231 $Test->ok($test, $name);
233 Your basic test. Pass if $test is true, fail if $test is false. Just
234 like Test::Simple's ok().
239 my($self, $test, $name) = @_;
241 unless( $Have_Plan ) {
242 die "You tried to run a test without a plan! Gotta have a plan.\n";
247 $self->diag(<<ERR) if defined $name and $name =~ /^[\d\s]+$/;
248 You named your test '$name'. You shouldn't use numbers for your test names.
252 my($pack, $file, $line) = $self->caller;
254 my $todo = $self->todo($pack);
259 $Test_Results[$Curr_Test-1] = $todo ? 1 : 0;
262 $Test_Results[$Curr_Test-1] = 1;
266 $out .= " $Curr_Test" if $self->use_numbers;
268 if( defined $name ) {
269 $name =~ s|#|\\#|g; # # in a name can confuse Test::Harness.
274 my $what_todo = $todo;
275 $out .= " # TODO $what_todo";
283 my $msg = $todo ? "Failed (TODO)" : "Failed";
284 $self->diag(" $msg test ($file at line $line)\n");
287 return $test ? 1 : 0;
292 $Test->is_eq($got, $expected, $name);
294 Like Test::More's is(). Checks if $got eq $expected. This is the
299 $Test->is_num($got, $expected, $name);
301 Like Test::More's is(). Checks if $got == $expected. This is the
307 my($self, $got, $expect, $name) = @_;
308 local $Level = $Level + 1;
310 if( !defined $got || !defined $expect ) {
311 # undef only matches undef and nothing else
312 my $test = !defined $got && !defined $expect;
314 $self->ok($test, $name);
315 $self->_is_diag($got, 'eq', $expect) unless $test;
319 return $self->cmp_ok($got, 'eq', $expect, $name);
323 my($self, $got, $expect, $name) = @_;
324 local $Level = $Level + 1;
326 if( !defined $got || !defined $expect ) {
327 # undef only matches undef and nothing else
328 my $test = !defined $got && !defined $expect;
330 $self->ok($test, $name);
331 $self->_is_diag($got, '==', $expect) unless $test;
335 return $self->cmp_ok($got, '==', $expect, $name);
339 my($self, $got, $type, $expect) = @_;
341 foreach my $val (\$got, \$expect) {
342 if( defined $$val ) {
343 if( $type eq 'eq' ) {
344 # quote and force string context
348 # force numeric context
357 $self->diag(sprintf <<DIAGNOSTIC, $got, $expect);
366 $Test->isnt_eq($got, $dont_expect, $name);
368 Like Test::More's isnt(). Checks if $got ne $dont_expect. This is
373 $Test->is_num($got, $dont_expect, $name);
375 Like Test::More's isnt(). Checks if $got ne $dont_expect. This is
381 my($self, $got, $dont_expect, $name) = @_;
382 local $Level = $Level + 1;
384 if( !defined $got || !defined $dont_expect ) {
385 # undef only matches undef and nothing else
386 my $test = defined $got || defined $dont_expect;
388 $self->ok($test, $name);
389 $self->_cmp_diag('ne', $got, $dont_expect) unless $test;
393 return $self->cmp_ok($got, 'ne', $dont_expect, $name);
397 my($self, $got, $dont_expect, $name) = @_;
398 local $Level = $Level + 1;
400 if( !defined $got || !defined $dont_expect ) {
401 # undef only matches undef and nothing else
402 my $test = defined $got || defined $dont_expect;
404 $self->ok($test, $name);
405 $self->_cmp_diag('!=', $got, $dont_expect) unless $test;
409 return $self->cmp_ok($got, '!=', $dont_expect, $name);
415 $Test->like($this, qr/$regex/, $name);
416 $Test->like($this, '/$regex/', $name);
418 Like Test::More's like(). Checks if $this matches the given $regex.
420 You'll want to avoid qr// if you want your tests to work before 5.005.
424 $Test->unlike($this, qr/$regex/, $name);
425 $Test->unlike($this, '/$regex/', $name);
427 Like Test::More's unlike(). Checks if $this B<does not match> the
433 my($self, $this, $regex, $name) = @_;
435 local $Level = $Level + 1;
436 $self->_regex_ok($this, $regex, '=~', $name);
440 my($self, $this, $regex, $name) = @_;
442 local $Level = $Level + 1;
443 $self->_regex_ok($this, $regex, '!~', $name);
447 my($self, $this, $regex, $cmp, $name) = @_;
449 local $Level = $Level + 1;
453 if( ref $regex eq 'Regexp' ) {
454 $usable_regex = $regex;
456 # Check if it looks like '/foo/'
457 elsif( my($re, $opts) = $regex =~ m{^ /(.*)/ (\w*) $ }sx ) {
458 $usable_regex = "(?$opts)$re";
461 $ok = $self->ok( 0, $name );
463 $self->diag(" '$regex' doesn't look much like a regex to me.");
470 my $test = $this =~ /$usable_regex/ ? 1 : 0;
471 $test = !$test if $cmp eq '!~';
472 $ok = $self->ok( $test, $name );
476 $this = defined $this ? "'$this'" : 'undef';
477 my $match = $cmp eq '=~' ? "doesn't match" : "matches";
478 $self->diag(sprintf <<DIAGNOSTIC, $this, $match, $regex);
490 $Test->cmp_ok($this, $type, $that, $name);
492 Works just like Test::More's cmp_ok().
494 $Test->cmp_ok($big_num, '!=', $other_big_num);
499 my($self, $got, $type, $expect, $name) = @_;
504 local($@,$!); # don't interfere with $@
505 # eval() sometimes resets $!
506 $test = eval "\$got $type \$expect";
508 local $Level = $Level + 1;
509 my $ok = $self->ok($test, $name);
512 if( $type =~ /^(eq|==)$/ ) {
513 $self->_is_diag($got, $type, $expect);
516 $self->_cmp_diag($got, $type, $expect);
523 my($self, $got, $type, $expect) = @_;
525 $got = defined $got ? "'$got'" : 'undef';
526 $expect = defined $expect ? "'$expect'" : 'undef';
527 $self->diag(sprintf <<DIAGNOSTIC, $got, $type, $expect);
536 $Test->BAILOUT($reason);
538 Indicates to the Test::Harness that things are going so badly all
539 testing should terminate. This includes running any additional test
542 It will exit with 255.
547 my($self, $reason) = @_;
549 $self->_print("Bail out! $reason");
558 Skips the current test, reporting $why.
563 my($self, $why) = @_;
566 unless( $Have_Plan ) {
567 die "You tried to run tests without a plan! Gotta have a plan.\n";
572 $Test_Results[$Curr_Test-1] = 1;
575 $out .= " $Curr_Test" if $self->use_numbers;
576 $out .= " # skip $why\n";
587 $Test->todo_skip($why);
589 Like skip(), only it will declare the test as failing and TODO. Similar
592 print "not ok $tnum # TODO $why\n";
597 my($self, $why) = @_;
600 unless( $Have_Plan ) {
601 die "You tried to run tests without a plan! Gotta have a plan.\n";
606 $Test_Results[$Curr_Test-1] = 1;
609 $out .= " $Curr_Test" if $self->use_numbers;
610 $out .= " # TODO $why\n";
618 =begin _unimplemented
623 $Test->skip_rest($reason);
625 Like skip(), only it skips all the rest of the tests you plan to run
626 and terminates the test.
628 If you're running under no_plan, it skips once and terminates the
642 $Test->level($how_high);
644 How far up the call stack should $Test look when reporting where the
649 Setting $Test::Builder::Level overrides. This is typically useful
653 local $Test::Builder::Level = 2;
660 my($self, $level) = @_;
662 if( defined $level ) {
673 $Test->use_numbers($on_or_off);
675 Whether or not the test should output numbers. That is, this if true:
687 Most useful when you can't depend on the test output order, such as
688 when threads or forking is involved.
690 Test::Harness will accept either, but avoid mixing the two styles.
698 my($self, $use_nums) = @_;
700 if( defined $use_nums ) {
701 $Use_Nums = $use_nums;
708 $Test->no_header($no_header);
710 If set to true, no "1..N" header will be printed.
714 $Test->no_ending($no_ending);
716 Normally, Test::Builder does some extra diagnostics when the test
717 ends. It also changes the exit code as described in Test::Simple.
719 If this is true, none of that will be done.
723 my($No_Header, $No_Ending) = (0,0);
725 my($self, $no_header) = @_;
727 if( defined $no_header ) {
728 $No_Header = $no_header;
734 my($self, $no_ending) = @_;
736 if( defined $no_ending ) {
737 $No_Ending = $no_ending;
747 Controlling where the test output goes.
749 It's ok for your test to change where STDOUT and STDERR point to,
750 Test::Builder's default output settings will not be affected.
758 Prints out the given $message. Normally, it uses the failure_output()
759 handle, but if this is for a TODO test, the todo_output() handle is
762 Output will be indented and marked with a # so as not to interfere
763 with test output. A newline will be put on the end if there isn't one
766 We encourage using this rather than calling print directly.
771 my($self, @msgs) = @_;
774 # Prevent printing headers when compiling (i.e. -c)
777 # Escape each line with a #.
782 push @msgs, "\n" unless $msgs[-1] =~ /\n\Z/;
784 local $Level = $Level + 1;
785 my $fh = $self->todo ? $self->todo_output : $self->failure_output;
786 local($\, $", $,) = (undef, ' ', '');
794 $Test->_print(@msgs);
796 Prints to the output() filehandle.
803 my($self, @msgs) = @_;
805 # Prevent printing headers when only compiling. Mostly for when
806 # tests are deparsed with B::Deparse
809 local($\, $", $,) = (undef, ' ', '');
810 my $fh = $self->output;
818 $Test->output($file);
820 Where normal "ok/not ok" test output should go.
824 =item B<failure_output>
826 $Test->failure_output($fh);
827 $Test->failure_output($file);
829 Where diagnostic output on test failures and diag() should go.
835 $Test->todo_output($fh);
836 $Test->todo_output($file);
838 Where diagnostics about todo test failures and diag() should go.
844 my($Out_FH, $Fail_FH, $Todo_FH);
849 $Out_FH = _new_fh($fh);
858 $Fail_FH = _new_fh($fh);
867 $Todo_FH = _new_fh($fh);
873 my($file_or_fh) = shift;
876 unless( UNIVERSAL::isa($file_or_fh, 'GLOB') ) {
877 $fh = do { local *FH };
878 open $fh, ">$file_or_fh" or
879 die "Can't open test output log $file_or_fh: $!";
889 # We dup STDOUT and STDERR so people can change them in their
890 # test suites while still getting normal test output.
891 open(TESTOUT, ">&STDOUT") or die "Can't dup STDOUT: $!";
892 open(TESTERR, ">&STDERR") or die "Can't dup STDERR: $!";
894 # Set everything to unbuffered else plain prints to STDOUT will
895 # come out in the wrong order from our own prints.
896 _autoflush(\*TESTOUT);
897 _autoflush(\*STDOUT);
898 _autoflush(\*TESTERR);
899 _autoflush(\*STDERR);
901 $CLASS->output(\*TESTOUT);
902 $CLASS->failure_output(\*TESTERR);
903 $CLASS->todo_output(\*TESTOUT);
908 my $old_fh = select $fh;
917 =head2 Test Status and Info
921 =item B<current_test>
923 my $curr_test = $Test->current_test;
924 $Test->current_test($num);
926 Gets/sets the current test # we're on.
928 You usually shouldn't have to set this.
933 my($self, $num) = @_;
937 if( $num > @Test_Results ) {
938 for ($#Test_Results..$num-1) {
939 $Test_Results[$_] = 1;
949 my @tests = $Test->summary;
951 A simple summary of the tests so far. True for pass, false for fail.
952 This is a logical pass/fail, so todos are passes.
954 Of course, test #1 is $tests[0], etc...
961 return @Test_Results;
964 =item B<details> I<UNIMPLEMENTED>
966 my @tests = $Test->details;
968 Like summary(), but with a lot more detail.
970 $tests[$test_num - 1] =
971 { ok => is the test considered ok?
972 actual_ok => did it literally say 'ok'?
973 name => name of the test (if any)
974 type => 'skip' or 'todo' (if any)
975 reason => reason for the above (if any)
980 my $todo_reason = $Test->todo;
981 my $todo_reason = $Test->todo($pack);
983 todo() looks for a $TODO variable in your tests. If set, all tests
984 will be considered 'todo' (see Test::More and Test::Harness for
985 details). Returns the reason (ie. the value of $TODO) if running as
986 todo tests, false otherwise.
988 todo() is pretty part about finding the right package to look for
989 $TODO in. It uses the exported_to() package to find it. If that's
990 not set, it's pretty good at guessing the right package to look at.
992 Sometimes there is some confusion about where todo() should be looking
993 for the $TODO variable. If you want to be sure, tell it explicitly
999 my($self, $pack) = @_;
1001 $pack = $pack || $self->exported_to || $self->caller(1);
1004 return defined ${$pack.'::TODO'} ? ${$pack.'::TODO'}
1010 my $package = $Test->caller;
1011 my($pack, $file, $line) = $Test->caller;
1012 my($pack, $file, $line) = $Test->caller($height);
1014 Like the normal caller(), except it reports according to your level().
1019 my($self, $height) = @_;
1022 my @caller = CORE::caller($self->level + $height + 1);
1023 return wantarray ? @caller : $caller[0];
1034 =item B<_sanity_check>
1038 Runs a bunch of end of test sanity checks to make sure reality came
1039 through ok. If anything is wrong it will die with a fairly friendly
1046 _whoa($Curr_Test < 0, 'Says here you ran a negative number of tests!');
1047 _whoa(!$Have_Plan and $Curr_Test,
1048 'Somehow your tests ran without a plan!');
1049 _whoa($Curr_Test != @Test_Results,
1050 'Somehow you got a different number of results than tests ran!');
1055 _whoa($check, $description);
1057 A sanity check, similar to assert(). If the $check is true, something
1058 has gone horribly wrong. It will die with the given $description and
1059 a note to contact the author.
1064 my($check, $desc) = @_;
1068 This should never happen! Please contact the author immediately!
1075 _my_exit($exit_num);
1077 Perl seems to have some trouble with exiting inside an END block. 5.005_03
1078 and 5.6.1 both seem to do odd things. Instead, this function edits $?
1079 directly. It should ONLY be called from inside an END block. It
1080 doesn't actually exit, that's your job.
1097 $SIG{__DIE__} = sub {
1098 # We don't want to muck with death in an eval, but $^S isn't
1099 # totally reliable. 5.005_03 and 5.6.1 both do the wrong thing
1100 # with it. Instead, we use caller. This also means it runs under
1103 for( my $stack = 1; my $sub = (CORE::caller($stack))[3]; $stack++ ) {
1104 $in_eval = 1 if $sub =~ /^\(eval\)/;
1106 $Test_Died = 1 unless $in_eval;
1114 # Bailout if plan() was never called. This is so
1115 # "require Test::Simple" doesn't puke.
1116 do{ _my_exit(0) && return } if !$Have_Plan;
1118 # Figure out if we passed or failed and print helpful messages.
1119 if( @Test_Results ) {
1120 # The plan? We have no plan.
1122 $self->_print("1..$Curr_Test\n") unless $self->no_header;
1123 $Expected_Tests = $Curr_Test;
1126 my $num_failed = grep !$_, @Test_Results[0..$Expected_Tests-1];
1127 $num_failed += abs($Expected_Tests - @Test_Results);
1129 if( $Curr_Test < $Expected_Tests ) {
1130 $self->diag(<<"FAIL");
1131 Looks like you planned $Expected_Tests tests but only ran $Curr_Test.
1134 elsif( $Curr_Test > $Expected_Tests ) {
1135 my $num_extra = $Curr_Test - $Expected_Tests;
1136 $self->diag(<<"FAIL");
1137 Looks like you planned $Expected_Tests tests but ran $num_extra extra.
1140 elsif ( $num_failed ) {
1141 $self->diag(<<"FAIL");
1142 Looks like you failed $num_failed tests of $Expected_Tests.
1147 $self->diag(<<"FAIL");
1148 Looks like your test died just after $Curr_Test.
1151 _my_exit( 255 ) && return;
1154 _my_exit( $num_failed <= 254 ? $num_failed : 254 ) && return;
1156 elsif ( $Skip_All ) {
1157 _my_exit( 0 ) && return;
1160 $self->diag("No tests run!\n");
1161 _my_exit( 255 ) && return;
1166 $Test->_ending if defined $Test and !$Test->no_ending;
1171 At this point, Test::Simple and Test::More are your best examples.
1175 Test::Simple, Test::More, Test::Harness
1179 Original code by chromatic, maintained by Michael G Schwern
1180 E<lt>schwern@pobox.comE<gt>
1184 Copyright 2001 by chromatic E<lt>chromatic@wgz.orgE<gt>,
1185 Michael G Schwern E<lt>schwern@pobox.comE<gt>.
1187 This program is free software; you can redistribute it and/or
1188 modify it under the same terms as Perl itself.
1190 See F<http://www.perl.com/perl/misc/Artistic.html>