package Test::Builder;
-# $Id$
use 5.006;
use strict;
use warnings;
-our $VERSION = '0.86';
+our $VERSION = '0.92';
$VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval)
+BEGIN {
+ if( $] < 5.008 ) {
+ require Test::Builder::IO::Scalar;
+ }
+}
+
+
# Make Test::Builder thread-safe for ithreads.
BEGIN {
use Config;
test.
Since you only run one test per program C<new> always returns the same
-Test::Builder object. No matter how many times you call new(), you're
+Test::Builder object. No matter how many times you call C<new()>, you're
getting the same object. This is called a singleton. This is done so that
multiple modules share such global information as the test counter and
where test output is going.
$self->{Have_Plan} = 0;
$self->{No_Plan} = 0;
+ $self->{Have_Output_Plan} = 0;
+
$self->{Original_Pid} = $$;
share( $self->{Curr_Test} );
$self->{Todo} = undef;
$self->{Todo_Stack} = [];
$self->{Start_Todo} = 0;
+ $self->{Opened_Testhandles} = 0;
$self->_dup_stdhandles;
A convenient way to set up your tests. Call this and Test::Builder
will print the appropriate headers and take the appropriate actions.
-If you call plan(), don't call any of the other methods below.
+If you call C<plan()>, don't call any of the other methods below.
=cut
+my %plan_cmds = (
+ no_plan => \&no_plan,
+ skip_all => \&skip_all,
+ tests => \&_plan_tests,
+);
+
sub plan {
my( $self, $cmd, $arg ) = @_;
local $Level = $Level + 1;
- $self->croak("You tried to plan twice")
- if $self->{Have_Plan};
+ $self->croak("You tried to plan twice") if $self->{Have_Plan};
- if( $cmd eq 'no_plan' ) {
- $self->carp("no_plan takes no arguments") if $arg;
- $self->no_plan;
- }
- elsif( $cmd eq 'skip_all' ) {
- return $self->skip_all($arg);
- }
- elsif( $cmd eq 'tests' ) {
- if($arg) {
- local $Level = $Level + 1;
- return $self->expected_tests($arg);
- }
- elsif( !defined $arg ) {
- $self->croak("Got an undefined number of tests");
- }
- else {
- $self->croak("You said to run 0 tests");
- }
+ if( my $method = $plan_cmds{$cmd} ) {
+ local $Level = $Level + 1;
+ $self->$method($arg);
}
else {
my @args = grep { defined } ( $cmd, $arg );
return 1;
}
+
+sub _plan_tests {
+ my($self, $arg) = @_;
+
+ if($arg) {
+ local $Level = $Level + 1;
+ return $self->expected_tests($arg);
+ }
+ elsif( !defined $arg ) {
+ $self->croak("Got an undefined number of tests");
+ }
+ else {
+ $self->croak("You said to run 0 tests");
+ }
+
+ return;
+}
+
+
=item B<expected_tests>
my $max = $Test->expected_tests;
$Test->expected_tests($max);
-Gets/sets the # of tests we expect this test to run and prints out
+Gets/sets the number of tests we expect this test to run and prints out
the appropriate headers.
=cut
$self->{Expected_Tests} = $max;
$self->{Have_Plan} = 1;
- $self->_print("1..$max\n") unless $self->no_header;
+ $self->_output_plan($max) unless $self->no_header;
}
return $self->{Expected_Tests};
}
$Test->no_plan;
-Declares that this test will run an indeterminate # of tests.
+Declares that this test will run an indeterminate number of tests.
=cut
sub no_plan {
- my $self = shift;
+ my($self, $arg) = @_;
+
+ $self->carp("no_plan takes no arguments") if $arg;
$self->{No_Plan} = 1;
$self->{Have_Plan} = 1;
return 1;
}
+
+=begin private
+
+=item B<_output_plan>
+
+ $tb->_output_plan($max);
+ $tb->_output_plan($max, $directive);
+ $tb->_output_plan($max, $directive => $reason);
+
+Handles displaying the test plan.
+
+If a C<$directive> and/or C<$reason> are given they will be output with the
+plan. So here's what skipping all tests looks like:
+
+ $tb->_output_plan(0, "SKIP", "Because I said so");
+
+It sets C<< $tb->{Have_Output_Plan} >> and will croak if the plan was already
+output.
+
+=end private
+
+=cut
+
+sub _output_plan {
+ my($self, $max, $directive, $reason) = @_;
+
+ $self->carp("The plan was already output") if $self->{Have_Output_Plan};
+
+ my $plan = "1..$max";
+ $plan .= " # $directive" if defined $directive;
+ $plan .= " $reason" if defined $reason;
+
+ $self->_print("$plan\n");
+
+ $self->{Have_Output_Plan} = 1;
+
+ return;
+}
+
+=item B<done_testing>
+
+ $Test->done_testing();
+ $Test->done_testing($num_tests);
+
+Declares that you are done testing, no more tests will be run after this point.
+
+If a plan has not yet been output, it will do so.
+
+$num_tests is the number of tests you planned to run. If a numbered
+plan was already declared, and if this contradicts, a failing test
+will be run to reflect the planning mistake. If C<no_plan> was declared,
+this will override.
+
+If C<done_testing()> is called twice, the second call will issue a
+failing test.
+
+If C<$num_tests> is omitted, the number of tests run will be used, like
+no_plan.
+
+C<done_testing()> is, in effect, used when you'd want to use C<no_plan>, but
+safer. You'd use it like so:
+
+ $Test->ok($a == $b);
+ $Test->done_testing();
+
+Or to plan a variable number of tests:
+
+ for my $test (@tests) {
+ $Test->ok($test);
+ }
+ $Test->done_testing(@tests);
+
+=cut
+
+sub done_testing {
+ my($self, $num_tests) = @_;
+
+ # If done_testing() specified the number of tests, shut off no_plan.
+ if( defined $num_tests ) {
+ $self->{No_Plan} = 0;
+ }
+ else {
+ $num_tests = $self->current_test;
+ }
+
+ if( $self->{Done_Testing} ) {
+ my($file, $line) = @{$self->{Done_Testing}}[1,2];
+ $self->ok(0, "done_testing() was already called at $file line $line");
+ return;
+ }
+
+ $self->{Done_Testing} = [caller];
+
+ if( $self->expected_tests && $num_tests != $self->expected_tests ) {
+ $self->ok(0, "planned to run @{[ $self->expected_tests ]} ".
+ "but done_testing() expects $num_tests");
+ }
+ else {
+ $self->{Expected_Tests} = $num_tests;
+ }
+
+ $self->_output_plan($num_tests) unless $self->{Have_Output_Plan};
+
+ $self->{Have_Plan} = 1;
+
+ return 1;
+}
+
+
=item B<has_plan>
$plan = $Test->has_plan
-Find out whether a plan has been defined. $plan is either C<undef> (no plan has been set), C<no_plan> (indeterminate # of tests) or an integer (the number of expected tests).
+Find out whether a plan has been defined. C<$plan> is either C<undef> (no plan
+has been set), C<no_plan> (indeterminate # of tests) or an integer (the number
+of expected tests).
=cut
$Test->skip_all;
$Test->skip_all($reason);
-Skips all the tests, using the given $reason. Exits immediately with 0.
+Skips all the tests, using the given C<$reason>. Exits immediately with 0.
=cut
sub skip_all {
my( $self, $reason ) = @_;
- my $out = "1..0";
- $out .= " # Skip $reason" if $reason;
- $out .= "\n";
-
$self->{Skip_All} = 1;
- $self->_print($out) unless $self->no_header;
+ $self->_output_plan(0, "SKIP", $reason) unless $self->no_header;
exit(0);
}
They all return true if the test passed, false if the test failed.
-$name is always optional.
+C<$name> is always optional.
=over 4
$Test->ok($test, $name);
-Your basic test. Pass if $test is true, fail if $test is false. Just
-like Test::Simple's ok().
+Your basic test. Pass if C<$test> is true, fail if $test is false. Just
+like Test::Simple's C<ok()>.
=cut
# store, so we turn it into a boolean.
$test = $test ? 1 : 0;
- $self->_plan_check;
-
lock $self->{Curr_Test};
$self->{Curr_Test}++;
$Test->is_eq($got, $expected, $name);
-Like Test::More's is(). Checks if $got eq $expected. This is the
+Like Test::More's C<is()>. Checks if C<$got eq $expected>. This is the
string version.
=item B<is_num>
$Test->is_num($got, $expected, $name);
-Like Test::More's is(). Checks if $got == $expected. This is the
+Like Test::More's C<is()>. Checks if C<$got == $expected>. This is the
numeric version.
=cut
$Test->isnt_eq($got, $dont_expect, $name);
-Like Test::More's isnt(). Checks if $got ne $dont_expect. This is
+Like Test::More's C<isnt()>. Checks if C<$got ne $dont_expect>. This is
the string version.
=item B<isnt_num>
$Test->isnt_num($got, $dont_expect, $name);
-Like Test::More's isnt(). Checks if $got ne $dont_expect. This is
+Like Test::More's C<isnt()>. Checks if C<$got ne $dont_expect>. This is
the numeric version.
=cut
$Test->like($this, qr/$regex/, $name);
$Test->like($this, '/$regex/', $name);
-Like Test::More's like(). Checks if $this matches the given $regex.
+Like Test::More's C<like()>. Checks if $this matches the given C<$regex>.
-You'll want to avoid qr// if you want your tests to work before 5.005.
+You'll want to avoid C<qr//> if you want your tests to work before 5.005.
=item B<unlike>
$Test->unlike($this, qr/$regex/, $name);
$Test->unlike($this, '/$regex/', $name);
-Like Test::More's unlike(). Checks if $this B<does not match> the
-given $regex.
+Like Test::More's C<unlike()>. Checks if $this B<does not match> the
+given C<$regex>.
=cut
$Test->cmp_ok($this, $type, $that, $name);
-Works just like Test::More's cmp_ok().
+Works just like Test::More's C<cmp_ok()>.
$Test->cmp_ok($big_num, '!=', $other_big_num);
$Test->skip;
$Test->skip($why);
-Skips the current test, reporting $why.
+Skips the current test, reporting C<$why>.
=cut
$why ||= '';
$self->_unoverload_str( \$why );
- $self->_plan_check;
-
lock( $self->{Curr_Test} );
$self->{Curr_Test}++;
$Test->todo_skip;
$Test->todo_skip($why);
-Like skip(), only it will declare the test as failing and TODO. Similar
+Like C<skip()>, only it will declare the test as failing and TODO. Similar
to
print "not ok $tnum # TODO $why\n";
my( $self, $why ) = @_;
$why ||= '';
- $self->_plan_check;
-
lock( $self->{Curr_Test} );
$self->{Curr_Test}++;
$Test->skip_rest;
$Test->skip_rest($reason);
-Like skip(), only it skips all the rest of the tests you plan to run
+Like C<skip()>, only it skips all the rest of the tests you plan to run
and terminates the test.
-If you're running under no_plan, it skips once and terminates the
+If you're running under C<no_plan>, it skips once and terminates the
test.
=end _unimplemented
Convenience method for building testing functions that take regular
expressions as arguments, but need to work before perl 5.005.
-Takes a quoted regular expression produced by qr//, or a string
+Takes a quoted regular expression produced by C<qr//>, or a string
representing a regular expression.
Returns a Perl value which may be used instead of the corresponding
-regular expression, or undef if its argument is not recognised.
+regular expression, or C<undef> if its argument is not recognised.
-For example, a version of like(), sans the useful diagnostic messages,
+For example, a version of C<like()>, sans the useful diagnostic messages,
could be written as:
sub laconic_like {
my($return_from_code, $error) = $Test->try(sub { code });
Works like eval BLOCK except it ensures it has no effect on the rest
-of the test (ie. $@ is not set) nor is effected by outside
-interference (ie. $SIG{__DIE__}) and works around some quirks in older
+of the test (ie. C<$@> is not set) nor is effected by outside
+interference (ie. C<$SIG{__DIE__}>) and works around some quirks in older
Perls.
-$error is what would normally be in $@.
+C<$error> is what would normally be in C<$@>.
It is suggested you use this in place of eval BLOCK.
my $is_fh = $Test->is_fh($thing);
-Determines if the given $thing can be used as a filehandle.
+Determines if the given C<$thing> can be used as a filehandle.
=cut
$Test->level($how_high);
-How far up the call stack should $Test look when reporting where the
+How far up the call stack should C<$Test> look when reporting where the
test failed.
Defaults to 1.
$Test->no_diag($no_diag);
If set true no diagnostics will be printed. This includes calls to
-diag().
+C<diag()>.
=item B<no_ending>
$Test->diag(@msgs);
-Prints out the given @msgs. Like C<print>, arguments are simply
+Prints out the given C<@msgs>. Like C<print>, arguments are simply
appended together.
-Normally, it uses the failure_output() handle, but if this is for a
-TODO test, the todo_output() handle is used.
+Normally, it uses the C<failure_output()> handle, but if this is for a
+TODO test, the C<todo_output()> handle is used.
Output will be indented and marked with a # so as not to interfere
with test output. A newline will be put on the end if there isn't one
We encourage using this rather than calling print directly.
-Returns false. Why? Because diag() is often used in conjunction with
+Returns false. Why? Because C<diag()> is often used in conjunction with
a failing test (C<ok() || diag()>) it "passes through" the failure.
return ok(...) || diag(...);
$Test->note(@msgs);
-Like diag(), but it prints to the C<output()> handle so it will not
+Like C<diag()>, but it prints to the C<output()> handle so it will not
normally be seen by the user except in verbose mode.
=cut
$Test->_print(@msgs);
-Prints to the output() filehandle.
+Prints to the C<output()> filehandle.
=end _private
=item B<output>
- $Test->output($fh);
- $Test->output($file);
-
-Where normal "ok/not ok" test output should go.
+=item B<failure_output>
-Defaults to STDOUT.
+=item B<todo_output>
-=item B<failure_output>
+ my $filehandle = $Test->output;
+ $Test->output($filehandle);
+ $Test->output($filename);
+ $Test->output(\$scalar);
- $Test->failure_output($fh);
- $Test->failure_output($file);
+These methods control where Test::Builder will print its output.
+They take either an open C<$filehandle>, a C<$filename> to open and write to
+or a C<$scalar> reference to append to. It will always return a C<$filehandle>.
-Where diagnostic output on test failures and diag() should go.
+B<output> is where normal "ok/not ok" test output goes.
-Defaults to STDERR.
+Defaults to STDOUT.
-=item B<todo_output>
+B<failure_output> is where diagnostic output on test failures and
+C<diag()> goes. It is normally not read by Test::Harness and instead is
+displayed to the user.
- $Test->todo_output($fh);
- $Test->todo_output($file);
+Defaults to STDERR.
-Where diagnostics about todo test failures and diag() should go.
+C<todo_output> is used instead of C<failure_output()> for the
+diagnostics of a failing TODO test. These will not be seen by the
+user.
Defaults to STDOUT.
if( $self->is_fh($file_or_fh) ) {
$fh = $file_or_fh;
}
+ elsif( ref $file_or_fh eq 'SCALAR' ) {
+ # Scalar refs as filehandles was added in 5.8.
+ if( $] >= 5.008 ) {
+ open $fh, ">>", $file_or_fh
+ or $self->croak("Can't open scalar ref $file_or_fh: $!");
+ }
+ # Emulate scalar ref filehandles with a tie.
+ else {
+ $fh = Test::Builder::IO::Scalar->new($file_or_fh)
+ or $self->croak("Can't tie scalar ref $file_or_fh");
+ }
+ }
else {
open $fh, ">", $file_or_fh
or $self->croak("Can't open test output log $file_or_fh: $!");
return;
}
-my $Opened_Testhandles = 0;
-
sub _open_testhandles {
my $self = shift;
- return if $Opened_Testhandles;
+ return if $self->{Opened_Testhandles};
# We dup STDOUT and STDERR so people can change them in their
# test suites while still getting normal test output.
# $self->_copy_io_layers( \*STDOUT, $Testout );
# $self->_copy_io_layers( \*STDERR, $Testerr );
- $Opened_Testhandles = 1;
+ $self->{Opened_Testhandles} = 1;
return;
}
$tb->carp(@message);
Warns with C<@message> but the message will appear to come from the
-point where the original test function was called (C<$tb->caller>).
+point where the original test function was called (C<< $tb->caller >>).
=item croak
$tb->croak(@message);
Dies with C<@message> but the message will appear to come from the
-point where the original test function was called (C<$tb->caller>).
+point where the original test function was called (C<< $tb->caller >>).
=cut
return die $self->_message_at_caller(@_);
}
-sub _plan_check {
- my $self = shift;
-
- unless( $self->{Have_Plan} ) {
- local $Level = $Level + 2;
- $self->croak("You tried to run a test without a plan");
- }
-
- return;
-}
=back
lock( $self->{Curr_Test} );
if( defined $num ) {
- $self->croak("Can't change the current test number without a plan!")
- unless $self->{Have_Plan};
-
$self->{Curr_Test} = $num;
# If the test counter is being pushed forward fill in the details.
my @tests = $Test->details;
-Like summary(), but with a lot more detail.
+Like C<summary()>, but with a lot more detail.
$tests[$test_num - 1] =
{ 'ok' => is the test considered a pass?
'actual_ok' is a reflection of whether or not the test literally
printed 'ok' or 'not ok'. This is for examining the result of 'todo'
-tests.
+tests.
'name' is the name of the test.
unknown see below
Sometimes the Test::Builder test counter is incremented without it
-printing any test output, for example, when current_test() is changed.
+printing any test output, for example, when C<current_test()> is changed.
In these cases, Test::Builder doesn't know the result of the test, so
its type is 'unknown'. These details for these tests are filled in.
-They are considered ok, but the name and actual_ok is left undef.
+They are considered ok, but the name and actual_ok is left C<undef>.
For example "not ok 23 - hole count # TODO insufficient donuts" would
result in this structure:
$tests[22] = # 23 - 1, since arrays start from 0.
- { ok => 1, # logically, the test passed since it's todo
+ { ok => 1, # logically, the test passed since its todo
actual_ok => 0, # in absolute terms, it failed
name => 'hole count',
type => 'todo',
my $todo_reason = $Test->todo($pack);
If the current tests are considered "TODO" it will return the reason,
-if any. This reason can come from a $TODO variable or the last call
-to C<<todo_start()>>.
+if any. This reason can come from a C<$TODO> variable or the last call
+to C<todo_start()>.
Since a TODO test does not need a reason, this function can return an
-empty string even when inside a TODO block. Use C<<$Test->in_todo>>
+empty string even when inside a TODO block. Use C<< $Test->in_todo >>
to determine if you are currently inside a TODO block.
-todo() is about finding the right package to look for $TODO in. It's
+C<todo()> is about finding the right package to look for C<$TODO> in. It's
pretty good at guessing the right package to look at. It first looks for
the caller based on C<$Level + 1>, since C<todo()> is usually called inside
a test function. As a last resort it will use C<exported_to()>.
Sometimes there is some confusion about where todo() should be looking
-for the $TODO variable. If you want to be sure, tell it explicitly
+for the C<$TODO> variable. If you want to be sure, tell it explicitly
what $pack to use.
=cut
my $todo_reason = $Test->find_TODO();
my $todo_reason = $Test->find_TODO($pack):
-Like C<<todo()>> but only returns the value of C<<$TODO>> ignoring
-C<<todo_start()>>.
+Like C<todo()> but only returns the value of C<$TODO> ignoring
+C<todo_start()>.
=cut
my($pack, $file, $line) = $Test->caller;
my($pack, $file, $line) = $Test->caller($height);
-Like the normal caller(), except it reports according to your level().
+Like the normal C<caller()>, except it reports according to your C<level()>.
-C<$height> will be added to the level().
+C<$height> will be added to the C<level()>.
-If caller() winds up off the top of the stack it report the highest context.
+If C<caller()> winds up off the top of the stack it report the highest context.
=cut
my $self = shift;
$self->_whoa( $self->{Curr_Test} < 0, 'Says here you ran a negative number of tests!' );
- $self->_whoa( !$self->{Have_Plan} and $self->{Curr_Test},
- 'Somehow your tests ran without a plan!' );
$self->_whoa( $self->{Curr_Test} != @{ $self->{Test_Results} },
'Somehow you got a different number of results than tests ran!' );
$self->_whoa($check, $description);
-A sanity check, similar to assert(). If the $check is true, something
-has gone horribly wrong. It will die with the given $description and
+A sanity check, similar to C<assert()>. If the C<$check> is true, something
+has gone horribly wrong. It will die with the given C<$description> and
a note to contact the author.
=cut
_my_exit($exit_num);
-Perl seems to have some trouble with exiting inside an END block. 5.005_03
-and 5.6.1 both seem to do odd things. Instead, this function edits $?
-directly. It should ONLY be called from inside an END block. It
+Perl seems to have some trouble with exiting inside an C<END> block. 5.005_03
+and 5.6.1 both seem to do odd things. Instead, this function edits C<$?>
+directly. It should B<only> be called from inside an C<END> block. It
doesn't actually exit, that's your job.
=cut
my $self = shift;
my $real_exit_code = $?;
- $self->_sanity_check();
# Don't bother with an ending if this is a forked copy. Only the parent
# should do the ending.
return;
}
+ # Ran tests but never declared a plan or hit done_testing
+ if( !$self->{Have_Plan} and $self->{Curr_Test} ) {
+ $self->diag("Tests were run but no plan was declared and done_testing() was not seen.");
+ }
+
# Exit if plan() was never called. This is so "require Test::Simple"
# doesn't puke.
if( !$self->{Have_Plan} ) {
if(@$test_results) {
# The plan? We have no plan.
if( $self->{No_Plan} ) {
- $self->_print("1..$self->{Curr_Test}\n") unless $self->no_header;
+ $self->_output_plan($self->{Curr_Test}) unless $self->no_header;
$self->{Expected_Tests} = $self->{Curr_Test};
}
If you fail more than 254 tests, it will be reported as 254.
-
=head1 THREADS
In perl 5.8.1 and later, Test::Builder is thread-safe. The test
number is shared amongst all threads. This means if one thread sets
-the test number using current_test() they will all be effected.
+the test number using C<current_test()> they will all be effected.
While versions earlier than 5.8.1 had threads they contain too many
bugs to support.
Test::Builder is only thread-aware if threads.pm is loaded I<before>
Test::Builder.
+=head1 MEMORY
+
+An informative hash, accessable via C<<details()>>, is stored for each
+test you perform. So memory usage will scale linearly with each test
+run. Although this is not a problem for most test suites, it can
+become an issue if you do large (hundred thousands to million)
+combinatorics tests in the same run.
+
+In such cases, you are advised to either split the test file into smaller
+ones, or use a reverse approach, doing "normal" (code) compares and
+triggering fail() should anything go unexpected.
+
+Future versions of Test::Builder will have a way to turn history off.
+
+
=head1 EXAMPLES
CPAN can provide the best examples. Test::Simple, Test::More,
Copyright 2002-2008 by chromatic E<lt>chromatic@wgz.orgE<gt> and
Michael G Schwern E<lt>schwern@pobox.comE<gt>.
-This program is free software; you can redistribute it and/or
+This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
See F<http://www.perl.com/perl/misc/Artistic.html>
projects / p5sagit/p5-mst-13.2.git / blobdiff