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 Test::Simple and Test::More have proven to be popular testing modules,
59 but they're not always flexible enough. Test::Builder provides the a
60 building block upon which to write your own test libraries I<which can
69 my $Test = Test::Builder->new;
71 Returns a Test::Builder object representing the current state of the
74 Since you only run one test per program, there is B<one and only one>
75 Test::Builder object. No matter how many times you call new(), you're
76 getting the same object. (This is called a singleton).
83 $Test ||= bless ['Move along, nothing to see here'], $class;
89 =head2 Setting up tests
91 These methods are for setting up tests and declaring how many there
92 are. You usually only want to call one of these methods.
98 my $pack = $Test->exported_to;
99 $Test->exported_to($pack);
101 Tells Test::Builder what package you exported your functions to.
102 This is important for getting TODO tests right.
108 my($self, $pack) = @_;
110 if( defined $pack ) {
111 $Exported_To = $pack;
118 $Test->plan('no_plan');
119 $Test->plan( skip_all => $reason );
120 $Test->plan( tests => $num_tests );
122 A convenient way to set up your tests. Call this and Test::Builder
123 will print the appropriate headers and take the appropriate actions.
125 If you call plan(), don't call any of the other methods below.
130 my($self, $cmd, $arg) = @_;
134 if( $cmd eq 'no_plan' ) {
137 elsif( $cmd eq 'skip_all' ) {
138 return $self->skip_all($arg);
140 elsif( $cmd eq 'tests' ) {
142 return $self->expected_tests($arg);
144 elsif( !defined $arg ) {
145 die "Got an undefined number of tests. Looks like you tried to ".
146 "say how many tests you plan to run but made a mistake.\n";
149 die "You said to run 0 tests! You've got to run something.\n";
154 my @args = grep { defined } ($cmd, $arg);
155 Carp::croak("plan() doesn't understand @args");
160 =item B<expected_tests>
162 my $max = $Test->expected_tests;
163 $Test->expected_tests($max);
165 Gets/sets the # of tests we expect this test to run and prints out
166 the appropriate headers.
170 my $Expected_Tests = 0;
172 my($self, $max) = @_;
175 $Expected_Tests = $max;
178 $self->_print("1..$max\n") unless $self->no_header;
180 return $Expected_Tests;
188 Declares that this test will run an indeterminate # of tests.
201 $Test->skip_all($reason);
203 Skips all the tests, using the given $reason. Exits immediately with 0.
209 my($self, $reason) = @_;
212 $out .= " # Skip $reason" if $reason;
217 $self->_print($out) unless $self->no_header;
225 These actually run the tests, analogous to the functions in
228 $name is always optional.
234 $Test->ok($test, $name);
236 Your basic test. Pass if $test is true, fail if $test is false. Just
237 like Test::Simple's ok().
242 my($self, $test, $name) = @_;
244 unless( $Have_Plan ) {
246 Carp::croak("You tried to run a test without a plan! Gotta have a plan.");
251 $self->diag(<<ERR) if defined $name and $name =~ /^[\d\s]+$/;
252 You named your test '$name'. You shouldn't use numbers for your test names.
256 my($pack, $file, $line) = $self->caller;
258 my $todo = $self->todo($pack);
263 $Test_Results[$Curr_Test-1] = $todo ? 1 : 0;
266 $Test_Results[$Curr_Test-1] = 1;
270 $out .= " $Curr_Test" if $self->use_numbers;
272 if( defined $name ) {
273 $name =~ s|#|\\#|g; # # in a name can confuse Test::Harness.
278 my $what_todo = $todo;
279 $out .= " # TODO $what_todo";
287 my $msg = $todo ? "Failed (TODO)" : "Failed";
288 $self->diag(" $msg test ($file at line $line)\n");
291 return $test ? 1 : 0;
296 $Test->is_eq($got, $expected, $name);
298 Like Test::More's is(). Checks if $got eq $expected. This is the
303 $Test->is_num($got, $expected, $name);
305 Like Test::More's is(). Checks if $got == $expected. This is the
311 my($self, $got, $expect, $name) = @_;
312 local $Level = $Level + 1;
314 if( !defined $got || !defined $expect ) {
315 # undef only matches undef and nothing else
316 my $test = !defined $got && !defined $expect;
318 $self->ok($test, $name);
319 $self->_is_diag($got, 'eq', $expect) unless $test;
323 return $self->cmp_ok($got, 'eq', $expect, $name);
327 my($self, $got, $expect, $name) = @_;
328 local $Level = $Level + 1;
330 if( !defined $got || !defined $expect ) {
331 # undef only matches undef and nothing else
332 my $test = !defined $got && !defined $expect;
334 $self->ok($test, $name);
335 $self->_is_diag($got, '==', $expect) unless $test;
339 return $self->cmp_ok($got, '==', $expect, $name);
343 my($self, $got, $type, $expect) = @_;
345 foreach my $val (\$got, \$expect) {
346 if( defined $$val ) {
347 if( $type eq 'eq' ) {
348 # quote and force string context
352 # force numeric context
361 return $self->diag(sprintf <<DIAGNOSTIC, $got, $expect);
370 $Test->isnt_eq($got, $dont_expect, $name);
372 Like Test::More's isnt(). Checks if $got ne $dont_expect. This is
377 $Test->is_num($got, $dont_expect, $name);
379 Like Test::More's isnt(). Checks if $got ne $dont_expect. This is
385 my($self, $got, $dont_expect, $name) = @_;
386 local $Level = $Level + 1;
388 if( !defined $got || !defined $dont_expect ) {
389 # undef only matches undef and nothing else
390 my $test = defined $got || defined $dont_expect;
392 $self->ok($test, $name);
393 $self->_cmp_diag('ne', $got, $dont_expect) unless $test;
397 return $self->cmp_ok($got, 'ne', $dont_expect, $name);
401 my($self, $got, $dont_expect, $name) = @_;
402 local $Level = $Level + 1;
404 if( !defined $got || !defined $dont_expect ) {
405 # undef only matches undef and nothing else
406 my $test = defined $got || defined $dont_expect;
408 $self->ok($test, $name);
409 $self->_cmp_diag('!=', $got, $dont_expect) unless $test;
413 return $self->cmp_ok($got, '!=', $dont_expect, $name);
419 $Test->like($this, qr/$regex/, $name);
420 $Test->like($this, '/$regex/', $name);
422 Like Test::More's like(). Checks if $this matches the given $regex.
424 You'll want to avoid qr// if you want your tests to work before 5.005.
428 $Test->unlike($this, qr/$regex/, $name);
429 $Test->unlike($this, '/$regex/', $name);
431 Like Test::More's unlike(). Checks if $this B<does not match> the
437 my($self, $this, $regex, $name) = @_;
439 local $Level = $Level + 1;
440 $self->_regex_ok($this, $regex, '=~', $name);
444 my($self, $this, $regex, $name) = @_;
446 local $Level = $Level + 1;
447 $self->_regex_ok($this, $regex, '!~', $name);
452 $Test->maybe_regex(qr/$regex/);
453 $Test->maybe_regex('/$regex/');
455 Convenience method for building testing functions that take regular
456 expressions as arguments, but need to work before perl 5.005.
458 Takes a quoted regular expression produced by qr//, or a string
459 representing a regular expression.
461 Returns a Perl value which may be used instead of the corresponding
462 regular expression, or undef if it's argument is not recognised.
464 For example, a version of like(), sans the useful diagnostic messages,
468 my ($self, $this, $regex, $name) = @_;
469 my $usable_regex = $self->maybe_regex($regex);
470 die "expecting regex, found '$regex'\n"
471 unless $usable_regex;
472 $self->ok($this =~ m/$usable_regex/, $name);
479 my ($self, $regex) = @_;
480 my $usable_regex = undef;
481 if( ref $regex eq 'Regexp' ) {
482 $usable_regex = $regex;
484 # Check if it looks like '/foo/'
485 elsif( my($re, $opts) = $regex =~ m{^ /(.*)/ (\w*) $ }sx ) {
486 $usable_regex = length $opts ? "(?$opts)$re" : $re;
488 return($usable_regex)
492 my($self, $this, $regex, $cmp, $name) = @_;
494 local $Level = $Level + 1;
497 my $usable_regex = $self->maybe_regex($regex);
498 unless (defined $usable_regex) {
499 $ok = $self->ok( 0, $name );
500 $self->diag(" '$regex' doesn't look much like a regex to me.");
506 my $test = $this =~ /$usable_regex/ ? 1 : 0;
507 $test = !$test if $cmp eq '!~';
508 $ok = $self->ok( $test, $name );
512 $this = defined $this ? "'$this'" : 'undef';
513 my $match = $cmp eq '=~' ? "doesn't match" : "matches";
514 $self->diag(sprintf <<DIAGNOSTIC, $this, $match, $regex);
526 $Test->cmp_ok($this, $type, $that, $name);
528 Works just like Test::More's cmp_ok().
530 $Test->cmp_ok($big_num, '!=', $other_big_num);
535 my($self, $got, $type, $expect, $name) = @_;
540 local($@,$!); # don't interfere with $@
541 # eval() sometimes resets $!
542 $test = eval "\$got $type \$expect";
544 local $Level = $Level + 1;
545 my $ok = $self->ok($test, $name);
548 if( $type =~ /^(eq|==)$/ ) {
549 $self->_is_diag($got, $type, $expect);
552 $self->_cmp_diag($got, $type, $expect);
559 my($self, $got, $type, $expect) = @_;
561 $got = defined $got ? "'$got'" : 'undef';
562 $expect = defined $expect ? "'$expect'" : 'undef';
563 return $self->diag(sprintf <<DIAGNOSTIC, $got, $type, $expect);
572 $Test->BAILOUT($reason);
574 Indicates to the Test::Harness that things are going so badly all
575 testing should terminate. This includes running any additional test
578 It will exit with 255.
583 my($self, $reason) = @_;
585 $self->_print("Bail out! $reason");
594 Skips the current test, reporting $why.
599 my($self, $why) = @_;
602 unless( $Have_Plan ) {
604 Carp::croak("You tried to run tests without a plan! Gotta have a plan.");
609 $Test_Results[$Curr_Test-1] = 1;
612 $out .= " $Curr_Test" if $self->use_numbers;
613 $out .= " # skip $why\n";
624 $Test->todo_skip($why);
626 Like skip(), only it will declare the test as failing and TODO. Similar
629 print "not ok $tnum # TODO $why\n";
634 my($self, $why) = @_;
637 unless( $Have_Plan ) {
639 Carp::croak("You tried to run tests without a plan! Gotta have a plan.");
644 $Test_Results[$Curr_Test-1] = 1;
647 $out .= " $Curr_Test" if $self->use_numbers;
648 $out .= " # TODO & SKIP $why\n";
656 =begin _unimplemented
661 $Test->skip_rest($reason);
663 Like skip(), only it skips all the rest of the tests you plan to run
664 and terminates the test.
666 If you're running under no_plan, it skips once and terminates the
680 $Test->level($how_high);
682 How far up the call stack should $Test look when reporting where the
687 Setting $Test::Builder::Level overrides. This is typically useful
691 local $Test::Builder::Level = 2;
698 my($self, $level) = @_;
700 if( defined $level ) {
711 $Test->use_numbers($on_or_off);
713 Whether or not the test should output numbers. That is, this if true:
725 Most useful when you can't depend on the test output order, such as
726 when threads or forking is involved.
728 Test::Harness will accept either, but avoid mixing the two styles.
736 my($self, $use_nums) = @_;
738 if( defined $use_nums ) {
739 $Use_Nums = $use_nums;
746 $Test->no_header($no_header);
748 If set to true, no "1..N" header will be printed.
752 $Test->no_ending($no_ending);
754 Normally, Test::Builder does some extra diagnostics when the test
755 ends. It also changes the exit code as described in Test::Simple.
757 If this is true, none of that will be done.
761 my($No_Header, $No_Ending) = (0,0);
763 my($self, $no_header) = @_;
765 if( defined $no_header ) {
766 $No_Header = $no_header;
772 my($self, $no_ending) = @_;
774 if( defined $no_ending ) {
775 $No_Ending = $no_ending;
785 Controlling where the test output goes.
787 It's ok for your test to change where STDOUT and STDERR point to,
788 Test::Builder's default output settings will not be affected.
796 Prints out the given $message. Normally, it uses the failure_output()
797 handle, but if this is for a TODO test, the todo_output() handle is
800 Output will be indented and marked with a # so as not to interfere
801 with test output. A newline will be put on the end if there isn't one
804 We encourage using this rather than calling print directly.
806 Returns false. Why? Because diag() is often used in conjunction with
807 a failing test (C<ok() || diag()>) it "passes through" the failure.
809 return ok(...) || diag(...);
812 Mark Fowler <mark@twoshortplanks.com>
817 my($self, @msgs) = @_;
820 # Prevent printing headers when compiling (i.e. -c)
823 # Escape each line with a #.
825 $_ = 'undef' unless defined;
829 push @msgs, "\n" unless $msgs[-1] =~ /\n\Z/;
831 local $Level = $Level + 1;
832 my $fh = $self->todo ? $self->todo_output : $self->failure_output;
833 local($\, $", $,) = (undef, ' ', '');
843 $Test->_print(@msgs);
845 Prints to the output() filehandle.
852 my($self, @msgs) = @_;
854 # Prevent printing headers when only compiling. Mostly for when
855 # tests are deparsed with B::Deparse
858 local($\, $", $,) = (undef, ' ', '');
859 my $fh = $self->output;
861 # Escape each line after the first with a # so we don't
862 # confuse Test::Harness.
867 push @msgs, "\n" unless $msgs[-1] =~ /\n\Z/;
876 $Test->output($file);
878 Where normal "ok/not ok" test output should go.
882 =item B<failure_output>
884 $Test->failure_output($fh);
885 $Test->failure_output($file);
887 Where diagnostic output on test failures and diag() should go.
893 $Test->todo_output($fh);
894 $Test->todo_output($file);
896 Where diagnostics about todo test failures and diag() should go.
902 my($Out_FH, $Fail_FH, $Todo_FH);
907 $Out_FH = _new_fh($fh);
916 $Fail_FH = _new_fh($fh);
925 $Todo_FH = _new_fh($fh);
931 my($file_or_fh) = shift;
934 unless( UNIVERSAL::isa($file_or_fh, 'GLOB') ) {
935 $fh = do { local *FH };
936 open $fh, ">$file_or_fh" or
937 die "Can't open test output log $file_or_fh: $!";
947 # We dup STDOUT and STDERR so people can change them in their
948 # test suites while still getting normal test output.
949 open(TESTOUT, ">&STDOUT") or die "Can't dup STDOUT: $!";
950 open(TESTERR, ">&STDERR") or die "Can't dup STDERR: $!";
952 # Set everything to unbuffered else plain prints to STDOUT will
953 # come out in the wrong order from our own prints.
954 _autoflush(\*TESTOUT);
955 _autoflush(\*STDOUT);
956 _autoflush(\*TESTERR);
957 _autoflush(\*STDERR);
959 $CLASS->output(\*TESTOUT);
960 $CLASS->failure_output(\*TESTERR);
961 $CLASS->todo_output(\*TESTOUT);
966 my $old_fh = select $fh;
975 =head2 Test Status and Info
979 =item B<current_test>
981 my $curr_test = $Test->current_test;
982 $Test->current_test($num);
984 Gets/sets the current test # we're on.
986 You usually shouldn't have to set this.
991 my($self, $num) = @_;
995 unless( $Have_Plan ) {
997 Carp::croak("Can't change the current test number without a plan!");
1001 if( $num > @Test_Results ) {
1002 my $start = @Test_Results ? $#Test_Results : 0;
1003 for ($start..$num-1) {
1004 $Test_Results[$_] = 1;
1014 my @tests = $Test->summary;
1016 A simple summary of the tests so far. True for pass, false for fail.
1017 This is a logical pass/fail, so todos are passes.
1019 Of course, test #1 is $tests[0], etc...
1026 return @Test_Results;
1029 =item B<details> I<UNIMPLEMENTED>
1031 my @tests = $Test->details;
1033 Like summary(), but with a lot more detail.
1035 $tests[$test_num - 1] =
1036 { ok => is the test considered ok?
1037 actual_ok => did it literally say 'ok'?
1038 name => name of the test (if any)
1039 type => 'skip' or 'todo' (if any)
1040 reason => reason for the above (if any)
1045 my $todo_reason = $Test->todo;
1046 my $todo_reason = $Test->todo($pack);
1048 todo() looks for a $TODO variable in your tests. If set, all tests
1049 will be considered 'todo' (see Test::More and Test::Harness for
1050 details). Returns the reason (ie. the value of $TODO) if running as
1051 todo tests, false otherwise.
1053 todo() is pretty part about finding the right package to look for
1054 $TODO in. It uses the exported_to() package to find it. If that's
1055 not set, it's pretty good at guessing the right package to look at.
1057 Sometimes there is some confusion about where todo() should be looking
1058 for the $TODO variable. If you want to be sure, tell it explicitly
1064 my($self, $pack) = @_;
1066 $pack = $pack || $self->exported_to || $self->caller(1);
1069 return defined ${$pack.'::TODO'} ? ${$pack.'::TODO'}
1075 my $package = $Test->caller;
1076 my($pack, $file, $line) = $Test->caller;
1077 my($pack, $file, $line) = $Test->caller($height);
1079 Like the normal caller(), except it reports according to your level().
1084 my($self, $height) = @_;
1087 my @caller = CORE::caller($self->level + $height + 1);
1088 return wantarray ? @caller : $caller[0];
1099 =item B<_sanity_check>
1103 Runs a bunch of end of test sanity checks to make sure reality came
1104 through ok. If anything is wrong it will die with a fairly friendly
1111 _whoa($Curr_Test < 0, 'Says here you ran a negative number of tests!');
1112 _whoa(!$Have_Plan and $Curr_Test,
1113 'Somehow your tests ran without a plan!');
1114 _whoa($Curr_Test != @Test_Results,
1115 'Somehow you got a different number of results than tests ran!');
1120 _whoa($check, $description);
1122 A sanity check, similar to assert(). If the $check is true, something
1123 has gone horribly wrong. It will die with the given $description and
1124 a note to contact the author.
1129 my($check, $desc) = @_;
1133 This should never happen! Please contact the author immediately!
1140 _my_exit($exit_num);
1142 Perl seems to have some trouble with exiting inside an END block. 5.005_03
1143 and 5.6.1 both seem to do odd things. Instead, this function edits $?
1144 directly. It should ONLY be called from inside an END block. It
1145 doesn't actually exit, that's your job.
1162 $SIG{__DIE__} = sub {
1163 # We don't want to muck with death in an eval, but $^S isn't
1164 # totally reliable. 5.005_03 and 5.6.1 both do the wrong thing
1165 # with it. Instead, we use caller. This also means it runs under
1168 for( my $stack = 1; my $sub = (CORE::caller($stack))[3]; $stack++ ) {
1169 $in_eval = 1 if $sub =~ /^\(eval\)/;
1171 $Test_Died = 1 unless $in_eval;
1179 # Bailout if plan() was never called. This is so
1180 # "require Test::Simple" doesn't puke.
1181 do{ _my_exit(0) && return } if !$Have_Plan;
1183 # Figure out if we passed or failed and print helpful messages.
1184 if( @Test_Results ) {
1185 # The plan? We have no plan.
1187 $self->_print("1..$Curr_Test\n") unless $self->no_header;
1188 $Expected_Tests = $Curr_Test;
1191 my $num_failed = grep !$_, @Test_Results[0..$Expected_Tests-1];
1192 $num_failed += abs($Expected_Tests - @Test_Results);
1194 if( $Curr_Test < $Expected_Tests ) {
1195 $self->diag(<<"FAIL");
1196 Looks like you planned $Expected_Tests tests but only ran $Curr_Test.
1199 elsif( $Curr_Test > $Expected_Tests ) {
1200 my $num_extra = $Curr_Test - $Expected_Tests;
1201 $self->diag(<<"FAIL");
1202 Looks like you planned $Expected_Tests tests but ran $num_extra extra.
1205 elsif ( $num_failed ) {
1206 $self->diag(<<"FAIL");
1207 Looks like you failed $num_failed tests of $Expected_Tests.
1212 $self->diag(<<"FAIL");
1213 Looks like your test died just after $Curr_Test.
1216 _my_exit( 255 ) && return;
1219 _my_exit( $num_failed <= 254 ? $num_failed : 254 ) && return;
1221 elsif ( $Skip_All ) {
1222 _my_exit( 0 ) && return;
1225 $self->diag("No tests run!\n");
1226 _my_exit( 255 ) && return;
1231 $Test->_ending if defined $Test and !$Test->no_ending;
1236 At this point, Test::Simple and Test::More are your best examples.
1240 Test::Simple, Test::More, Test::Harness
1244 Original code by chromatic, maintained by Michael G Schwern
1245 E<lt>schwern@pobox.comE<gt>
1249 Copyright 2001 by chromatic E<lt>chromatic@wgz.orgE<gt>,
1250 Michael G Schwern E<lt>schwern@pobox.comE<gt>.
1252 This program is free software; you can redistribute it and/or
1253 modify it under the same terms as Perl itself.
1255 See F<http://www.perl.com/perl/misc/Artistic.html>