lib/Test/Simple/t/Builder/Builder.t Test::Builder tests
lib/Test/Simple/t/Builder/carp.t Test::Builder test
lib/Test/Simple/t/Builder/create.t Test::Builder test
-lib/Test/Simple/t/Builder/curr_test.t Test::Builder->curr_test tests
+lib/Test/Simple/t/Builder/current_test.t Test::Builder tests
+lib/Test/Simple/t/Builder/current_test_without_plan.t Test::Builder tests
lib/Test/Simple/t/Builder/details.t Test::Builder tests
+lib/Test/Simple/t/Builder/done_testing_double.t Test::Builder tests
+lib/Test/Simple/t/Builder/done_testing_plan_mismatch.t Test::Builder tests
+lib/Test/Simple/t/Builder/done_testing.t Test::Builder tests
+lib/Test/Simple/t/Builder/done_testing_with_no_plan.t Test::Builder tests
+lib/Test/Simple/t/Builder/done_testing_with_number.t Test::Builder tests
+lib/Test/Simple/t/Builder/done_testing_with_plan.t Test::Builder tests
+lib/Test/Simple/t/Builder/fork_with_new_stdout.t Test::Builder tests
lib/Test/Simple/t/Builder/has_plan2.t Test::Builder tests
lib/Test/Simple/t/Builder/has_plan.t Test::Builder tests
lib/Test/Simple/t/Builder/is_fh.t Test::Builder tests
lib/Test/Simple/t/Builder/no_diag.t Test::Builder tests
lib/Test/Simple/t/Builder/no_ending.t Test::Builder tests
lib/Test/Simple/t/Builder/no_header.t Test::Builder tests
+lib/Test/Simple/t/Builder/no_plan_at_all.t Test::Builder tests
lib/Test/Simple/t/Builder/ok_obj.t Test::Builder tests
lib/Test/Simple/t/Builder/output.t Test::Builder tests
lib/Test/Simple/t/Builder/reset.t Test::Builder tests
lib/Test/Simple/t/useing.t Test::More test, compile test
lib/Test/Simple/t/use_ok.t Test::More test, use_ok()
lib/Test/Simple/t/utf8.t Test::More test
+lib/Test/Simple/t/versions.t Test::More test
lib/Test/t/05_about_verbose.t See if Test works
lib/Test/t/fail.t See if Test works
lib/Test/t/mix.t See if Test works
t/lib/strict/refs Tests of "use strict 'refs'" for strict.t
t/lib/strict/subs Tests of "use strict 'subs'" for strict.t
t/lib/strict/vars Tests of "use strict 'vars'" for strict.t
+t/lib/Test/Builder/NoOutput.pm Utility module for testing Test::Builder
t/lib/Test/Simple/Catch.pm Utility module for testing Test::Simple
t/lib/Test/Simple/sample_tests/death_in_eval.plx for exit.t
t/lib/Test/Simple/sample_tests/death.plx for exit.t
'Test::Simple' =>
{
'MAINTAINER' => 'mschwern',
- 'DISTRIBUTION' => 'MSCHWERN/Test-Simple-0.86.tar.gz',
+ 'DISTRIBUTION' => 'MSCHWERN/Test-Simple-0.92.tar.gz',
'FILES' => q[lib/Test/Simple.pm
lib/Test/Simple
lib/Test/Builder.pm
lib/Test/Builder
lib/Test/More.pm
lib/Test/Tutorial.pod
- t/lib/Test/Simple
+ t/lib/Test/
t/lib/Dev/Null.pm
],
'EXCLUDED' => [
# NB - TieOut.pm comes with more than one
# distro. We use the MM one
- # XXX should all these actually be excluded
- # from blead ???? - DAPM
qw{.perlcriticrc
.perltidyrc
t/pod.t
t/pod-coverage.t
- t/versions.t
- t/Builder/current_test.t
- t/Builder/current_test_without_plan.t
- t/Builder/done_testing.t
- t/Builder/done_testing_double.t
- t/Builder/done_testing_plan_mismatch.t
- t/Builder/done_testing_with_no_plan.t
- t/Builder/done_testing_with_number.t
- t/Builder/done_testing_with_plan.t
- t/Builder/fork_with_new_stdout.t
- t/Builder/no_plan_at_all.t
- t/Builder/reset_outputs.t
lib/Test/Builder/IO/Scalar.pm
- t/lib/Test/Builder/NoOutput.pm
t/lib/TieOut.pm
}
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>
package Test::Builder::Module;
-# $Id$
use strict;
require Exporter;
our @ISA = qw(Exporter);
-our $VERSION = '0.86';
+our $VERSION = '0.92';
+$VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval)
# 5.004's Exporter doesn't have export_to_level.
my $_export_to_level = sub {
package Test::Builder::Tester;
-# $Id$
use strict;
our $VERSION = "1.18";
package Test::Builder::Tester::Color;
-# $Id$
use strict;
+our $VERSION = "1.18";
require Test::Builder::Tester;
+
=head1 NAME
Test::Builder::Tester::Color - turn on colour in Test::Builder::Tester
package Test::More;
-# $Id$
use 5.006;
use strict;
return warn @_, " at $file line $line\n";
}
-our $VERSION = '0.86';
+our $VERSION = '0.92';
$VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval)
use Test::Builder::Module;
eq_array eq_hash eq_set
$TODO
plan
+ done_testing
can_ok isa_ok new_ok
diag note explain
BAIL_OUT
use Test::More tests => 23;
# or
- use Test::More qw(no_plan);
- # or
use Test::More skip_all => $reason;
+ # or
+ use Test::More; # see done_testing()
BEGIN { use_ok( 'Some::Module' ); }
require_ok( 'Some::Module' );
=head1 DESCRIPTION
B<STOP!> If you're just getting started writing tests, have a look at
-Test::Simple first. This is a drop in replacement for Test::Simple
+L<Test::Simple> first. This is a drop in replacement for Test::Simple
which you can switch to once you get the hang of basic testing.
The purpose of this module is to provide a wide range of testing
use Test::More tests => 23;
-There are rare cases when you will not know beforehand how many tests
-your script is going to run. In this case, you can declare that you
-have no plan. (Try to avoid using this as it weakens your test.)
+There are cases when you will not know beforehand how many tests your
+script is going to run. In this case, you can declare your tests at
+the end.
+
+ use Test::More;
+
+ ... run your tests ...
- use Test::More qw(no_plan);
+ done_testing( $number_of_tests_run );
-B<NOTE>: using no_plan requires a Test::Harness upgrade else it will
-think everything has failed. See L<CAVEATS and NOTES>).
+Sometimes you really don't know how many tests were run, or it's too
+difficult to calculate. In which case you can leave off
+$number_of_tests_run.
In some cases, you'll want to completely skip an entire testing script.
return;
}
+=over 4
+
+=item B<done_testing>
+
+ done_testing();
+ done_testing($number_of_tests);
+
+If you don't know how many tests you're going to run, you can issue
+the plan when you're done running tests.
+
+$number_of_tests is the same as plan(), it's the number of tests you
+expected to run. You can omit this, in which case the number of tests
+you ran doesn't matter, just the fact that your tests ran to
+conclusion.
+
+This is safer than and replaces the "no_plan" plan.
+
+=back
+
+=cut
+
+sub done_testing {
+ my $tb = Test::More->builder;
+ $tb->done_testing(@_);
+}
+
=head2 Test names
By convention, each test is assigned a number in order. This is
ok( exists $brooklyn{tree}, 'A tree grows in Brooklyn' );
+A simple call to isnt() usually does not provide a strong test but there
+are cases when you cannot say much more about a value than that it is
+different from some other value:
+
+ new_ok $obj, "Foo";
+
+ my $clone = $obj->clone;
+ isa_ok $obj, "Foo", "Foo->clone";
+
+ isnt $obj, $clone, "clone() produces a different object";
+
For those grammatical pedants out there, there's an C<isn't()>
function which is an alias of isnt().
cmp_ok( $big_hairy_number, '==', $another_big_hairy_number );
+It's especially useful when comparing greater-than or smaller-than
+relation between values:
+
+ cmp_ok( $some_value, '<=', $upper_limit );
+
+
=cut
sub cmp_ok($$$;$) {
=item B<isa_ok>
- isa_ok($object, $class, $object_name);
- isa_ok($ref, $type, $ref_name);
+ isa_ok($object, $class, $object_name);
+ isa_ok($subclass, $class, $object_name);
+ isa_ok($ref, $type, $ref_name);
Checks to see if the given C<< $object->isa($class) >>. Also checks to make
sure the object was defined in the first place. Handy for this sort
to safeguard against your test script blowing up.
+You can also test a class, to make sure that it has the right ancestor:
+
+ isa_ok( 'Vole', 'Rodent' );
+
It works on references, too:
isa_ok( $array_ref, 'ARRAY' );
my $tb = Test::More->builder;
my $diag;
- $obj_name = 'The object' unless defined $obj_name;
- my $name = "$obj_name isa $class";
+
if( !defined $object ) {
+ $obj_name = 'The thing' unless defined $obj_name;
$diag = "$obj_name isn't defined";
}
- elsif( !ref $object ) {
- $diag = "$obj_name isn't a reference";
- }
else {
+ my $whatami = ref $object ? 'object' : 'class';
# We can't use UNIVERSAL::isa because we want to honor isa() overrides
my( $rslt, $error ) = $tb->_try( sub { $object->isa($class) } );
if($error) {
if( $error =~ /^Can't call method "isa" on unblessed reference/ ) {
# Its an unblessed reference
+ $obj_name = 'The reference' unless defined $obj_name;
if( !UNIVERSAL::isa( $object, $class ) ) {
my $ref = ref $object;
$diag = "$obj_name isn't a '$class' it's a '$ref'";
}
}
+ elsif( $error =~ /Can't call method "isa" without a package/ ) {
+ # It's something that can't even be a class
+ $diag = "$obj_name isn't a class or reference";
+ }
else {
die <<WHOA;
-WHOA! I tried to call ->isa on your object and got some weird error.
+WHOA! I tried to call ->isa on your $whatami and got some weird error.
Here's the error.
$error
WHOA
}
}
- elsif( !$rslt ) {
- my $ref = ref $object;
- $diag = "$obj_name isn't a '$class' it's a '$ref'";
+ else {
+ $obj_name = "The $whatami" unless defined $obj_name;
+ if( !$rslt ) {
+ my $ref = ref $object;
+ $diag = "$obj_name isn't a '$class' it's a '$ref'";
+ }
}
}
+ my $name = "$obj_name isa $class";
my $ok;
if($diag) {
$ok = $tb->ok( 0, $name );
references themselves (except for their type) are ignored. This means
aspects such as blessing and ties are not considered "different".
-is_deeply() current has very limited handling of function reference
+is_deeply() currently has very limited handling of function reference
and globs. It merely checks if they have the same referent. This may
improve in the future.
-Test::Differences and Test::Deep provide more in-depth functionality
+L<Test::Differences> and L<Test::Deep> provide more in-depth functionality
along these lines.
=cut
my @dump = explain @diagnostic_message;
Will dump the contents of any references in a human readable format.
-Usually you want to pass this into C<note> or C<dump>.
+Usually you want to pass this into C<note> or C<diag>.
Handy for things like...
The test will exit with 255.
+For even better control look at L<Test::Most>.
+
=cut
sub BAIL_OUT {
if( defined $e1 xor defined $e2 ) {
$ok = 0;
}
+ elsif( !defined $e1 and !defined $e2 ) {
+ # Shortcut if they're both defined.
+ $ok = 1;
+ }
elsif( _dne($e1) xor _dne($e2) ) {
$ok = 0;
}
eq_set([\1, \2], [\2, \1]);
-Test::Deep contains much better set comparison functions.
+L<Test::Deep> contains much better set comparison functions.
=cut
Test::More works with Perls as old as 5.6.0.
+=item utf8 / "Wide character in print"
+
+If you use utf8 or other non-ASCII characters with Test::More you
+might get a "Wide character in print" warning. Using C<binmode
+STDOUT, ":utf8"> will not fix it. Test::Builder (which powers
+Test::More) duplicates STDOUT and STDERR. So any changes to them,
+including changing their output disciplines, will not be seem by
+Test::More.
+
+The work around is to change the filehandles used by Test::Builder
+directly.
+
+ my $builder = Test::More->builder;
+ binmode $builder->output, ":utf8";
+ binmode $builder->failure_output, ":utf8";
+ binmode $builder->todo_output, ":utf8";
+
+
=item Overloaded objects
String overloaded objects are compared B<as strings> (or in cmp_ok()'s
However, it does mean that functions like is_deeply() cannot be used to
test the internals of string overloaded objects. In this case I would
-suggest Test::Deep which contains more flexible testing functions for
+suggest L<Test::Deep> which contains more flexible testing functions for
complex data structures.
=item Test::Harness upgrade
-no_plan and todo depend on new Test::Harness features and fixes. If
-you're going to distribute tests that use no_plan or todo your
-end-users will have to upgrade Test::Harness to the latest one on
-CPAN. If you avoid no_plan and TODO tests, the stock Test::Harness
-will work fine.
+no_plan, todo and done_testing() depend on new Test::Harness features
+and fixes. If you're going to distribute tests that use no_plan or
+todo your end-users will have to upgrade Test::Harness to the latest
+one on CPAN. If you avoid no_plan and TODO tests, the stock
+Test::Harness will work fine.
Installing Test::More should also upgrade Test::Harness.
See F<http://rt.cpan.org> to report and view bugs.
+=head1 SOURCE
+
+The source code repository for Test::More can be found at
+F<http://github.com/schwern/test-more/>.
+
+
=head1 COPYRIGHT
Copyright 2001-2008 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
package Test::Simple;
-# $Id$
use 5.004;
use strict;
-our $VERSION = '0.86_01';
+our $VERSION = '0.92';
$VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval)
use Test::Builder::Module;
+0.92 Fri Jul 3 11:08:56 PDT 2009
+ Test Fixes
+ * Silence noise on VMS in exit.t (Craig Berry)
+ * Skip Builder/fork_with_new_stdout.t on systems without fork (Craig Berry)
+
+
+0.90 Thu Jul 2 13:18:25 PDT 2009
+ Docs
+ * Finally added a note about the "Wide character in print" warning and
+ how to work around it.
+ * Note the IO::Stringy license in our copy of it.
+ [test-more.googlecode.com 47]
+
+ Test Fixes
+ * Small fixes for integration with the Perl core
+ [bleadperl eaa0815147e13cd4ab5b3d6ca8f26544a9f0c3b4]
+ * exit code tests could be effected by errno when PERLIO=stdio
+ [bleadperl c76230386fc5e6fba9fdbeab473abbf4f4adcbe3]
+
+ Other
+ * This is a stable release for 5.10.1. It does not include
+ the subtest() work in 0.89_01.
+
+
+0.88 Sat May 30 12:31:24 PDT 2009
+ Turing 0.87_03 into a stable release.
+
+
+0.87_03 Sun May 24 13:41:40 PDT 2009
+ New Features
+ * isa_ok() now works on classes. (Peter Scott)
+
+
+0.87_02 Sat Apr 11 12:54:14 PDT 2009
+ Test Fixes
+ * Some filesystems don't like it when you open a file for writing multiple
+ times. Fixes t/Builder/reset.t. [rt.cpan.org 17298]
+ * Check how an operating system is going to map exit codes. Some OS'
+ will map them... sometimes. [rt.cpan.org 42148]
+ * Fix Test::Builder::NoOutput on 5.6.2.
+
+
+0.87_01 Sun Mar 29 09:56:52 BST 2009
+ New Features
+ * done_testing() allows you to declare that you have finished running tests,
+ and how many you ran. It is a safer no_plan and effectively replaces it.
+ * output() now supports scalar references.
+
+ Feature Changes
+ * You can now run a test without first declaring a plan. This allows
+ done_testing() to work.
+ * You can now call current_test() without first declaring a plan.
+
+ Bug Fixes
+ * skip_all() with no reason would output "1..0" which is invalid TAP. It will
+ now always include the SKIP directive.
+
+ Other
+ * Repository moved to github.
+
+
0.86 Sun Nov 9 01:09:05 PST 2008
Same as 0.85_01
-# $Id$
This is the README file for Test::Simple, basic utilities for
writing tests, by Michael G Schwern <schwern@pobox.com>.
make
make test
make install
+
+It requires Perl version 5.6.0 or newer and Test::Harness 2.03 or newer.
+
+
+* More Info
+
+More information can be found at http://test-more.googlecode.com/
-# $Id$
See https://rt.cpan.org/NoAuth/Bugs.html?Dist=Test-Simple plus here's
a few more I haven't put in RT yet.
#!/usr/bin/perl -w
-# $Id$
# A test to make sure the new Test::Harness was installed properly.
#!/usr/bin/perl -w
-# $Id$
+
+# Fixed a problem with BEGIN { use_ok or require_ok } silently failing when there's no
+# plan set. [rt.cpan.org 28345] Thanks Adriano Ferreira and Yitzchak.
+
+use strict;
BEGIN {
if( $ENV{PERL_CORE} ) {
my $result;
BEGIN {
- eval {
- require_ok("Wibble");
- };
- $result = $@;
+ $result = require_ok("strict");
}
-plan tests => 1;
-like $result, '/^You tried to run a test without a plan/';
+ok $result, "require_ok ran";
+
+done_testing(2);
#!/usr/bin/perl -w
-# $Id$
# [rt.cpan.org 28345]
#
my $result;
BEGIN {
- eval {
- use_ok("Wibble");
- };
- $result = $@;
+ $result = use_ok("strict");
}
-plan tests => 1;
-like $result, '/^You tried to run a test without a plan/';
+ok( $result, "use_ok() ran" );
+done_testing(2);
+
#!/usr/bin/perl -w
-# $Id$
BEGIN {
if( $ENV{PERL_CORE} ) {
#!/usr/bin/perl
-# $Id$
BEGIN {
if( $ENV{PERL_CORE} ) {
#!/usr/bin/perl -w
-# $Id$
#!perl -w
}
}
-use Test::More tests => 8;
+use Test::More tests => 7;
use Test::Builder;
+use Test::Builder::NoOutput;
my $more_tb = Test::More->builder;
isa_ok $more_tb, 'Test::Builder';
is $more_tb, Test::Builder->new, ' does not interfere with ->new';
{
- my $new_tb = Test::Builder->create;
+ my $new_tb = Test::Builder::NoOutput->create;
isa_ok $new_tb, 'Test::Builder';
isnt $more_tb, $new_tb, 'Test::Builder->create makes a new object';
- $new_tb->output("some_file");
- END { 1 while unlink "some_file" }
-
$new_tb->plan(tests => 1);
- $new_tb->ok(1);
-}
-
-pass("Changing output() of new TB doesn't interfere with singleton");
+ $new_tb->ok(1, "a test");
-ok open FILE, "some_file";
-is join("", <FILE>), <<OUT;
+ is $new_tb->read, <<'OUT';
1..1
-ok 1
+ok 1 - a test
OUT
+}
-close FILE;
+pass("Changing output() of new TB doesn't interfere with singleton");
#!/usr/bin/perl -w
-# $Id$
# Dave Rolsky found a bug where if current_test() is used and no
# tests are run via Test::Builder it will blow up.
--- /dev/null
+#!/usr/bin/perl -w
+
+# Test that current_test() will work without a declared plan.
+
+use Test::Builder;
+
+my $tb = Test::Builder->new;
+$tb->current_test(2);
+print <<'END';
+ok 1
+ok 2
+END
+
+$tb->ok(1, "Third test");
+
+$tb->done_testing(3);
#!/usr/bin/perl -w
-# $Id$
BEGIN {
if( $ENV{PERL_CORE} ) {
# Inline TODO tests will confuse pre 1.20 Test::Harness, so we
# should just avoid the problem and not print it out.
-my $out_fh = $Test->output;
-my $todo_fh = $Test->todo_output;
my $start_test = $Test->current_test + 1;
-require TieOut;
-tie *FH, 'TieOut';
-$Test->output(\*FH);
-$Test->todo_output(\*FH);
+
+my $output = '';
+$Test->output(\$output);
+$Test->todo_output(\$output);
SKIP: {
$Test->skip( 'just testing skip' );
};
for ($start_test..$Test->current_test) { print "ok $_\n" }
-$Test->output($out_fh);
-$Test->todo_output($todo_fh);
+$Test->reset_outputs;
$Test->is_num( scalar $Test->summary(), 4, 'summary' );
push @Expected_Details, { 'ok' => 1,
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+
+use Test::Builder;
+
+my $tb = Test::Builder->new;
+$tb->level(0);
+
+$tb->ok(1, "testing done_testing() with no arguments");
+$tb->ok(1, " another test so we're not testing just one");
+$tb->done_testing();
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+use lib 't/lib';
+
+use Test::Builder;
+use Test::Builder::NoOutput;
+
+my $tb = Test::Builder::NoOutput->create;
+
+{
+ # Normalize test output
+ local $ENV{HARNESS_ACTIVE};
+
+ $tb->ok(1);
+ $tb->ok(1);
+ $tb->ok(1);
+
+#line 24
+ $tb->done_testing(3);
+ $tb->done_testing;
+ $tb->done_testing;
+}
+
+my $Test = Test::Builder->new;
+$Test->plan( tests => 1 );
+$Test->level(0);
+$Test->is_eq($tb->read, <<"END", "multiple done_testing");
+ok 1
+ok 2
+ok 3
+1..3
+not ok 4 - done_testing() was already called at $0 line 24
+# Failed test 'done_testing() was already called at $0 line 24'
+# at $0 line 25.
+not ok 5 - done_testing() was already called at $0 line 24
+# Failed test 'done_testing() was already called at $0 line 24'
+# at $0 line 26.
+END
--- /dev/null
+#!/usr/bin/perl -w
+
+# What if there's a plan and done_testing but they don't match?
+
+use strict;
+use lib 't/lib';
+
+use Test::Builder;
+use Test::Builder::NoOutput;
+
+my $tb = Test::Builder::NoOutput->create;
+
+{
+ # Normalize test output
+ local $ENV{HARNESS_ACTIVE};
+
+ $tb->plan( tests => 3 );
+ $tb->ok(1);
+ $tb->ok(1);
+ $tb->ok(1);
+
+#line 24
+ $tb->done_testing(2);
+}
+
+my $Test = Test::Builder->new;
+$Test->plan( tests => 1 );
+$Test->level(0);
+$Test->is_eq($tb->read, <<"END");
+1..3
+ok 1
+ok 2
+ok 3
+not ok 4 - planned to run 3 but done_testing() expects 2
+# Failed test 'planned to run 3 but done_testing() expects 2'
+# at $0 line 24.
+END
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+
+use Test::Builder;
+
+my $tb = Test::Builder->new;
+$tb->plan( "no_plan" );
+$tb->ok(1);
+$tb->ok(1);
+$tb->done_testing(2);
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+
+use Test::Builder;
+
+my $tb = Test::Builder->new;
+$tb->level(0);
+
+$tb->ok(1, "testing done_testing() with no arguments");
+$tb->ok(1, " another test so we're not testing just one");
+$tb->done_testing(2);
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+
+use Test::Builder;
+
+my $tb = Test::Builder->new;
+$tb->plan( tests => 2 );
+$tb->ok(1);
+$tb->ok(1);
+$tb->done_testing(2);
--- /dev/null
+#!perl -w
+use strict;
+use warnings;
+use IO::Pipe;
+use Test::Builder;
+use Config;
+
+my $b = Test::Builder->new;
+$b->reset;
+
+my $Can_Fork = $Config{d_fork} ||
+ (($^O eq 'MSWin32' || $^O eq 'NetWare') and
+ $Config{useithreads} and
+ $Config{ccflags} =~ /-DPERL_IMPLICIT_SYS/
+ );
+
+if( !$Can_Fork ) {
+ $b->plan('skip_all' => "This system cannot fork");
+}
+else {
+ $b->plan('tests' => 2);
+}
+
+my $pipe = IO::Pipe->new;
+if ( my $pid = fork ) {
+ $pipe->reader;
+ $b->ok((<$pipe> =~ /FROM CHILD: ok 1/), "ok 1 from child");
+ $b->ok((<$pipe> =~ /FROM CHILD: 1\.\.1/), "1..1 from child");
+ waitpid($pid, 0);
+}
+else {
+ $pipe->writer;
+ my $pipe_fd = $pipe->fileno;
+ close STDOUT;
+ open(STDOUT, ">&$pipe_fd");
+ my $b = Test::Builder->new;
+ $b->reset;
+ $b->no_plan;
+ $b->ok(1);
+}
+
+
+=pod
+#actual
+1..2
+ok 1
+1..1
+ok 1
+ok 2
+#expected
+1..2
+ok 1
+ok 2
+=cut
#!/usr/bin/perl -w
-# $Id$
BEGIN {
if( $ENV{PERL_CORE} ) {
#!/usr/bin/perl -w
-# $Id$
BEGIN {
if( $ENV{PERL_CORE} ) {
#!/usr/bin/perl -w
-# $Id$
BEGIN {
if( $ENV{PERL_CORE} ) {
#!/usr/bin/perl -w
-# $Id$
BEGIN {
if( $ENV{PERL_CORE} ) {
#!/usr/bin/perl -w
-# $Id$
use Test::More 'no_diag', tests => 2;
-# $Id$
use Test::Builder;
BEGIN {
-# $Id$
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
--- /dev/null
+#!/usr/bin/perl -w
+
+# Test what happens when no plan is delcared and done_testing() is not seen
+
+use strict;
+use lib 't/lib';
+
+use Test::Builder;
+use Test::Builder::NoOutput;
+
+my $Test = Test::Builder->new;
+$Test->level(0);
+$Test->plan( tests => 1 );
+
+my $tb = Test::Builder::NoOutput->create;
+
+{
+ $tb->level(0);
+ $tb->ok(1, "just a test");
+ $tb->ok(1, " and another");
+ $tb->_ending;
+}
+
+$Test->is_eq($tb->read, <<'END', "proper behavior when no plan is seen");
+ok 1 - just a test
+ok 2 - and another
+# Tests were run but no plan was declared and done_testing() was not seen.
+END
#!/usr/bin/perl -w
-# $Id$
# Testing to make sure Test::Builder doesn't accidentally store objects
# passed in as test arguments.
#!perl -w
-# $Id$
+
+use strict;
BEGIN {
if( $ENV{PERL_CORE} ) {
}
chdir 't';
+use Test::Builder;
-# Can't use Test.pm, that's a 5.005 thing.
-print "1..4\n";
-
-my $test_num = 1;
-# Utility testing functions.
-sub ok ($;$) {
- my($test, $name) = @_;
- my $ok = '';
- $ok .= "not " unless $test;
- $ok .= "ok $test_num";
- $ok .= " - $name" if defined $name;
- $ok .= "\n";
- print $ok;
- $test_num++;
+# The real Test::Builder
+my $Test = Test::Builder->new;
+$Test->plan( tests => 6 );
- return $test;
-}
-use TieOut;
-use Test::Builder;
-my $Test = Test::Builder->new();
+# The one we're going to test.
+my $tb = Test::Builder->create();
-my $result;
my $tmpfile = 'foo.tmp';
-my $out = $Test->output($tmpfile);
END { 1 while unlink($tmpfile) }
-ok( defined $out );
+# Test output to a file
+{
+ my $out = $tb->output($tmpfile);
+ $Test->ok( defined $out );
+
+ print $out "hi!\n";
+ close *$out;
+
+ undef $out;
+ open(IN, $tmpfile) or die $!;
+ chomp(my $line = <IN>);
+ close IN;
+
+ $Test->is_eq($line, 'hi!');
+}
+
+
+# Test output to a filehandle
+{
+ open(FOO, ">>$tmpfile") or die $!;
+ my $out = $tb->output(\*FOO);
+ my $old = select *$out;
+ print "Hello!\n";
+ close *$out;
+ undef $out;
+ select $old;
+ open(IN, $tmpfile) or die $!;
+ my @lines = <IN>;
+ close IN;
+
+ $Test->like($lines[1], qr/Hello!/);
+}
-print $out "hi!\n";
-close *$out;
-undef $out;
-open(IN, $tmpfile) or die $!;
-chomp(my $line = <IN>);
-close IN;
+# Test output to a scalar ref
+{
+ my $scalar = '';
+ my $out = $tb->output(\$scalar);
+
+ print $out "Hey hey hey!\n";
+ $Test->is_eq($scalar, "Hey hey hey!\n");
+}
-ok($line eq 'hi!');
-open(FOO, ">>$tmpfile") or die $!;
-$out = $Test->output(\*FOO);
-$old = select *$out;
-print "Hello!\n";
-close *$out;
-undef $out;
-select $old;
-open(IN, $tmpfile) or die $!;
-my @lines = <IN>;
-close IN;
+# Test we can output to the same scalar ref
+{
+ my $scalar = '';
+ my $out = $tb->output(\$scalar);
+ my $err = $tb->failure_output(\$scalar);
-ok($lines[1] =~ /Hello!/);
+ print $out "To output ";
+ print $err "and beyond!";
+ $Test->is_eq($scalar, "To output and beyond!", "One scalar, two filehandles");
+}
# Ensure stray newline in name escaping works.
-$out = tie *FAKEOUT, 'TieOut';
-$Test->output(\*FAKEOUT);
-$Test->exported_to(__PACKAGE__);
-$Test->no_ending(1);
-$Test->plan(tests => 5);
-
-$Test->ok(1, "ok");
-$Test->ok(1, "ok\n");
-$Test->ok(1, "ok, like\nok");
-$Test->skip("wibble\nmoof");
-$Test->todo_skip("todo\nskip\n");
-
-my $output = $out->read;
-ok( $output eq <<OUTPUT ) || print STDERR $output;
+{
+ my $fakeout = '';
+ my $out = $tb->output(\$fakeout);
+ $tb->exported_to(__PACKAGE__);
+ $tb->no_ending(1);
+ $tb->plan(tests => 5);
+
+ $tb->ok(1, "ok");
+ $tb->ok(1, "ok\n");
+ $tb->ok(1, "ok, like\nok");
+ $tb->skip("wibble\nmoof");
+ $tb->todo_skip("todo\nskip\n");
+
+ $Test->is_eq( $fakeout, <<OUTPUT ) || print STDERR $fakeout;
1..5
ok 1 - ok
ok 2 - ok
# skip
#
OUTPUT
+}
#!/usr/bin/perl -w
-# $Id$
# Test Test::Builder->reset;
use Test::Builder;
-my $tb = Test::Builder->new;
+my $Test = Test::Builder->new;
+my $tb = Test::Builder->create;
+# We'll need this later to know the outputs were reset
my %Original_Output;
$Original_Output{$_} = $tb->$_ for qw(output failure_output todo_output);
+# Alter the state of Test::Builder as much as possible.
+my $output = '';
+$tb->output(\$output);
+$tb->failure_output(\$output);
+$tb->todo_output(\$output);
$tb->plan(tests => 14);
$tb->level(0);
-# Alter the state of Test::Builder as much as possible.
$tb->ok(1, "Running a test to alter TB's state");
-my $tmpfile = 'foo.tmp';
-
-$tb->output($tmpfile);
-$tb->failure_output($tmpfile);
-$tb->todo_output($tmpfile);
-END { 1 while unlink $tmpfile }
-
# This won't print since we just sent output off to oblivion.
$tb->ok(0, "And a failure for fun");
# Now reset it.
$tb->reset;
-my $test_num = 2; # since we already printed 1
-# Utility testing functions.
-sub ok ($;$) {
- my($test, $name) = @_;
- my $ok = '';
- $ok .= "not " unless $test;
- $ok .= "ok $test_num";
- $ok .= " - $name" if defined $name;
- $ok .= "\n";
- print $ok;
- $test_num++;
-
- return $test;
-}
-
-ok( !defined $tb->exported_to, 'exported_to' );
-ok( $tb->expected_tests == 0, 'expected_tests' );
-ok( $tb->level == 1, 'level' );
-ok( $tb->use_numbers == 1, 'use_numbers' );
-ok( $tb->no_header == 0, 'no_header' );
-ok( $tb->no_ending == 0, 'no_ending' );
-ok( fileno $tb->output == fileno $Original_Output{output},
- 'output' );
-ok( fileno $tb->failure_output == fileno $Original_Output{failure_output},
- 'failure_output' );
-ok( fileno $tb->todo_output == fileno $Original_Output{todo_output},
- 'todo_output' );
-ok( $tb->current_test == 0, 'current_test' );
-ok( $tb->summary == 0, 'summary' );
-ok( $tb->details == 0, 'details' );
-
-$tb->no_ending(1);
-$tb->no_header(1);
-$tb->plan(tests => 14);
-$tb->current_test(13);
+$Test->ok( !defined $tb->exported_to, 'exported_to' );
+$Test->is_eq( $tb->expected_tests, 0, 'expected_tests' );
+$Test->is_eq( $tb->level, 1, 'level' );
+$Test->is_eq( $tb->use_numbers, 1, 'use_numbers' );
+$Test->is_eq( $tb->no_header, 0, 'no_header' );
+$Test->is_eq( $tb->no_ending, 0, 'no_ending' );
+$Test->is_eq( $tb->current_test, 0, 'current_test' );
+$Test->is_eq( scalar $tb->summary, 0, 'summary' );
+$Test->is_eq( scalar $tb->details, 0, 'details' );
+$Test->is_eq( fileno $tb->output,
+ fileno $Original_Output{output}, 'output' );
+$Test->is_eq( fileno $tb->failure_output,
+ fileno $Original_Output{failure_output}, 'failure_output' );
+$Test->is_eq( fileno $tb->todo_output,
+ fileno $Original_Output{todo_output}, 'todo_output' );
+
+$tb->current_test(12);
$tb->level(0);
$tb->ok(1, 'final test to make sure output was reset');
+
+$Test->current_test(13);
+$Test->done_testing(13);
#!perl -w
-# $Id$
BEGIN {
if( $ENV{PERL_CORE} ) {
#!perl -w
-# $Id$
BEGIN {
if( $ENV{PERL_CORE} ) {
}
use lib 't/lib';
-use Test::More tests => 52;
+use Test::More tests => 53;
# Make sure we don't mess with $@ or $!. Test at bottom.
my $Err = "this should not be touched";
isa_ok(bless([], "Foo"), "Foo");
isa_ok([], 'ARRAY');
isa_ok(\42, 'SCALAR');
+{
+ local %Bar::;
+ local @Foo::ISA = 'Bar';
+ isa_ok( "Foo", "Bar" );
+}
# can_ok() & isa_ok should call can() & isa() on the given object, not
#!/usr/bin/perl
-# $Id$
use Test::Builder::Tester tests => 9;
use Test::More;
test_test("multiple tests");
test_out("not ok 1 - should fail");
-test_err("# Failed test ($0 at line 29)");
+test_err("# Failed test ($0 at line 28)");
test_err("# got: 'foo'");
test_err("# expected: 'bar'");
is("foo","bar","should fail");
test_out("not ok 1 - name # TODO Something");
-test_err("# Failed (TODO) test ($0 at line 53)");
+test_err("# Failed (TODO) test ($0 at line 52)");
TODO: {
local $TODO = "Something";
fail("name");
#!/usr/bin/perl
-# $Id$
use Test::Builder::Tester tests => 4;
use Test::More;
#!/usr/bin/perl
-# $Id$
use Test::Builder::Tester tests => 1;
use Test::More;
#!/usr/bin/perl
-# $Id$
use Test::More tests => 3;
use Test::Builder::Tester;
-is(line_num(),7,"normal line num");
-is(line_num(-1),7,"line number minus one");
-is(line_num(+2),11,"line number plus two");
+is(line_num(),6,"normal line num");
+is(line_num(-1),6,"line number minus one");
+is(line_num(+2),10,"line number plus two");
#!/usr/bin/perl
-# $Id$
use Test::Builder::Tester tests => 5;
use Test::More;
#!/usr/bin/perl -w
-# $Id$
use Test::More tests => 8;
use Symbol;
#!/usr/bin/perl -w
-# $Id$
use Test::More tests => 18;
use Symbol;
#!/usr/bin/perl -w
-# $Id$
BEGIN {
if( $ENV{PERL_CORE} ) {
}
}
-my $test_num = 1;
-# Utility testing functions.
-sub ok ($;$) {
- my($test, $name) = @_;
- my $ok = '';
- $ok .= "not " unless $test;
- $ok .= "ok $test_num";
- $ok .= " - $name" if defined $name;
- $ok .= "\n";
- print $ok;
- $test_num++;
-
- return $test;
-}
-
-
use Test::Builder;
my $Test = Test::Builder->new;
+$Test->plan( tests => 2 );
+$Test->level(0);
-print "1..2\n";
+my $tb = Test::Builder->create;
-eval { $Test->plan(7); };
-ok( $@ =~ /^plan\(\) doesn't understand 7/, 'bad plan()' ) ||
+eval { $tb->plan(7); };
+$Test->like( $@, qr/^plan\(\) doesn't understand 7/, 'bad plan()' ) ||
print STDERR "# $@";
-eval { $Test->plan(wibble => 7); };
-ok( $@ =~ /^plan\(\) doesn't understand wibble 7/, 'bad plan()' ) ||
+eval { $tb->plan(wibble => 7); };
+$Test->like( $@, qr/^plan\(\) doesn't understand wibble 7/, 'bad plan()' ) ||
print STDERR "# $@";
-
#!/usr/bin/perl -w
-# $Id$
BEGIN {
if( $ENV{PERL_CORE} ) {
use Test::Builder;
use Test::More;
-use TieOut;
-my $output = tie *FAKEOUT, 'TieOut';
+my $output;
my $TB = Test::More->builder;
-$TB->output(\*FAKEOUT);
+$TB->output(\$output);
my $Test = Test::Builder->create;
$Test->level(0);
-if( $] >= 5.005 ) {
- $Test->plan(tests => 3);
-}
-else {
- $Test->plan(skip_all =>
- 'CORE::GLOBAL::exit, introduced in 5.005, is needed for testing');
-}
-
+$Test->plan(tests => 3);
plan tests => 4;
BAIL_OUT("ROCKS FALL! EVERYONE DIES!");
-$Test->is_eq( $output->read, <<'OUT' );
+$Test->is_eq( $output, <<'OUT' );
1..4
Bail out! ROCKS FALL! EVERYONE DIES!
OUT
#!/usr/bin/perl
-# $Id$
BEGIN {
if( $ENV{PERL_CORE} ) {
#!/usr/bin/perl -w
-# $Id$
# Test is_deeply and friends with circular data structures [rt.cpan.org 7289]
#!/usr/bin/perl -w
-# $Id$
BEGIN {
if( $ENV{PERL_CORE} ) {
#!perl -w
-# $Id$
BEGIN {
if( $ENV{PERL_CORE} ) {
use strict;
+use Test::Builder::NoOutput;
use Test::More tests => 7;
-my $test = Test::Builder->create;
-
-# now make a filehandle where we can send data
-use TieOut;
-my $output = tie *FAKEOUT, 'TieOut';
-
+my $test = Test::Builder::NoOutput->create;
# Test diag() goes to todo_output() in a todo test.
{
$test->todo_start();
- $test->todo_output(\*FAKEOUT);
$test->diag("a single line");
- is( $output->read, <<'DIAG', 'diag() with todo_output set' );
+ is( $test->read('todo'), <<'DIAG', 'diag() with todo_output set' );
# a single line
DIAG
my $ret = $test->diag("multiple\n", "lines");
- is( $output->read, <<'DIAG', ' multi line' );
+ is( $test->read('todo'), <<'DIAG', ' multi line' );
# multiple
# lines
DIAG
$test->todo_end();
}
-$test->reset_outputs();
-
# Test diagnostic formatting
-$test->failure_output(\*FAKEOUT);
{
$test->diag("# foo");
- is( $output->read, "# # foo\n", "diag() adds # even if there's one already" );
+ is( $test->read('err'), "# # foo\n", "diag() adds # even if there's one already" );
$test->diag("foo\n\nbar");
- is( $output->read, <<'DIAG', " blank lines get escaped" );
+ is( $test->read('err'), <<'DIAG', " blank lines get escaped" );
# foo
#
# bar
DIAG
-
$test->diag("foo\n\nbar\n\n");
- is( $output->read, <<'DIAG', " even at the end" );
+ is( $test->read('err'), <<'DIAG', " even at the end" );
# foo
#
# bar
}
-# [rt.cpan.org 8392]
+# [rt.cpan.org 8392] diag(@list) emulates print
{
$test->diag(qw(one two));
-}
-is( $output->read, <<'DIAG' );
+
+ is( $test->read('err'), <<'DIAG' );
# onetwo
DIAG
+}
#!perl -w
-# $Id$
BEGIN {
if( $ENV{PERL_CORE} ) {
#!/usr/bin/perl -w
-# $Id$
BEGIN {
if( $ENV{PERL_CORE} ) {
#!perl -w
-# $Id$
BEGIN {
if( $ENV{PERL_CORE} ) {
#!/usr/bin/perl -w
-# $Id$
# Can't use Test.pm, that's a 5.005 thing.
package My::Test;
}
}
-unless( eval { require File::Spec } ) {
- print "1..0 # Skip Need File::Spec to run this test\n";
- exit 0;
-}
-
-if( $^O eq 'VMS' && $] <= 5.00503 ) {
- print "1..0 # Skip test will hang on older VMS perls\n";
- exit 0;
-}
-
-if( $^O eq 'MacOS' ) {
- print "1..0 # Skip exit status broken on Mac OS\n";
- exit 0;
-}
-
require Test::Builder;
my $TB = Test::Builder->create();
$TB->level(0);
package main;
-my $IsVMS = $^O eq 'VMS';
+use Cwd;
+use File::Spec;
-print "# Ahh! I see you're running VMS.\n" if $IsVMS;
+my $Orig_Dir = cwd;
-my %Tests = (
- # Everyone Else VMS
- 'success.plx' => [0, 0],
- 'one_fail.plx' => [1, 4],
- 'two_fail.plx' => [2, 4],
- 'five_fail.plx' => [5, 4],
- 'extras.plx' => [2, 4],
- 'too_few.plx' => [255, 4],
- 'too_few_fail.plx' => [2, 4],
- 'death.plx' => [255, 4],
- 'last_minute_death.plx' => [255, 4],
- 'pre_plan_death.plx' => ['not zero', 'not zero'],
- 'death_in_eval.plx' => [0, 0],
- 'require.plx' => [0, 0],
- 'death_with_handler.plx' => [255, 4],
- 'exit.plx' => [1, 4],
- );
+my $Perl = File::Spec->rel2abs($^X);
+if( $^O eq 'VMS' ) {
+ # VMS can't use its own $^X in a system call until almost 5.8
+ $Perl = "MCR $^X" if $] < 5.007003;
+
+ # Quiet noisy 'SYS$ABORT'
+ $Perl .= q{ -"Mvmsish=hushed"};
+}
-$TB->plan( tests => scalar keys(%Tests) );
eval { require POSIX; &POSIX::WEXITSTATUS(0) };
if( $@ ) {
*exitstatus = sub { POSIX::WEXITSTATUS($_[0]) }
}
-my $Perl = File::Spec->rel2abs($^X);
-chdir 't';
-my $lib = File::Spec->catdir(qw(lib Test Simple sample_tests));
-while( my($test_name, $exit_codes) = each %Tests ) {
- my($exit_code) = $exit_codes->[$IsVMS ? 1 : 0];
+# Some OS' will alter the exit code to their own native sense...
+# sometimes. Rather than deal with the exception we'll just
+# build up the mapping.
+print "# Building up a map of exit codes. May take a while.\n";
+my %Exit_Map;
+
+open my $fh, ">", "exit_map_test" or die $!;
+print $fh <<'DONE';
+if ($^O eq 'VMS') {
+ require vmsish;
+ import vmsish qw(hushed);
+}
+my $exit = shift;
+print "exit $exit\n";
+END { $? = $exit };
+DONE
+
+close $fh;
+END { 1 while unlink "exit_map_test" }
+
+for my $exit (0..255) {
+ # This correctly emulates Test::Builder's behavior.
+ my $out = qx[$Perl exit_map_test $exit];
+ $TB->like( $out, qr/^exit $exit\n/, "exit map test for $exit" );
+ $Exit_Map{$exit} = exitstatus($?);
+}
+print "# Done.\n";
- if( $^O eq 'VMS' ) {
- # VMS can't use its own $^X in a system call until almost 5.8
- $Perl = "MCR $^X" if $] < 5.007003;
- # Quiet noisy 'SYS$ABORT'. 'hushed' only exists in 5.6 and up,
- # but it doesn't do any harm on eariler perls.
- $Perl .= q{ -"Mvmsish=hushed"};
- }
+my %Tests = (
+ # File Exit Code
+ 'success.plx' => 0,
+ 'one_fail.plx' => 1,
+ 'two_fail.plx' => 2,
+ 'five_fail.plx' => 5,
+ 'extras.plx' => 2,
+ 'too_few.plx' => 255,
+ 'too_few_fail.plx' => 2,
+ 'death.plx' => 255,
+ 'last_minute_death.plx' => 255,
+ 'pre_plan_death.plx' => 'not zero',
+ 'death_in_eval.plx' => 0,
+ 'require.plx' => 0,
+ 'death_with_handler.plx' => 255,
+ 'exit.plx' => 1,
+ );
+chdir 't';
+my $lib = File::Spec->catdir(qw(lib Test Simple sample_tests));
+while( my($test_name, $exit_code) = each %Tests ) {
my $file = File::Spec->catfile($lib, $test_name);
my $wait_stat = system(qq{$Perl -"I../blib/lib" -"I../lib" -"I../t/lib" $file});
my $actual_exit = exitstatus($wait_stat);
if( $exit_code eq 'not zero' ) {
- $TB->isnt_num( $actual_exit, 0,
+ $TB->isnt_num( $actual_exit, $Exit_Map{0},
"$test_name exited with $actual_exit ".
- "(expected $exit_code)");
+ "(expected non-zero)");
}
else {
- $TB->is_num( $actual_exit, $exit_code,
+ $TB->is_num( $actual_exit, $Exit_Map{$exit_code},
"$test_name exited with $actual_exit ".
- "(expected $exit_code)");
+ "(expected $Exit_Map{$exit_code})");
}
}
+
+$TB->done_testing( scalar keys(%Tests) + 256 );
+
+# So any END block file cleanup works.
+chdir $Orig_Dir;
#!/usr/bin/perl -w
-# $Id$
BEGIN {
if( $ENV{PERL_CORE} ) {
#!perl -w
-# $Id$
BEGIN {
if( $ENV{PERL_CORE} ) {
#!/usr/bin/perl -w
-# $Id$
BEGIN {
if( $ENV{PERL_CORE} ) {
#!/usr/bin/perl -w
-# $Id$
BEGIN {
if( $ENV{PERL_CORE} ) {
}
{
- # line 60
+ # line 59
like("foo", "not a regex");
$TB->is_eq($out->read, <<OUT);
not ok 2
OUT
$TB->is_eq($err->read, <<OUT);
-# Failed test at $0 line 60.
+# Failed test at $0 line 59.
# 'not a regex' doesn't look much like a regex to me.
OUT
#!perl -w
-# $Id$
BEGIN {
if( $ENV{PERL_CORE} ) {
# Test::Builder's own and the ending diagnostics don't come out right.
require Test::Builder;
my $TB = Test::Builder->create;
-$TB->plan(tests => 23);
+$TB->plan(tests => 78);
sub like ($$;$) {
$TB->like(@_);
$TB->is_eq(@_);
}
-sub main::err_ok ($) {
- my($expect) = @_;
- my $got = $err->read;
-
- return $TB->is_eq( $got, $expect );
+sub main::out_ok ($$) {
+ $TB->is_eq( $out->read, shift );
+ $TB->is_eq( $err->read, shift );
}
-sub main::err_like ($) {
- my($expect) = @_;
- my $got = $err->read;
+sub main::out_like ($$) {
+ my($output, $failure) = @_;
- return $TB->like( $got, qr/$expect/ );
+ $TB->like( $out->read, qr/$output/ );
+ $TB->like( $err->read, qr/$failure/ );
}
package main;
require Test::More;
-my $Total = 36;
+our $TODO;
+my $Total = 37;
Test::More->import(tests => $Total);
+$out->read; # clear the plan from $out
# This should all work in the presence of a __DIE__ handler.
local $SIG{__DIE__} = sub { $TB->ok(0, "DIE handler called: ".join "", @_); };
my $Filename = quotemeta $0;
-# Preserve the line numbers.
+
#line 38
ok( 0, 'failing' );
-err_ok( <<ERR );
+out_ok( <<OUT, <<ERR );
+not ok - failing
+OUT
# Failed test 'failing'
# at $0 line 38.
ERR
+
#line 40
is( "foo", "bar", 'foo is bar?');
-is( undef, '', 'undef is empty string?');
-is( undef, 0, 'undef is 0?');
-is( '', 0, 'empty string is 0?' );
-err_ok( <<ERR );
+out_ok( <<OUT, <<ERR );
+not ok - foo is bar?
+OUT
# Failed test 'foo is bar?'
# at $0 line 40.
# got: 'foo'
# expected: 'bar'
+ERR
+
+#line 89
+is( undef, '', 'undef is empty string?');
+out_ok( <<OUT, <<ERR );
+not ok - undef is empty string?
+OUT
# Failed test 'undef is empty string?'
-# at $0 line 41.
+# at $0 line 89.
# got: undef
# expected: ''
+ERR
+
+#line 99
+is( undef, 0, 'undef is 0?');
+out_ok( <<OUT, <<ERR );
+not ok - undef is 0?
+OUT
# Failed test 'undef is 0?'
-# at $0 line 42.
+# at $0 line 99.
# got: undef
# expected: '0'
+ERR
+
+#line 110
+is( '', 0, 'empty string is 0?' );
+out_ok( <<OUT, <<ERR );
+not ok - empty string is 0?
+OUT
# Failed test 'empty string is 0?'
-# at $0 line 43.
+# at $0 line 110.
# got: ''
# expected: '0'
ERR
-#line 45
+#line 121
isnt("foo", "foo", 'foo isnt foo?' );
-isn't("foo", "foo",'foo isn\'t foo?' );
-isnt(undef, undef, 'undef isnt undef?');
-err_ok( <<ERR );
+out_ok( <<OUT, <<ERR );
+not ok - foo isnt foo?
+OUT
# Failed test 'foo isnt foo?'
-# at $0 line 45.
+# at $0 line 121.
# got: 'foo'
# expected: anything else
+ERR
+
+#line 132
+isn't("foo", "foo",'foo isn\'t foo?' );
+out_ok( <<OUT, <<ERR );
+not ok - foo isn't foo?
+OUT
# Failed test 'foo isn\'t foo?'
-# at $0 line 46.
+# at $0 line 132.
# got: 'foo'
# expected: anything else
+ERR
+
+#line 143
+isnt(undef, undef, 'undef isnt undef?');
+out_ok( <<OUT, <<ERR );
+not ok - undef isnt undef?
+OUT
# Failed test 'undef isnt undef?'
-# at $0 line 47.
+# at $0 line 143.
# got: undef
# expected: anything else
ERR
-#line 48
+#line 154
like( "foo", '/that/', 'is foo like that' );
-unlike( "foo", '/foo/', 'is foo unlike foo' );
-err_ok( <<ERR );
+out_ok( <<OUT, <<ERR );
+not ok - is foo like that
+OUT
# Failed test 'is foo like that'
-# at $0 line 48.
+# at $0 line 154.
# 'foo'
# doesn't match '/that/'
+ERR
+
+#line 165
+unlike( "foo", '/foo/', 'is foo unlike foo' );
+out_ok( <<OUT, <<ERR );
+not ok - is foo unlike foo
+OUT
# Failed test 'is foo unlike foo'
-# at $0 line 49.
+# at $0 line 165.
# 'foo'
# matches '/foo/'
ERR
# Nick Clark found this was a bug. Fixed in 0.40.
-# line 60
+# line 177
like( "bug", '/(%)/', 'regex with % in it' );
-err_ok( <<ERR );
+out_ok( <<OUT, <<ERR );
+not ok - regex with % in it
+OUT
# Failed test 'regex with % in it'
-# at $0 line 60.
+# at $0 line 177.
# 'bug'
# doesn't match '/(%)/'
ERR
-#line 67
+#line 188
fail('fail()');
-err_ok( <<ERR );
+out_ok( <<OUT, <<ERR );
+not ok - fail()
+OUT
# Failed test 'fail()'
-# at $0 line 67.
+# at $0 line 188.
ERR
-#line 52
+#line 197
can_ok('Mooble::Hooble::Yooble', qw(this that));
-can_ok('Mooble::Hooble::Yooble', ());
-can_ok(undef, undef);
-can_ok([], "foo");
-err_ok( <<ERR );
+out_ok( <<OUT, <<ERR );
+not ok - Mooble::Hooble::Yooble->can(...)
+OUT
# Failed test 'Mooble::Hooble::Yooble->can(...)'
-# at $0 line 52.
+# at $0 line 197.
# Mooble::Hooble::Yooble->can('this') failed
# Mooble::Hooble::Yooble->can('that') failed
+ERR
+
+#line 208
+can_ok('Mooble::Hooble::Yooble', ());
+out_ok( <<OUT, <<ERR );
+not ok - Mooble::Hooble::Yooble->can(...)
+OUT
# Failed test 'Mooble::Hooble::Yooble->can(...)'
-# at $0 line 53.
+# at $0 line 208.
# can_ok() called with no methods
+ERR
+
+#line 218
+can_ok(undef, undef);
+out_ok( <<OUT, <<ERR );
+not ok - ->can(...)
+OUT
# Failed test '->can(...)'
-# at $0 line 54.
+# at $0 line 218.
# can_ok() called with empty class or reference
+ERR
+
+#line 228
+can_ok([], "foo");
+out_ok( <<OUT, <<ERR );
+not ok - ARRAY->can('foo')
+OUT
# Failed test 'ARRAY->can('foo')'
-# at $0 line 55.
+# at $0 line 228.
# ARRAY->can('foo') failed
ERR
-#line 55
+#line 238
isa_ok(bless([], "Foo"), "Wibble");
-isa_ok(42, "Wibble", "My Wibble");
-isa_ok(undef, "Wibble", "Another Wibble");
-isa_ok([], "HASH");
-err_ok( <<ERR );
+out_ok( <<OUT, <<ERR );
+not ok - The object isa Wibble
+OUT
# Failed test 'The object isa Wibble'
-# at $0 line 55.
+# at $0 line 238.
# The object isn't a 'Wibble' it's a 'Foo'
+ERR
+
+#line 248
+isa_ok(42, "Wibble", "My Wibble");
+out_ok( <<OUT, <<ERR );
+not ok - My Wibble isa Wibble
+OUT
# Failed test 'My Wibble isa Wibble'
-# at $0 line 56.
-# My Wibble isn't a reference
+# at $0 line 248.
+# My Wibble isn't a class or reference
+ERR
+
+#line 258
+isa_ok(undef, "Wibble", "Another Wibble");
+out_ok( <<OUT, <<ERR );
+not ok - Another Wibble isa Wibble
+OUT
# Failed test 'Another Wibble isa Wibble'
-# at $0 line 57.
+# at $0 line 258.
# Another Wibble isn't defined
-# Failed test 'The object isa HASH'
-# at $0 line 58.
-# The object isn't a 'HASH' it's a 'ARRAY'
ERR
+#line 268
+isa_ok([], "HASH");
+out_ok( <<OUT, <<ERR );
+not ok - The reference isa HASH
+OUT
+# Failed test 'The reference isa HASH'
+# at $0 line 268.
+# The reference isn't a 'HASH' it's a 'ARRAY'
+ERR
-#line 188
+#line 278
new_ok(undef);
-err_like( <<ERR );
+out_like( <<OUT, <<ERR );
+not ok - new\\(\\) died
+OUT
# Failed test 'new\\(\\) died'
-# at $Filename line 188.
+# at $Filename line 278.
# Error was: Can't call method "new" on an undefined value at .*
ERR
-#line 211
+#line 288
new_ok( "Does::Not::Exist" );
-err_like( <<ERR );
+out_like( <<OUT, <<ERR );
+not ok - new\\(\\) died
+OUT
# Failed test 'new\\(\\) died'
-# at $Filename line 211.
+# at $Filename line 288.
# Error was: Can't locate object method "new" via package "Does::Not::Exist" .*
ERR
+
{ package Foo; sub new { } }
{ package Bar; sub new { {} } }
{ package Baz; sub new { bless {}, "Wibble" } }
-#line 219
+#line 303
new_ok( "Foo" );
-err_ok( <<ERR );
+out_ok( <<OUT, <<ERR );
+not ok - The object isa Foo
+OUT
# Failed test 'The object isa Foo'
-# at $0 line 219.
+# at $0 line 303.
# The object isn't defined
ERR
-# line 231
+# line 313
new_ok( "Bar" );
-err_ok( <<ERR );
+out_ok( <<OUT, <<ERR );
+not ok - The object isa Bar
+OUT
# Failed test 'The object isa Bar'
-# at $0 line 231.
+# at $0 line 313.
# The object isn't a 'Bar' it's a 'HASH'
ERR
-#line 239
+#line 323
new_ok( "Baz" );
-err_ok( <<ERR );
+out_ok( <<OUT, <<ERR );
+not ok - The object isa Baz
+OUT
# Failed test 'The object isa Baz'
-# at $0 line 239.
+# at $0 line 323.
# The object isn't a 'Baz' it's a 'Wibble'
ERR
-#line 247
+#line 333
new_ok( "Baz", [], "no args" );
-err_ok( <<ERR );
+out_ok( <<OUT, <<ERR );
+not ok - no args isa Baz
+OUT
# Failed test 'no args isa Baz'
-# at $0 line 247.
+# at $0 line 333.
# no args isn't a 'Baz' it's a 'Wibble'
ERR
-
-#line 68
+#line 343
cmp_ok( 'foo', 'eq', 'bar', 'cmp_ok eq' );
-cmp_ok( 42.1, '==', 23, , ' ==' );
-cmp_ok( 42, '!=', 42 , ' !=' );
-cmp_ok( 1, '&&', 0 , ' &&' );
-err_ok( <<ERR );
+out_ok( <<OUT, <<ERR );
+not ok - cmp_ok eq
+OUT
# Failed test 'cmp_ok eq'
-# at $0 line 68.
+# at $0 line 343.
# got: 'foo'
# expected: 'bar'
+ERR
+
+#line 354
+cmp_ok( 42.1, '==', 23, , ' ==' );
+out_ok( <<OUT, <<ERR );
+not ok - ==
+OUT
# Failed test ' =='
-# at $0 line 69.
+# at $0 line 354.
# got: 42.1
# expected: 23
+ERR
+
+#line 365
+cmp_ok( 42, '!=', 42 , ' !=' );
+out_ok( <<OUT, <<ERR );
+not ok - !=
+OUT
# Failed test ' !='
-# at $0 line 70.
+# at $0 line 365.
# got: 42
# expected: anything else
+ERR
+
+#line 376
+cmp_ok( 1, '&&', 0 , ' &&' );
+out_ok( <<OUT, <<ERR );
+not ok - &&
+OUT
# Failed test ' &&'
-# at $0 line 71.
+# at $0 line 376.
# '1'
# &&
# '0'
ERR
-
-# line 196
+# line 388
cmp_ok( 42, 'eq', "foo", ' eq with numbers' );
-err_ok( <<ERR );
+out_ok( <<OUT, <<ERR );
+not ok - eq with numbers
+OUT
# Failed test ' eq with numbers'
-# at $0 line 196.
+# at $0 line 388.
# got: '42'
# expected: 'foo'
ERR
-
{
- my $warnings;
+ my $warnings = '';
local $SIG{__WARN__} = sub { $warnings .= join '', @_ };
-# line 211
+# line 404
cmp_ok( 42, '==', "foo", ' == with strings' );
- err_ok( <<ERR );
+ out_ok( <<OUT, <<ERR );
+not ok - == with strings
+OUT
# Failed test ' == with strings'
-# at $0 line 211.
+# at $0 line 404.
# got: 42
# expected: foo
ERR
- My::Test::like $warnings,
- qr/^Argument "foo" isn't numeric in .* at cmp_ok \[from $Filename line 211\] line 1\.\n$/;
+ My::Test::like(
+ $warnings,
+ qr/^Argument "foo" isn't numeric in .* at cmp_ok \[from $Filename line 404\] line 1\.\n$/
+ );
+ $warnings = '';
+}
+
+{
+ my $warnings = '';
+ local $SIG{__WARN__} = sub { $warnings .= join '', @_ };
+
+#line 426
+ cmp_ok( undef, "ne", "", "undef ne empty string" );
+
+ $TB->is_eq( $out->read, <<OUT );
+not ok - undef ne empty string
+OUT
+
+ TODO: {
+ local $::TODO = 'cmp_ok() gives the wrong "expected" for undef';
+
+ $TB->is_eq( $err->read, <<ERR );
+# Failed test 'undef ne empty string'
+# at $0 line 426.
+# got: undef
+# expected: ''
+ERR
+ }
+
+ My::Test::like(
+ $warnings,
+ qr/^Use of uninitialized value.* in string ne at cmp_ok \[from $Filename line 426\] line 1\.\n\z/
+ );
}
-e "wibblehibble";
my $Errno_Number = $!+0;
my $Errno_String = $!.'';
-#line 80
+#line 425
cmp_ok( $!, 'eq', '', ' eq with stringified errno' );
-cmp_ok( $!, '==', -1, ' eq with numerified errno' );
-err_ok( <<ERR );
+out_ok( <<OUT, <<ERR );
+not ok - eq with stringified errno
+OUT
# Failed test ' eq with stringified errno'
-# at $0 line 80.
+# at $0 line 425.
# got: '$Errno_String'
# expected: ''
+ERR
+
+#line 436
+cmp_ok( $!, '==', -1, ' eq with numerified errno' );
+out_ok( <<OUT, <<ERR );
+not ok - eq with numerified errno
+OUT
# Failed test ' eq with numerified errno'
-# at $0 line 81.
+# at $0 line 436.
# got: $Errno_Number
# expected: -1
ERR
-#line 84
+#line 447
use_ok('Hooble::mooble::yooble');
-
my $more_err_re = <<ERR;
# Failed test 'use Hooble::mooble::yooble;'
-# at $Filename line 84\\.
+# at $Filename line 447\\.
# Tried to use 'Hooble::mooble::yooble'.
# Error: Can't locate Hooble.* in \\\@INC .*
ERR
+out_like(
+ qr/^\Qnot ok - use Hooble::mooble::yooble;\E\n\z/,
+ qr/^$more_err_re/
+);
-My::Test::like($err->read, "/^$more_err_re/");
-
-
-#line 85
+#line 460
require_ok('ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble');
$more_err_re = <<ERR;
# Failed test 'require ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble;'
-# at $Filename line 85\\.
+# at $Filename line 460\\.
# Tried to require 'ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble'.
# Error: Can't locate ALL.* in \\\@INC .*
ERR
-
-My::Test::like($err->read, "/^$more_err_re/");
+out_like(
+ qr/^\Qnot ok - require ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble;\E\n\z/,
+ qr/^$more_err_re/
+);
-#line 88
END {
- $TB->is_eq($$out, <<OUT, 'failing output');
-1..$Total
-not ok - failing
-not ok - foo is bar?
-not ok - undef is empty string?
-not ok - undef is 0?
-not ok - empty string is 0?
-not ok - foo isnt foo?
-not ok - foo isn't foo?
-not ok - undef isnt undef?
-not ok - is foo like that
-not ok - is foo unlike foo
-not ok - regex with % in it
-not ok - fail()
-not ok - Mooble::Hooble::Yooble->can(...)
-not ok - Mooble::Hooble::Yooble->can(...)
-not ok - ->can(...)
-not ok - ARRAY->can('foo')
-not ok - The object isa Wibble
-not ok - My Wibble isa Wibble
-not ok - Another Wibble isa Wibble
-not ok - The object isa HASH
-not ok - new() died
-not ok - new() died
-not ok - The object isa Foo
-not ok - The object isa Bar
-not ok - The object isa Baz
-not ok - no args isa Baz
-not ok - cmp_ok eq
-not ok - ==
-not ok - !=
-not ok - &&
-not ok - eq with numbers
-not ok - == with strings
-not ok - eq with stringified errno
-not ok - eq with numerified errno
-not ok - use Hooble::mooble::yooble;
-not ok - require ALL::YOUR::BASE::ARE::BELONG::TO::US::wibble;
+ out_like( <<OUT, <<ERR );
OUT
-
-err_ok( <<ERR );
# Looks like you failed $Total tests of $Total.
ERR
#!perl -w
-# $Id$
+
+# Simple test of what failure output looks like
BEGIN {
if( $ENV{PERL_CORE} ) {
use strict;
-require Test::Simple::Catch;
-my($out, $err) = Test::Simple::Catch::caught();
+# Normalize the output whether we're running under Test::Harness or not.
local $ENV{HARNESS_ACTIVE} = 0;
+use Test::Builder;
+use Test::Builder::NoOutput;
-# Can't use Test.pm, that's a 5.005 thing.
-package My::Test;
-
-print "1..2\n";
-
-my $test_num = 1;
-# Utility testing functions.
-sub ok ($;$) {
- my($test, $name) = @_;
- my $ok = '';
- $ok .= "not " unless $test;
- $ok .= "ok $test_num";
- $ok .= " - $name" if defined $name;
- $ok .= "\n";
- print $ok;
- $test_num++;
-}
-
-
-package main;
-
-require Test::Simple;
-Test::Simple->import(tests => 5);
+my $Test = Test::Builder->new;
-#line 35
-ok( 1, 'passing' );
-ok( 2, 'passing still' );
-ok( 3, 'still passing' );
-ok( 0, 'oh no!' );
-ok( 0, 'damnit' );
+# Set up a builder to record some failing tests.
+{
+ my $tb = Test::Builder::NoOutput->create;
+ $tb->plan( tests => 5 );
+#line 28
+ $tb->ok( 1, 'passing' );
+ $tb->ok( 2, 'passing still' );
+ $tb->ok( 3, 'still passing' );
+ $tb->ok( 0, 'oh no!' );
+ $tb->ok( 0, 'damnit' );
+ $tb->_ending;
-END {
- My::Test::ok($$out eq <<OUT);
+ $Test->is_eq($tb->read('out'), <<OUT);
1..5
ok 1 - passing
ok 2 - passing still
not ok 5 - damnit
OUT
- My::Test::ok($$err eq <<ERR);
+ $Test->is_eq($tb->read('err'), <<ERR);
# Failed test 'oh no!'
-# at $0 line 38.
+# at $0 line 31.
# Failed test 'damnit'
-# at $0 line 39.
+# at $0 line 32.
# Looks like you failed 2 tests of 5.
ERR
- # Prevent Test::Simple from exiting with non zero
- exit 0;
+ $Test->done_testing(2);
}
#!/usr/bin/perl -w
-# $Id$
BEGIN {
if( $ENV{PERL_CORE} ) {
use strict;
-require Test::Simple::Catch;
-my($out, $err) = Test::Simple::Catch::caught();
+# Normalize the output whether we're running under Test::Harness or not.
local $ENV{HARNESS_ACTIVE} = 0;
+use Test::Builder;
+use Test::Builder::NoOutput;
-# Can't use Test.pm, that's a 5.005 thing.
-package My::Test;
+my $Test = Test::Builder->new;
-print "1..2\n";
+{
+ my $tb = Test::Builder::NoOutput->create;
-my $test_num = 1;
-# Utility testing functions.
-sub ok ($;$) {
- my($test, $name) = @_;
- my $ok = '';
- $ok .= "not " unless $test;
- $ok .= "ok $test_num";
- $ok .= " - $name" if defined $name;
- $ok .= "\n";
- print $ok;
- $test_num++;
+ $tb->plan( tests => 1 );
- return $test ? 1 : 0;
-}
-
-
-package main;
-
-require Test::Simple;
-Test::Simple->import(tests => 1);
-
-#line 45
-ok(0);
+#line 28
+ $tb->ok(0);
+ $tb->_ending;
-END {
- My::Test::ok($$out eq <<OUT);
+ $Test->is_eq($tb->read('out'), <<OUT);
1..1
not ok 1
OUT
- My::Test::ok($$err eq <<ERR) || print $$err;
-# Failed test at $0 line 45.
+ $Test->is_eq($tb->read('err'), <<ERR);
+# Failed test at $0 line 28.
# Looks like you failed 1 test of 1.
ERR
- # Prevent Test::Simple from existing with non-zero
- exit 0;
+ $Test->done_testing(2);
}
#!perl -w
-# $Id$
BEGIN {
if( $ENV{PERL_CORE} ) {
#!/usr/bin/perl -w
-# $Id$
BEGIN {
if( $ENV{PERL_CORE} ) {
#!perl -w
-# $Id$
BEGIN {
if( $ENV{PERL_CORE} ) {
-# $Id$
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
#!/usr/bin/perl -w
-# $Id$
# test for rt.cpan.org 20768
#
#!/usr/bin/perl -w
-# $Id$
BEGIN {
if( $ENV{PERL_CORE} ) {
#!/usr/bin/perl -w
-# $Id$
# Test to see if is_deeply() plays well with threads.
package Dummy;
-# $Id$
-$VERSION = '0.01';
+use strict;
+our $VERSION = '0.01';
1;
-package Overloaded;
-# $Id$
+package Overloaded; ##no critic (Modules::RequireFilenameMatchesPackage)
+
+use strict;
sub new {
my $class = shift;
}
package Overloaded::Compare;
-use vars qw(@ISA);
-@ISA = qw(Overloaded);
+
+use strict;
+our @ISA = qw(Overloaded);
# Sometimes objects have only comparison ops overloaded and nothing else.
# For example, DateTime objects.
q{==} => sub { $_[0]->{num} == $_[1] };
package Overloaded::Ify;
-use vars qw(@ISA);
-@ISA = qw(Overloaded);
+
+use strict;
+our @ISA = qw(Overloaded);
use overload
q{""} => sub { $_[0]->{string} },
package NoExporter;
-# $Id$
-$VERSION = 1.02;
+use strict;
+our $VERSION = 1.02;
sub import {
shift;
package SigDie;
-use vars qw($DIE);
+use strict;
+
+our $DIE;
$SIG{__DIE__} = sub { $DIE = $@ };
1;
-# $Id$
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
#!/usr/bin/perl -w
-# $Id$
BEGIN {
if( $ENV{PERL_CORE} ) {
}
}
-use Test::More tests => 9;
+use Test::More tests => 7;
my $tb = Test::Builder->create;
-$tb->level(0);
#line 20
ok !eval { $tb->plan(tests => undef) };
ok !eval { $tb->plan(tests => 0) };
is($@, "You said to run 0 tests at $0 line 24.\n");
-#line 28
-ok !eval { $tb->ok(1) };
-is( $@, "You tried to run a test without a plan at $0 line 28.\n");
-
{
my $warning = '';
local $SIG{__WARN__} = sub { $warning .= join '', @_ };
-#line 36
+#line 31
ok $tb->plan(no_plan => 1);
- is( $warning, "no_plan takes no arguments at $0 line 36.\n" );
+ is( $warning, "no_plan takes no arguments at $0 line 31.\n" );
is $tb->has_plan, 'no_plan';
}
#!perl -w
-# $Id$
BEGIN {
if( $ENV{PERL_CORE} ) {
#!/usr/bin/perl -w
-# $Id$
BEGIN {
if( $ENV{PERL_CORE} ) {
use strict;
use warnings;
-use TieOut;
+use Test::Builder::NoOutput;
use Test::More tests => 2;
{
- my $test = Test::More->builder;
+ my $tb = Test::Builder::NoOutput->create;
- my $output = tie *FAKEOUT, "TieOut";
- my $fail_output = tie *FAKEERR, "TieOut";
- $test->output (*FAKEOUT);
- $test->failure_output(*FAKEERR);
+ $tb->note("foo");
- note("foo");
+ $tb->reset_outputs;
- $test->reset_outputs;
-
- is $output->read, "# foo\n";
- is $fail_output->read, '';
+ is $tb->read('out'), "# foo\n";
+ is $tb->read('err'), '';
}
#!/usr/bin/perl -w
-# $Id$
BEGIN {
if( $ENV{PERL_CORE} ) {
}
use strict;
-use Test::More tests => 15;
+use Test::More tests => 19;
package Overloaded;
use overload
- q{eq} => sub { $_[0]->{string} },
- q{==} => sub { $_[0]->{num} },
- q{""} => sub { $_[0]->{stringfy}++; $_[0]->{string} },
+ q{eq} => sub { $_[0]->{string} eq $_[1] },
+ q{==} => sub { $_[0]->{num} == $_[1] },
+ q{""} => sub { $_[0]->{stringify}++; $_[0]->{string} },
q{0+} => sub { $_[0]->{numify}++; $_[0]->{num} }
;
my $obj = Overloaded->new('foo', 42);
isa_ok $obj, 'Overloaded';
-is $obj, 'foo', 'is() with string overloading';
-cmp_ok $obj, 'eq', 'foo', 'cmp_ok() ...';
-is $obj->{stringify}, 0, 'cmp_ok() eq does not stringify';
-cmp_ok $obj, '==', 42, 'cmp_ok() with number overloading';
-is $obj->{numify}, 0, 'cmp_ok() == does not numify';
+cmp_ok $obj, 'eq', 'foo', 'cmp_ok() eq';
+is $obj->{stringify}, 0, ' does not stringify';
+is $obj, 'foo', 'is() with string overloading';
+cmp_ok $obj, '==', 42, 'cmp_ok() with number overloading';
+is $obj->{numify}, 0, ' does not numify';
is_deeply [$obj], ['foo'], 'is_deeply with string overloading';
ok eq_array([$obj], ['foo']), 'eq_array ...';
{'TestPackage' => 'TestPackage'});
::is_deeply('TestPackage', 'TestPackage');
}
+
+
+# Make sure 0 isn't a special case. [rt.cpan.org 41109]
+{
+ my $obj = Overloaded->new('0', 42);
+ isa_ok $obj, 'Overloaded';
+
+ cmp_ok $obj, 'eq', '0', 'cmp_ok() eq';
+ is $obj->{stringify}, 0, ' does not stringify';
+ is $obj, '0', 'is() with string overloading';
+}
#!perl -w
-# $Id$
BEGIN {
if( $ENV{PERL_CORE} ) {
#!/usr/bin/perl -w
-# $Id$
BEGIN {
if( $ENV{PERL_CORE} ) {
#!/usr/bin/perl -w
-# $Id$
BEGIN {
if( $ENV{PERL_CORE} ) {
-# $Id$
+#!/usr/bin/perl -w
+
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
}
}
-# Can't use Test.pm, that's a 5.005 thing.
-package My::Test;
-
-print "1..2\n";
-
-my $test_num = 1;
-# Utility testing functions.
-sub ok ($;$) {
- my($test, $name) = @_;
- my $ok = '';
- $ok .= "not " unless $test;
- $ok .= "ok $test_num";
- $ok .= " - $name" if defined $name;
- $ok .= "\n";
- print $ok;
- $test_num++;
-}
-
-
-package main;
+use strict;
-require Test::Simple;
+use Test::More tests => 1;
-require Test::Simple::Catch;
-my($out, $err) = Test::Simple::Catch::caught();
+use Test::Builder::NoOutput;
+{
+ my $tb = Test::Builder::NoOutput->create;
-Test::Simple->import('no_plan');
+ $tb->plan('no_plan');
-ok(1, 'foo');
+ $tb->ok(1, 'foo');
+ $tb->_ending;
-
-END {
- My::Test::ok($$out eq <<OUT);
+ is($tb->read, <<OUT);
ok 1 - foo
1..1
OUT
-
- My::Test::ok($$err eq <<ERR);
-ERR
-
- # Prevent Test::Simple from exiting with non zero
- exit 0;
}
+
-# $Id$
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
#!/usr/bin/perl -w
-# $Id$
# plan() used to export functions by mistake [rt.cpan.org 8385]
-# $Id$
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
#!/usr/bin/perl -w
-# $Id$
BEGIN {
if( $ENV{PERL_CORE} ) {
-# $Id$
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
#!perl -w
-# $Id$
BEGIN {
if( $ENV{PERL_CORE} ) {
pass "This does not run";
}
- like $warning, '/^skip\(\) was passed a non-numeric number of tests/';
+ like $warning, qr/^skip\(\) was passed a non-numeric number of tests/;
}
-# $Id$
+#!/usr/bin/perl -w
+
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
use strict;
-# Can't use Test.pm, that's a 5.005 thing.
-package My::Test;
-
-print "1..2\n";
-
-my $test_num = 1;
-# Utility testing functions.
-sub ok ($;$) {
- my($test, $name) = @_;
- my $ok = '';
- $ok .= "not " unless $test;
- $ok .= "ok $test_num";
- $ok .= " - $name" if defined $name;
- $ok .= "\n";
- print $ok;
- $test_num++;
-}
+use Test::More;
+my $Test = Test::Builder->create;
+$Test->plan(tests => 2);
-package main;
-require Test::More;
-
-require Test::Simple::Catch;
-my($out, $err) = Test::Simple::Catch::caught();
-
-Test::More->import('skip_all');
+my $out = '';
+my $err = '';
+{
+ my $tb = Test::More->builder;
+ $tb->output(\$out);
+ $tb->failure_output(\$err);
+ plan 'skip_all';
+}
END {
- My::Test::ok($$out eq "1..0\n");
- My::Test::ok($$err eq "");
+ $Test->is_eq($out, "1..0 # SKIP\n");
+ $Test->is_eq($err, "");
}
#!/usr/bin/perl -w
-# $Id$
BEGIN {
if( $ENV{PERL_CORE} ) {
#!/usr/bin/perl -w
-# $Id$
use Test::More tests => 1;
#!/usr/bin/perl -w
-# $Id$
BEGIN {
if( $ENV{PERL_CORE} ) {
#!perl -w
-# $Id$
BEGIN {
if( $ENV{PERL_CORE} ) {
ok( 'this' eq 'that', 'ok' );
- like( 'this', '/that/', 'like' );
+ like( 'this', qr/that/, 'like' );
is( 'this', 'that', 'is' );
isnt( 'this', 'this', 'isnt' );
#!/usr/bin/perl -w
-# $Id$
BEGIN {
if( $ENV{PERL_CORE} ) {
}
use strict;
-use Test::More tests => 20;
-use TieOut;
+use Test::More tests => 21;
BEGIN { $^W = 1; }
Test::More->builder->isnt_num(23, undef, 'isnt_num()');
#line 45
-like( undef, '/.*/', 'undef is like anything' );
+like( undef, qr/.*/, 'undef is like anything' );
warnings_like(qr/Use of uninitialized value.* at $Filename line 45\.\n/);
eq_array( [undef, undef], [undef, 23] );
my $tb = Test::More->builder;
-use TieOut;
-my $caught = tie *CATCH, 'TieOut';
-my $old_fail = $tb->failure_output;
-$tb->failure_output(\*CATCH);
+my $err;
+$tb->failure_output(\$err);
diag(undef);
-$tb->failure_output($old_fail);
+$tb->reset_outputs;
-is( $caught->read, "# undef\n" );
+is( $err, "# undef\n" );
no_warnings;
$tb->maybe_regex(undef);
-is( $caught->read, '' );
no_warnings;
+
+
+# test-more.googlecode.com #42
+{
+ is_deeply([ undef ], [ undef ]);
+ no_warnings;
+}
#!/usr/bin/perl -w
-# $Id$
BEGIN {
if( $ENV{PERL_CORE} ) {
-# $Id$
BEGIN {
if( $ENV{PERL_CORE} ) {
chdir 't';
#!/usr/bin/perl -w
-# $Id$
BEGIN {
if( $ENV{PERL_CORE} ) {
--- /dev/null
+#!/usr/bin/perl -w
+
+# Make sure all the modules have the same version
+#
+# TBT has its own version system.
+
+use strict;
+use Test::More;
+
+require Test::Builder;
+require Test::Builder::Module;
+require Test::Simple;
+
+my $dist_version = $Test::More::VERSION;
+
+like( $dist_version, qr/^ \d+ \. \d+ $/x );
+is( $dist_version, $Test::Builder::VERSION, 'Test::Builder' );
+is( $dist_version, $Test::Builder::Module::VERSION, 'TB::Module' );
+is( $dist_version, $Test::Simple::VERSION, 'Test::Simple' );
+
+done_testing(4);
-# $Id$
=head1 NAME
Test::Tutorial - A tutorial about writing really basic tests
package Dev::Null;
-# $Id$
-sub TIEHANDLE { bless {} }
+use strict;
+
+sub TIEHANDLE { bless {}, shift }
sub PRINT { 1 }
1;
--- /dev/null
+package Test::Builder::NoOutput;
+
+use strict;
+use warnings;
+
+use base qw(Test::Builder);
+
+
+=head1 NAME
+
+Test::Builder::NoOutput - A subclass of Test::Builder which prints nothing
+
+=head1 SYNOPSIS
+
+ use Test::Builder::NoOutput;
+
+ my $tb = Test::Builder::NoOutput->new;
+
+ ...test as normal...
+
+ my $output = $tb->read;
+
+=head1 DESCRIPTION
+
+This is a subclass of Test::Builder which traps all its output.
+It is mostly useful for testing Test::Builder.
+
+=head3 read
+
+ my $all_output = $tb->read;
+ my $output = $tb->read($stream);
+
+Returns all the output (including failure and todo output) collected
+so far. It is destructive, each call to read clears the output
+buffer.
+
+If $stream is given it will return just the output from that stream.
+$stream's are...
+
+ out output()
+ err failure_output()
+ todo todo_output()
+ all all outputs
+
+Defaults to 'all'.
+
+=cut
+
+my $Test = __PACKAGE__->new;
+
+sub create {
+ my $class = shift;
+ my $self = $class->SUPER::create(@_);
+
+ my %outputs = (
+ all => '',
+ out => '',
+ err => '',
+ todo => '',
+ );
+ $self->{_outputs} = \%outputs;
+
+ tie *OUT, "Test::Builder::NoOutput::Tee", \$outputs{all}, \$outputs{out};
+ tie *ERR, "Test::Builder::NoOutput::Tee", \$outputs{all}, \$outputs{err};
+ tie *TODO, "Test::Builder::NoOutput::Tee", \$outputs{all}, \$outputs{todo};
+
+ $self->output(*OUT);
+ $self->failure_output(*ERR);
+ $self->todo_output(*TODO);
+
+ return $self;
+}
+
+sub read {
+ my $self = shift;
+ my $stream = @_ ? shift : 'all';
+
+ my $out = $self->{_outputs}{$stream};
+
+ $self->{_outputs}{$stream} = '';
+
+ # Clear all the streams if 'all' is read.
+ if( $stream eq 'all' ) {
+ my @keys = keys %{$self->{_outputs}};
+ $self->{_outputs}{$_} = '' for @keys;
+ }
+
+ return $out;
+}
+
+
+package Test::Builder::NoOutput::Tee;
+
+# A cheap implementation of IO::Tee.
+
+sub TIEHANDLE {
+ my($class, @refs) = @_;
+
+ my @fhs;
+ for my $ref (@refs) {
+ my $fh = Test::Builder->_new_fh($ref);
+ push @fhs, $fh;
+ }
+
+ my $self = [@fhs];
+ return bless $self, $class;
+}
+
+sub PRINT {
+ my $self = shift;
+
+ print $_ @_ for @$self;
+}
+
+sub PRINTF {
+ my $self = shift;
+ my $format = shift;
+
+ printf $_ @_ for @$self;
+}
+
+1;
# For testing Test::Simple;
-# $Id$
package Test::Simple::Catch;
+use strict;
+
use Symbol;
use TieOut;
my( $out_fh, $err_fh ) = ( gensym, gensym );
require Test::Simple;
-# $Id$
push @INC, 't/lib';
require Test::Simple::Catch;
require Test::Simple;
-# $Id$
use Carp;
push @INC, 't/lib';
require Test::Simple;
-# $Id$
push @INC, 't/lib';
require Test::Simple::Catch;
require Test::Builder;
-# $Id$
exit 1;
require Test::Simple;
-# $Id$
push @INC, 't/lib';
require Test::Simple::Catch;
require Test::Simple;
-# $Id$
use lib 't/lib';
require Test::Simple::Catch;
require Test::Simple;
-# $Id$
push @INC, 't/lib';
require Test::Simple::Catch;
require Test::Simple;
-# $Id$
push @INC, 't/lib';
require Test::Simple::Catch;
# ID 20020716.013, the exit code would become 0 if the test died
-# $Id$
# before a plan.
require Test::Simple;
require Test::Simple;
-# $Id$
require Test::Simple;
-# $Id$
push @INC, 't/lib';
require Test::Simple::Catch;
require Test::Simple;
-# $Id$
push @INC, 't/lib';
require Test::Simple::Catch;
require Test::Simple;
-# $Id$
push @INC, 't/lib';
require Test::Simple::Catch;
require Test::Simple;
-# $Id$
push @INC, 't/lib';
require Test::Simple::Catch;
projects / p5sagit/p5-mst-13.2.git / commitdiff