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) = @_;
944 my @tests = $Test->summary;
946 A simple summary of the tests so far. True for pass, false for fail.
947 This is a logical pass/fail, so todos are passes.
949 Of course, test #1 is $tests[0], etc...
956 return @Test_Results;
959 =item B<details> I<UNIMPLEMENTED>
961 my @tests = $Test->details;
963 Like summary(), but with a lot more detail.
965 $tests[$test_num - 1] =
966 { ok => is the test considered ok?
967 actual_ok => did it literally say 'ok'?
968 name => name of the test (if any)
969 type => 'skip' or 'todo' (if any)
970 reason => reason for the above (if any)
975 my $todo_reason = $Test->todo;
976 my $todo_reason = $Test->todo($pack);
978 todo() looks for a $TODO variable in your tests. If set, all tests
979 will be considered 'todo' (see Test::More and Test::Harness for
980 details). Returns the reason (ie. the value of $TODO) if running as
981 todo tests, false otherwise.
983 todo() is pretty part about finding the right package to look for
984 $TODO in. It uses the exported_to() package to find it. If that's
985 not set, it's pretty good at guessing the right package to look at.
987 Sometimes there is some confusion about where todo() should be looking
988 for the $TODO variable. If you want to be sure, tell it explicitly
994 my($self, $pack) = @_;
996 $pack = $pack || $self->exported_to || $self->caller(1);
999 return defined ${$pack.'::TODO'} ? ${$pack.'::TODO'}
1005 my $package = $Test->caller;
1006 my($pack, $file, $line) = $Test->caller;
1007 my($pack, $file, $line) = $Test->caller($height);
1009 Like the normal caller(), except it reports according to your level().
1014 my($self, $height) = @_;
1017 my @caller = CORE::caller($self->level + $height + 1);
1018 return wantarray ? @caller : $caller[0];
1029 =item B<_sanity_check>
1033 Runs a bunch of end of test sanity checks to make sure reality came
1034 through ok. If anything is wrong it will die with a fairly friendly
1041 _whoa($Curr_Test < 0, 'Says here you ran a negative number of tests!');
1042 _whoa(!$Have_Plan and $Curr_Test,
1043 'Somehow your tests ran without a plan!');
1044 _whoa($Curr_Test != @Test_Results,
1045 'Somehow you got a different number of results than tests ran!');
1050 _whoa($check, $description);
1052 A sanity check, similar to assert(). If the $check is true, something
1053 has gone horribly wrong. It will die with the given $description and
1054 a note to contact the author.
1059 my($check, $desc) = @_;
1063 This should never happen! Please contact the author immediately!
1070 _my_exit($exit_num);
1072 Perl seems to have some trouble with exiting inside an END block. 5.005_03
1073 and 5.6.1 both seem to do odd things. Instead, this function edits $?
1074 directly. It should ONLY be called from inside an END block. It
1075 doesn't actually exit, that's your job.
1092 $SIG{__DIE__} = sub {
1093 # We don't want to muck with death in an eval, but $^S isn't
1094 # totally reliable. 5.005_03 and 5.6.1 both do the wrong thing
1095 # with it. Instead, we use caller. This also means it runs under
1098 for( my $stack = 1; my $sub = (CORE::caller($stack))[3]; $stack++ ) {
1099 $in_eval = 1 if $sub =~ /^\(eval\)/;
1101 $Test_Died = 1 unless $in_eval;
1109 # Bailout if plan() was never called. This is so
1110 # "require Test::Simple" doesn't puke.
1111 do{ _my_exit(0) && return } if !$Have_Plan;
1113 # Figure out if we passed or failed and print helpful messages.
1114 if( @Test_Results ) {
1115 # The plan? We have no plan.
1117 $self->_print("1..$Curr_Test\n") unless $self->no_header;
1118 $Expected_Tests = $Curr_Test;
1121 my $num_failed = grep !$_, @Test_Results[0..$Expected_Tests-1];
1122 $num_failed += abs($Expected_Tests - @Test_Results);
1124 if( $Curr_Test < $Expected_Tests ) {
1125 $self->diag(<<"FAIL");
1126 Looks like you planned $Expected_Tests tests but only ran $Curr_Test.
1129 elsif( $Curr_Test > $Expected_Tests ) {
1130 my $num_extra = $Curr_Test - $Expected_Tests;
1131 $self->diag(<<"FAIL");
1132 Looks like you planned $Expected_Tests tests but ran $num_extra extra.
1135 elsif ( $num_failed ) {
1136 $self->diag(<<"FAIL");
1137 Looks like you failed $num_failed tests of $Expected_Tests.
1142 $self->diag(<<"FAIL");
1143 Looks like your test died just after $Curr_Test.
1146 _my_exit( 255 ) && return;
1149 _my_exit( $num_failed <= 254 ? $num_failed : 254 ) && return;
1151 elsif ( $Skip_All ) {
1152 _my_exit( 0 ) && return;
1155 $self->diag("No tests run!\n");
1156 _my_exit( 255 ) && return;
1161 $Test->_ending if defined $Test and !$Test->no_ending;
1166 At this point, Test::Simple and Test::More are your best examples.
1170 Test::Simple, Test::More, Test::Harness
1174 Original code by chromatic, maintained by Michael G Schwern
1175 E<lt>schwern@pobox.comE<gt>
1179 Copyright 2001 by chromatic E<lt>chromatic@wgz.orgE<gt>,
1180 Michael G Schwern E<lt>schwern@pobox.comE<gt>.
1182 This program is free software; you can redistribute it and/or
1183 modify it under the same terms as Perl itself.
1185 See F<http://www.perl.com/perl/misc/Artistic.html>