diff options
| author | David Mitchell <davem@iabyn.com> | 2009-07-06 14:59:06 +0100 |
|---|---|---|
| committer | David Mitchell <davem@iabyn.com> | 2009-07-07 12:04:04 +0100 |
| commit | 2a4e0241c89892845c5a7765d788305c3a1e6620 (patch) | |
| tree | bb16a15ff38c631b2432493d8506a00a0cbd6223 /lib | |
| parent | a5f97a6fb2c6c5d04afcf3f9eaa92776ee947e44 (diff) | |
| download | perl-2a4e0241c89892845c5a7765d788305c3a1e6620.tar.gz | |
update to Test::Simple 0.92
(cherry picked from commit 3e887aae38ef79132cc7112942154a36f73033f5)
Diffstat (limited to 'lib')
99 files changed, 1334 insertions, 827 deletions
diff --git a/lib/Test/Builder.pm b/lib/Test/Builder.pm index 87f23f2bcd..cd5779f75b 100644 --- a/lib/Test/Builder.pm +++ b/lib/Test/Builder.pm @@ -1,13 +1,19 @@ 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; @@ -100,7 +106,7 @@ Returns a Test::Builder object representing the current state of the 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. @@ -162,6 +168,8 @@ sub reset { ## no critic (Subroutines::ProhibitBuiltinHomonyms) $self->{Have_Plan} = 0; $self->{No_Plan} = 0; + $self->{Have_Output_Plan} = 0; + $self->{Original_Pid} = $$; share( $self->{Curr_Test} ); @@ -181,6 +189,7 @@ sub reset { ## no critic (Subroutines::ProhibitBuiltinHomonyms) $self->{Todo} = undef; $self->{Todo_Stack} = []; $self->{Start_Todo} = 0; + $self->{Opened_Testhandles} = 0; $self->_dup_stdhandles; @@ -205,10 +214,16 @@ are. You usually only want to call one of these methods. 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 ) = @_; @@ -216,27 +231,11 @@ sub plan { 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 ); @@ -246,12 +245,31 @@ sub plan { 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 @@ -267,7 +285,7 @@ sub expected_tests { $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}; } @@ -276,12 +294,14 @@ sub 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; @@ -289,11 +309,122 @@ sub no_plan { 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 @@ -310,20 +441,16 @@ sub has_plan { $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); } @@ -357,7 +484,7 @@ These actually run the tests, analogous to the functions in Test::More. They all return true if the test passed, false if the test failed. -$name is always optional. +C<$name> is always optional. =over 4 @@ -365,8 +492,8 @@ $name is always optional. $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 @@ -377,8 +504,6 @@ sub ok { # store, so we turn it into a boolean. $test = $test ? 1 : 0; - $self->_plan_check; - lock $self->{Curr_Test}; $self->{Curr_Test}++; @@ -511,14 +636,14 @@ sub _is_dualvar { $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 @@ -608,14 +733,14 @@ DIAGNOSTIC $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 @@ -657,17 +782,17 @@ sub isnt_num { $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 @@ -689,7 +814,7 @@ sub unlike { $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); @@ -814,7 +939,7 @@ BAIL_OUT() used to be BAILOUT() $Test->skip; $Test->skip($why); -Skips the current test, reporting $why. +Skips the current test, reporting C<$why>. =cut @@ -823,8 +948,6 @@ sub skip { $why ||= ''; $self->_unoverload_str( \$why ); - $self->_plan_check; - lock( $self->{Curr_Test} ); $self->{Curr_Test}++; @@ -854,7 +977,7 @@ sub skip { $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"; @@ -865,8 +988,6 @@ sub todo_skip { my( $self, $why ) = @_; $why ||= ''; - $self->_plan_check; - lock( $self->{Curr_Test} ); $self->{Curr_Test}++; @@ -896,10 +1017,10 @@ sub todo_skip { $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 @@ -921,13 +1042,13 @@ These methods are useful when writing your own test methods. 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 { @@ -1030,11 +1151,11 @@ DIAGNOSTIC 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. @@ -1065,7 +1186,7 @@ sub _try { 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 @@ -1094,7 +1215,7 @@ sub is_fh { $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. @@ -1159,7 +1280,7 @@ sub use_numbers { $Test->no_diag($no_diag); If set true no diagnostics will be printed. This includes calls to -diag(). +C<diag()>. =item B<no_ending> @@ -1209,11 +1330,11 @@ Test::Builder's default output settings will not be affected. $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 @@ -1221,7 +1342,7 @@ already. 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(...); @@ -1241,7 +1362,7 @@ sub 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 @@ -1319,7 +1440,7 @@ sub explain { $Test->_print(@msgs); -Prints to the output() filehandle. +Prints to the C<output()> filehandle. =end _private @@ -1353,28 +1474,32 @@ sub _print_to_fh { =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. @@ -1415,6 +1540,18 @@ sub _new_fh { 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: $!"); @@ -1452,12 +1589,10 @@ sub _dup_stdhandles { 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. @@ -1467,7 +1602,7 @@ sub _open_testhandles { # $self->_copy_io_layers( \*STDOUT, $Testout ); # $self->_copy_io_layers( \*STDERR, $Testerr ); - $Opened_Testhandles = 1; + $self->{Opened_Testhandles} = 1; return; } @@ -1510,14 +1645,14 @@ sub reset_outputs { $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 @@ -1539,16 +1674,6 @@ sub croak { 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 @@ -1576,9 +1701,6 @@ sub current_test { 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. @@ -1626,7 +1748,7 @@ sub summary { 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? @@ -1640,7 +1762,7 @@ Like summary(), but with a lot more detail. '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. @@ -1653,16 +1775,16 @@ of ''. Type can be one of the following: 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', @@ -1682,20 +1804,20 @@ sub details { 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 @@ -1717,8 +1839,8 @@ sub todo { 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 @@ -1837,11 +1959,11 @@ sub todo_end { 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 @@ -1881,8 +2003,6 @@ sub _sanity_check { 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!' ); @@ -1893,8 +2013,8 @@ sub _sanity_check { $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 @@ -1916,9 +2036,9 @@ WHOA _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 @@ -1939,7 +2059,6 @@ sub _ending { 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. @@ -1947,6 +2066,11 @@ sub _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} ) { @@ -1963,7 +2087,7 @@ sub _ending { 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}; } @@ -2058,12 +2182,11 @@ So the exit codes are... 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. @@ -2071,6 +2194,21 @@ 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, @@ -2090,7 +2228,7 @@ E<lt>schwern@pobox.comE<gt> 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> diff --git a/lib/Test/Builder/Module.pm b/lib/Test/Builder/Module.pm index 166b9dabc0..a2d8e5bb60 100644 --- a/lib/Test/Builder/Module.pm +++ b/lib/Test/Builder/Module.pm @@ -1,5 +1,4 @@ package Test::Builder::Module; -# $Id$ use strict; @@ -8,7 +7,8 @@ use Test::Builder; 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 { diff --git a/lib/Test/Builder/Tester.pm b/lib/Test/Builder/Tester.pm index d0bfc3f8e6..c019635584 100644 --- a/lib/Test/Builder/Tester.pm +++ b/lib/Test/Builder/Tester.pm @@ -1,5 +1,4 @@ package Test::Builder::Tester; -# $Id$ use strict; our $VERSION = "1.18"; diff --git a/lib/Test/Builder/Tester/Color.pm b/lib/Test/Builder/Tester/Color.pm index d333b2fe51..264fddbfd8 100644 --- a/lib/Test/Builder/Tester/Color.pm +++ b/lib/Test/Builder/Tester/Color.pm @@ -1,10 +1,11 @@ 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 diff --git a/lib/Test/More.pm b/lib/Test/More.pm index 875e40ae36..aaf6d8721b 100644 --- a/lib/Test/More.pm +++ b/lib/Test/More.pm @@ -1,5 +1,4 @@ package Test::More; -# $Id$ use 5.006; use strict; @@ -18,7 +17,7 @@ sub _carp { 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; @@ -31,6 +30,7 @@ our @EXPORT = qw(ok use_ok require_ok eq_array eq_hash eq_set $TODO plan + done_testing can_ok isa_ok new_ok diag note explain BAIL_OUT @@ -44,9 +44,9 @@ Test::More - yet another framework for writing test scripts 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' ); @@ -96,7 +96,7 @@ Test::More - yet another framework for writing test scripts =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 @@ -116,14 +116,19 @@ The preferred way to do this is to declare a plan when you C<use Test::More>. 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. @@ -189,6 +194,32 @@ sub import_extra { 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 @@ -319,6 +350,17 @@ In these cases, use ok(). 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(). @@ -420,6 +462,12 @@ is()'s use of C<eq> will interfere: 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($$$;$) { @@ -491,8 +539,9 @@ sub can_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 @@ -508,6 +557,10 @@ where you'd otherwise have to write 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' ); @@ -523,39 +576,46 @@ sub isa_ok ($$;$) { 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 ); @@ -829,11 +889,11 @@ is_deeply() compares the dereferenced values of references, the 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 @@ -1011,7 +1071,7 @@ sub note { 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... @@ -1228,6 +1288,8 @@ available such as a database connection failing. The test will exit with 255. +For even better control look at L<Test::Most>. + =cut sub BAIL_OUT { @@ -1325,6 +1387,10 @@ sub _deep_check { 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; } @@ -1451,7 +1517,7 @@ level. The following is an example of a comparison which might not work: eq_set([\1, \2], [\2, \1]); -Test::Deep contains much better set comparison functions. +L<Test::Deep> contains much better set comparison functions. =cut @@ -1535,6 +1601,24 @@ B<NOTE> This behavior may go away in future versions. 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 @@ -1546,7 +1630,7 @@ difference. This is good. 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. @@ -1568,11 +1652,11 @@ This may cause problems: =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. @@ -1633,6 +1717,12 @@ the perl-qa gang. 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>. diff --git a/lib/Test/Simple.pm b/lib/Test/Simple.pm index cef041130f..48c72e27fc 100644 --- a/lib/Test/Simple.pm +++ b/lib/Test/Simple.pm @@ -1,11 +1,10 @@ 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; diff --git a/lib/Test/Simple/Changes b/lib/Test/Simple/Changes index 09a5662bff..0c955f2908 100644 --- a/lib/Test/Simple/Changes +++ b/lib/Test/Simple/Changes @@ -1,3 +1,64 @@ +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 diff --git a/lib/Test/Simple/README b/lib/Test/Simple/README index 114aa26735..5f825bd41d 100644 --- a/lib/Test/Simple/README +++ b/lib/Test/Simple/README @@ -1,4 +1,3 @@ -# $Id$ This is the README file for Test::Simple, basic utilities for writing tests, by Michael G Schwern <schwern@pobox.com>. @@ -14,3 +13,10 @@ perl Makefile.PL 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/ diff --git a/lib/Test/Simple/TODO b/lib/Test/Simple/TODO index a49068870e..c596e90876 100644 --- a/lib/Test/Simple/TODO +++ b/lib/Test/Simple/TODO @@ -1,4 +1,3 @@ -# $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. diff --git a/lib/Test/Simple/t/00test_harness_check.t b/lib/Test/Simple/t/00test_harness_check.t index 0504be39cc..3ff4a13c63 100644 --- a/lib/Test/Simple/t/00test_harness_check.t +++ b/lib/Test/Simple/t/00test_harness_check.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ # A test to make sure the new Test::Harness was installed properly. diff --git a/lib/Test/Simple/t/BEGIN_require_ok.t b/lib/Test/Simple/t/BEGIN_require_ok.t index c3e4ccab9b..733d0bb861 100644 --- a/lib/Test/Simple/t/BEGIN_require_ok.t +++ b/lib/Test/Simple/t/BEGIN_require_ok.t @@ -1,5 +1,9 @@ #!/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} ) { @@ -15,11 +19,9 @@ use Test::More; 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); diff --git a/lib/Test/Simple/t/BEGIN_use_ok.t b/lib/Test/Simple/t/BEGIN_use_ok.t index aa428d5711..476badf7a2 100644 --- a/lib/Test/Simple/t/BEGIN_use_ok.t +++ b/lib/Test/Simple/t/BEGIN_use_ok.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ # [rt.cpan.org 28345] # @@ -19,11 +18,9 @@ use Test::More; 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); + diff --git a/lib/Test/Simple/t/Builder/Builder.t b/lib/Test/Simple/t/Builder/Builder.t index ce53097076..a5bfd155a6 100644 --- a/lib/Test/Simple/t/Builder/Builder.t +++ b/lib/Test/Simple/t/Builder/Builder.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { diff --git a/lib/Test/Simple/t/Builder/carp.t b/lib/Test/Simple/t/Builder/carp.t index fb7208a560..e89eeebfb9 100644 --- a/lib/Test/Simple/t/Builder/carp.t +++ b/lib/Test/Simple/t/Builder/carp.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { diff --git a/lib/Test/Simple/t/Builder/create.t b/lib/Test/Simple/t/Builder/create.t index d66ee06b58..d584b30955 100644 --- a/lib/Test/Simple/t/Builder/create.t +++ b/lib/Test/Simple/t/Builder/create.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ #!perl -w @@ -13,8 +12,9 @@ BEGIN { } } -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'; @@ -23,24 +23,18 @@ is $more_tb, Test::More->builder, 'create does not interfere with ->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"); diff --git a/lib/Test/Simple/t/Builder/curr_test.t b/lib/Test/Simple/t/Builder/current_test.t index ec54980de4..edd201c0e9 100644 --- a/lib/Test/Simple/t/Builder/curr_test.t +++ b/lib/Test/Simple/t/Builder/current_test.t @@ -1,5 +1,4 @@ #!/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. diff --git a/lib/Test/Simple/t/Builder/current_test_without_plan.t b/lib/Test/Simple/t/Builder/current_test_without_plan.t new file mode 100644 index 0000000000..31f9589977 --- /dev/null +++ b/lib/Test/Simple/t/Builder/current_test_without_plan.t @@ -0,0 +1,16 @@ +#!/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); diff --git a/lib/Test/Simple/t/Builder/details.t b/lib/Test/Simple/t/Builder/details.t index 82f74c29a8..05d4828b4d 100644 --- a/lib/Test/Simple/t/Builder/details.t +++ b/lib/Test/Simple/t/Builder/details.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { @@ -30,13 +29,11 @@ push @Expected_Details, { 'ok' => 1, # 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' ); @@ -69,8 +66,7 @@ push @Expected_Details, { 'ok' => 1, }; 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, diff --git a/lib/Test/Simple/t/Builder/done_testing.t b/lib/Test/Simple/t/Builder/done_testing.t new file mode 100644 index 0000000000..14a8f918b0 --- /dev/null +++ b/lib/Test/Simple/t/Builder/done_testing.t @@ -0,0 +1,12 @@ +#!/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(); diff --git a/lib/Test/Simple/t/Builder/done_testing_double.t b/lib/Test/Simple/t/Builder/done_testing_double.t new file mode 100644 index 0000000000..d696384b28 --- /dev/null +++ b/lib/Test/Simple/t/Builder/done_testing_double.t @@ -0,0 +1,39 @@ +#!/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 diff --git a/lib/Test/Simple/t/Builder/done_testing_plan_mismatch.t b/lib/Test/Simple/t/Builder/done_testing_plan_mismatch.t new file mode 100644 index 0000000000..b815437f80 --- /dev/null +++ b/lib/Test/Simple/t/Builder/done_testing_plan_mismatch.t @@ -0,0 +1,37 @@ +#!/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 diff --git a/lib/Test/Simple/t/Builder/done_testing_with_no_plan.t b/lib/Test/Simple/t/Builder/done_testing_with_no_plan.t new file mode 100644 index 0000000000..ff5f40c197 --- /dev/null +++ b/lib/Test/Simple/t/Builder/done_testing_with_no_plan.t @@ -0,0 +1,11 @@ +#!/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); diff --git a/lib/Test/Simple/t/Builder/done_testing_with_number.t b/lib/Test/Simple/t/Builder/done_testing_with_number.t new file mode 100644 index 0000000000..c21458f54e --- /dev/null +++ b/lib/Test/Simple/t/Builder/done_testing_with_number.t @@ -0,0 +1,12 @@ +#!/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); diff --git a/lib/Test/Simple/t/Builder/done_testing_with_plan.t b/lib/Test/Simple/t/Builder/done_testing_with_plan.t new file mode 100644 index 0000000000..c0a3d0f014 --- /dev/null +++ b/lib/Test/Simple/t/Builder/done_testing_with_plan.t @@ -0,0 +1,11 @@ +#!/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); diff --git a/lib/Test/Simple/t/Builder/fork_with_new_stdout.t b/lib/Test/Simple/t/Builder/fork_with_new_stdout.t new file mode 100644 index 0000000000..e38c1d08cb --- /dev/null +++ b/lib/Test/Simple/t/Builder/fork_with_new_stdout.t @@ -0,0 +1,54 @@ +#!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 diff --git a/lib/Test/Simple/t/Builder/has_plan.t b/lib/Test/Simple/t/Builder/has_plan.t index 4eecbd0fa7..d0be86a97a 100644 --- a/lib/Test/Simple/t/Builder/has_plan.t +++ b/lib/Test/Simple/t/Builder/has_plan.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { diff --git a/lib/Test/Simple/t/Builder/has_plan2.t b/lib/Test/Simple/t/Builder/has_plan2.t index c4aca0f0ea..e13ea4af94 100644 --- a/lib/Test/Simple/t/Builder/has_plan2.t +++ b/lib/Test/Simple/t/Builder/has_plan2.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { diff --git a/lib/Test/Simple/t/Builder/is_fh.t b/lib/Test/Simple/t/Builder/is_fh.t index a492f01ddd..0eb3ec0b15 100644 --- a/lib/Test/Simple/t/Builder/is_fh.t +++ b/lib/Test/Simple/t/Builder/is_fh.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { diff --git a/lib/Test/Simple/t/Builder/maybe_regex.t b/lib/Test/Simple/t/Builder/maybe_regex.t index c352c821c5..d1927a56e5 100644 --- a/lib/Test/Simple/t/Builder/maybe_regex.t +++ b/lib/Test/Simple/t/Builder/maybe_regex.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { diff --git a/lib/Test/Simple/t/Builder/no_diag.t b/lib/Test/Simple/t/Builder/no_diag.t index f86198426e..6fa538a82e 100644 --- a/lib/Test/Simple/t/Builder/no_diag.t +++ b/lib/Test/Simple/t/Builder/no_diag.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ use Test::More 'no_diag', tests => 2; diff --git a/lib/Test/Simple/t/Builder/no_ending.t b/lib/Test/Simple/t/Builder/no_ending.t index 3b3077d41e..97e968e289 100644 --- a/lib/Test/Simple/t/Builder/no_ending.t +++ b/lib/Test/Simple/t/Builder/no_ending.t @@ -1,4 +1,3 @@ -# $Id$ use Test::Builder; BEGIN { diff --git a/lib/Test/Simple/t/Builder/no_header.t b/lib/Test/Simple/t/Builder/no_header.t index a12bec54c7..93e6bec34c 100644 --- a/lib/Test/Simple/t/Builder/no_header.t +++ b/lib/Test/Simple/t/Builder/no_header.t @@ -1,4 +1,3 @@ -# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { chdir 't'; diff --git a/lib/Test/Simple/t/Builder/no_plan_at_all.t b/lib/Test/Simple/t/Builder/no_plan_at_all.t new file mode 100644 index 0000000000..3909cfe5b7 --- /dev/null +++ b/lib/Test/Simple/t/Builder/no_plan_at_all.t @@ -0,0 +1,28 @@ +#!/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 diff --git a/lib/Test/Simple/t/Builder/ok_obj.t b/lib/Test/Simple/t/Builder/ok_obj.t index f5af1f17f3..8678dbff8d 100644 --- a/lib/Test/Simple/t/Builder/ok_obj.t +++ b/lib/Test/Simple/t/Builder/ok_obj.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ # Testing to make sure Test::Builder doesn't accidentally store objects # passed in as test arguments. diff --git a/lib/Test/Simple/t/Builder/output.t b/lib/Test/Simple/t/Builder/output.t index d49d02a001..77e0e0bbb3 100644 --- a/lib/Test/Simple/t/Builder/output.t +++ b/lib/Test/Simple/t/Builder/output.t @@ -1,5 +1,6 @@ #!perl -w -# $Id$ + +use strict; BEGIN { if( $ENV{PERL_CORE} ) { @@ -12,76 +13,91 @@ BEGIN { } 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 @@ -94,3 +110,4 @@ not ok 5 # TODO & SKIP todo # skip # OUTPUT +} diff --git a/lib/Test/Simple/t/Builder/reset.t b/lib/Test/Simple/t/Builder/reset.t index e655725d59..6bff7fcf27 100644 --- a/lib/Test/Simple/t/Builder/reset.t +++ b/lib/Test/Simple/t/Builder/reset.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ # Test Test::Builder->reset; @@ -16,25 +15,24 @@ chdir 't'; 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"); @@ -50,41 +48,26 @@ $tb->no_ending(1); # 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); diff --git a/lib/Test/Simple/t/Builder/try.t b/lib/Test/Simple/t/Builder/try.t index fd61ddd1b8..eeb3bcb1ab 100644 --- a/lib/Test/Simple/t/Builder/try.t +++ b/lib/Test/Simple/t/Builder/try.t @@ -1,5 +1,4 @@ #!perl -w -# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { diff --git a/lib/Test/Simple/t/More.t b/lib/Test/Simple/t/More.t index 73d71d84ac..21958cf2b6 100644 --- a/lib/Test/Simple/t/More.t +++ b/lib/Test/Simple/t/More.t @@ -1,5 +1,4 @@ #!perl -w -# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { @@ -9,7 +8,7 @@ BEGIN { } 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"; @@ -48,6 +47,11 @@ can_ok(bless({}, "Test::More"), qw(require_ok use_ok ok is isnt like skip 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 diff --git a/lib/Test/Simple/t/Tester/tbt_01basic.t b/lib/Test/Simple/t/Tester/tbt_01basic.t index f40ab5ee77..769a1c4729 100644 --- a/lib/Test/Simple/t/Tester/tbt_01basic.t +++ b/lib/Test/Simple/t/Tester/tbt_01basic.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -# $Id$ use Test::Builder::Tester tests => 9; use Test::More; @@ -23,7 +22,7 @@ ok(2,"two"); 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"); @@ -47,7 +46,7 @@ test_test("testing failing on the same line with the same name"); 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"); diff --git a/lib/Test/Simple/t/Tester/tbt_02fhrestore.t b/lib/Test/Simple/t/Tester/tbt_02fhrestore.t index b6ef7e0700..e37357171b 100644 --- a/lib/Test/Simple/t/Tester/tbt_02fhrestore.t +++ b/lib/Test/Simple/t/Tester/tbt_02fhrestore.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -# $Id$ use Test::Builder::Tester tests => 4; use Test::More; diff --git a/lib/Test/Simple/t/Tester/tbt_03die.t b/lib/Test/Simple/t/Tester/tbt_03die.t index 8c7d30aaa7..b9dba801eb 100644 --- a/lib/Test/Simple/t/Tester/tbt_03die.t +++ b/lib/Test/Simple/t/Tester/tbt_03die.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -# $Id$ use Test::Builder::Tester tests => 1; use Test::More; diff --git a/lib/Test/Simple/t/Tester/tbt_04line_num.t b/lib/Test/Simple/t/Tester/tbt_04line_num.t index f18ed019c5..9e8365acbf 100644 --- a/lib/Test/Simple/t/Tester/tbt_04line_num.t +++ b/lib/Test/Simple/t/Tester/tbt_04line_num.t @@ -1,9 +1,8 @@ #!/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"); diff --git a/lib/Test/Simple/t/Tester/tbt_05faildiag.t b/lib/Test/Simple/t/Tester/tbt_05faildiag.t index def67351cf..59ad721240 100644 --- a/lib/Test/Simple/t/Tester/tbt_05faildiag.t +++ b/lib/Test/Simple/t/Tester/tbt_05faildiag.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -# $Id$ use Test::Builder::Tester tests => 5; use Test::More; diff --git a/lib/Test/Simple/t/Tester/tbt_06errormess.t b/lib/Test/Simple/t/Tester/tbt_06errormess.t index c4e663237a..d8d8a0fead 100644 --- a/lib/Test/Simple/t/Tester/tbt_06errormess.t +++ b/lib/Test/Simple/t/Tester/tbt_06errormess.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ use Test::More tests => 8; use Symbol; diff --git a/lib/Test/Simple/t/Tester/tbt_07args.t b/lib/Test/Simple/t/Tester/tbt_07args.t index 8d104b7aa2..1b9393bdf4 100644 --- a/lib/Test/Simple/t/Tester/tbt_07args.t +++ b/lib/Test/Simple/t/Tester/tbt_07args.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ use Test::More tests => 18; use Symbol; diff --git a/lib/Test/Simple/t/bad_plan.t b/lib/Test/Simple/t/bad_plan.t index 1d4e50d6f0..80e0e65bca 100644 --- a/lib/Test/Simple/t/bad_plan.t +++ b/lib/Test/Simple/t/bad_plan.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { @@ -8,32 +7,17 @@ BEGIN { } } -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 "# $@"; - diff --git a/lib/Test/Simple/t/bail_out.t b/lib/Test/Simple/t/bail_out.t index 58bcf47480..5cdc1f9969 100644 --- a/lib/Test/Simple/t/bail_out.t +++ b/lib/Test/Simple/t/bail_out.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { @@ -19,30 +18,22 @@ BEGIN { 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 diff --git a/lib/Test/Simple/t/buffer.t b/lib/Test/Simple/t/buffer.t index 04e92b9205..6039e4a6f7 100644 --- a/lib/Test/Simple/t/buffer.t +++ b/lib/Test/Simple/t/buffer.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { diff --git a/lib/Test/Simple/t/circular_data.t b/lib/Test/Simple/t/circular_data.t index ce23e0b350..2fd819e1f4 100644 --- a/lib/Test/Simple/t/circular_data.t +++ b/lib/Test/Simple/t/circular_data.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ # Test is_deeply and friends with circular data structures [rt.cpan.org 7289] diff --git a/lib/Test/Simple/t/cmp_ok.t b/lib/Test/Simple/t/cmp_ok.t index 031940e49c..de1a7e634d 100644 --- a/lib/Test/Simple/t/cmp_ok.t +++ b/lib/Test/Simple/t/cmp_ok.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { diff --git a/lib/Test/Simple/t/diag.t b/lib/Test/Simple/t/diag.t index 91ef58f588..f5cb437d54 100644 --- a/lib/Test/Simple/t/diag.t +++ b/lib/Test/Simple/t/diag.t @@ -1,5 +1,4 @@ #!perl -w -# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { @@ -25,27 +24,22 @@ BEGIN { 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 @@ -54,25 +48,21 @@ 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 @@ -81,10 +71,11 @@ DIAG } -# [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 +} diff --git a/lib/Test/Simple/t/died.t b/lib/Test/Simple/t/died.t index 2a40d01f1e..b4ee2fbbff 100644 --- a/lib/Test/Simple/t/died.t +++ b/lib/Test/Simple/t/died.t @@ -1,5 +1,4 @@ #!perl -w -# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { diff --git a/lib/Test/Simple/t/dont_overwrite_die_handler.t b/lib/Test/Simple/t/dont_overwrite_die_handler.t index 03609a8023..0657a06ca3 100644 --- a/lib/Test/Simple/t/dont_overwrite_die_handler.t +++ b/lib/Test/Simple/t/dont_overwrite_die_handler.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { diff --git a/lib/Test/Simple/t/eq_set.t b/lib/Test/Simple/t/eq_set.t index b090373cfa..fbdc52db1f 100644 --- a/lib/Test/Simple/t/eq_set.t +++ b/lib/Test/Simple/t/eq_set.t @@ -1,5 +1,4 @@ #!perl -w -# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { diff --git a/lib/Test/Simple/t/exit.t b/lib/Test/Simple/t/exit.t index 6c6945ca21..96f3a7eaed 100644 --- a/lib/Test/Simple/t/exit.t +++ b/lib/Test/Simple/t/exit.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ # Can't use Test.pm, that's a 5.005 thing. package My::Test; @@ -11,21 +10,6 @@ BEGIN { } } -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); @@ -33,29 +17,20 @@ $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( $@ ) { @@ -65,34 +40,74 @@ else { *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; diff --git a/lib/Test/Simple/t/explain.t b/lib/Test/Simple/t/explain.t index 6b67b6cc4b..cf2f550e95 100644 --- a/lib/Test/Simple/t/explain.t +++ b/lib/Test/Simple/t/explain.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { diff --git a/lib/Test/Simple/t/extra.t b/lib/Test/Simple/t/extra.t index 778284da43..57235be195 100644 --- a/lib/Test/Simple/t/extra.t +++ b/lib/Test/Simple/t/extra.t @@ -1,5 +1,4 @@ #!perl -w -# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { diff --git a/lib/Test/Simple/t/extra_one.t b/lib/Test/Simple/t/extra_one.t index 90ba9abbce..d77404e15d 100644 --- a/lib/Test/Simple/t/extra_one.t +++ b/lib/Test/Simple/t/extra_one.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { diff --git a/lib/Test/Simple/t/fail-like.t b/lib/Test/Simple/t/fail-like.t index d1a51d49e1..0ea5fab3da 100644 --- a/lib/Test/Simple/t/fail-like.t +++ b/lib/Test/Simple/t/fail-like.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { @@ -56,14 +55,14 @@ ERR } { - # 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 diff --git a/lib/Test/Simple/t/fail-more.t b/lib/Test/Simple/t/fail-more.t index 4e515c5fb8..423e216488 100644 --- a/lib/Test/Simple/t/fail-more.t +++ b/lib/Test/Simple/t/fail-more.t @@ -1,5 +1,4 @@ #!perl -w -# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { @@ -25,7 +24,7 @@ package My::Test; # 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(@_); @@ -35,26 +34,26 @@ sub is ($$;$) { $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 "", @_); }; @@ -65,234 +64,387 @@ $tb->use_numbers(0); 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/ + ); } @@ -300,88 +452,58 @@ ERR -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 diff --git a/lib/Test/Simple/t/fail.t b/lib/Test/Simple/t/fail.t index fd272d17bf..ccf0c74893 100644 --- a/lib/Test/Simple/t/fail.t +++ b/lib/Test/Simple/t/fail.t @@ -1,5 +1,6 @@ #!perl -w -# $Id$ + +# Simple test of what failure output looks like BEGIN { if( $ENV{PERL_CORE} ) { @@ -13,45 +14,28 @@ BEGIN { 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 @@ -60,14 +44,13 @@ not ok 4 - oh no! 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); } diff --git a/lib/Test/Simple/t/fail_one.t b/lib/Test/Simple/t/fail_one.t index 53de4547f8..61d7c081ff 100644 --- a/lib/Test/Simple/t/fail_one.t +++ b/lib/Test/Simple/t/fail_one.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { @@ -13,51 +12,32 @@ BEGIN { 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); } diff --git a/lib/Test/Simple/t/filehandles.t b/lib/Test/Simple/t/filehandles.t index 1e20470f27..f7dad5d7ea 100644 --- a/lib/Test/Simple/t/filehandles.t +++ b/lib/Test/Simple/t/filehandles.t @@ -1,5 +1,4 @@ #!perl -w -# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { diff --git a/lib/Test/Simple/t/fork.t b/lib/Test/Simple/t/fork.t index cda5bde561..55d7aec1f9 100644 --- a/lib/Test/Simple/t/fork.t +++ b/lib/Test/Simple/t/fork.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { diff --git a/lib/Test/Simple/t/harness_active.t b/lib/Test/Simple/t/harness_active.t index 150c826deb..7b027a7b40 100644 --- a/lib/Test/Simple/t/harness_active.t +++ b/lib/Test/Simple/t/harness_active.t @@ -1,5 +1,4 @@ #!perl -w -# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { diff --git a/lib/Test/Simple/t/import.t b/lib/Test/Simple/t/import.t index fd2aef40ba..68a36138bc 100644 --- a/lib/Test/Simple/t/import.t +++ b/lib/Test/Simple/t/import.t @@ -1,4 +1,3 @@ -# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { chdir 't'; diff --git a/lib/Test/Simple/t/is_deeply_dne_bug.t b/lib/Test/Simple/t/is_deeply_dne_bug.t index 43cdce9786..f4578a6460 100644 --- a/lib/Test/Simple/t/is_deeply_dne_bug.t +++ b/lib/Test/Simple/t/is_deeply_dne_bug.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ # test for rt.cpan.org 20768 # diff --git a/lib/Test/Simple/t/is_deeply_fail.t b/lib/Test/Simple/t/is_deeply_fail.t index 5bcb070bf0..bd9b634233 100644 --- a/lib/Test/Simple/t/is_deeply_fail.t +++ b/lib/Test/Simple/t/is_deeply_fail.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { diff --git a/lib/Test/Simple/t/is_deeply_with_threads.t b/lib/Test/Simple/t/is_deeply_with_threads.t index 634bba30e9..9908ef6608 100644 --- a/lib/Test/Simple/t/is_deeply_with_threads.t +++ b/lib/Test/Simple/t/is_deeply_with_threads.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ # Test to see if is_deeply() plays well with threads. diff --git a/lib/Test/Simple/t/lib/Dummy.pm b/lib/Test/Simple/t/lib/Dummy.pm index e0cf30abc9..cdff79d540 100644 --- a/lib/Test/Simple/t/lib/Dummy.pm +++ b/lib/Test/Simple/t/lib/Dummy.pm @@ -1,6 +1,6 @@ package Dummy; -# $Id$ -$VERSION = '0.01'; +use strict; +our $VERSION = '0.01'; 1; diff --git a/lib/Test/Simple/t/lib/MyOverload.pm b/lib/Test/Simple/t/lib/MyOverload.pm index 6d78b93773..65f5ea5a7d 100644 --- a/lib/Test/Simple/t/lib/MyOverload.pm +++ b/lib/Test/Simple/t/lib/MyOverload.pm @@ -1,5 +1,6 @@ -package Overloaded; -# $Id$ +package Overloaded; ##no critic (Modules::RequireFilenameMatchesPackage) + +use strict; sub new { my $class = shift; @@ -7,8 +8,9 @@ sub new { } 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. @@ -17,8 +19,9 @@ use overload 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} }, diff --git a/lib/Test/Simple/t/lib/NoExporter.pm b/lib/Test/Simple/t/lib/NoExporter.pm index 314d59c4ab..6273e32d74 100644 --- a/lib/Test/Simple/t/lib/NoExporter.pm +++ b/lib/Test/Simple/t/lib/NoExporter.pm @@ -1,7 +1,7 @@ package NoExporter; -# $Id$ -$VERSION = 1.02; +use strict; +our $VERSION = 1.02; sub import { shift; diff --git a/lib/Test/Simple/t/lib/SigDie.pm b/lib/Test/Simple/t/lib/SigDie.pm index f954e2db78..0774728d4e 100644 --- a/lib/Test/Simple/t/lib/SigDie.pm +++ b/lib/Test/Simple/t/lib/SigDie.pm @@ -1,6 +1,8 @@ package SigDie; -use vars qw($DIE); +use strict; + +our $DIE; $SIG{__DIE__} = sub { $DIE = $@ }; 1; diff --git a/lib/Test/Simple/t/missing.t b/lib/Test/Simple/t/missing.t index 11f2443e75..3996b6de4b 100644 --- a/lib/Test/Simple/t/missing.t +++ b/lib/Test/Simple/t/missing.t @@ -1,4 +1,3 @@ -# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { chdir 't'; diff --git a/lib/Test/Simple/t/no_plan.t b/lib/Test/Simple/t/no_plan.t index 10e85abda9..5f392e40e1 100644 --- a/lib/Test/Simple/t/no_plan.t +++ b/lib/Test/Simple/t/no_plan.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { @@ -11,10 +10,9 @@ BEGIN { } } -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) }; @@ -24,16 +22,12 @@ is($@, "Got an undefined number of tests at $0 line 20.\n"); 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'; } diff --git a/lib/Test/Simple/t/no_tests.t b/lib/Test/Simple/t/no_tests.t index 9a0ace6856..eafa38cacc 100644 --- a/lib/Test/Simple/t/no_tests.t +++ b/lib/Test/Simple/t/no_tests.t @@ -1,5 +1,4 @@ #!perl -w -# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { diff --git a/lib/Test/Simple/t/note.t b/lib/Test/Simple/t/note.t index 56ce94241b..fb98fb4029 100644 --- a/lib/Test/Simple/t/note.t +++ b/lib/Test/Simple/t/note.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { @@ -14,23 +13,18 @@ BEGIN { 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'), ''; } diff --git a/lib/Test/Simple/t/overload.t b/lib/Test/Simple/t/overload.t index 1f1c9f8858..a86103746b 100644 --- a/lib/Test/Simple/t/overload.t +++ b/lib/Test/Simple/t/overload.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { @@ -12,15 +11,15 @@ BEGIN { } 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} } ; @@ -46,11 +45,11 @@ local $SIG{__DIE__} = sub { 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 ...'; @@ -74,3 +73,14 @@ Test::More->builder->is_eq ($obj, "foo"); {'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'; +} diff --git a/lib/Test/Simple/t/overload_threads.t b/lib/Test/Simple/t/overload_threads.t index bbd8e01c43..379e347bae 100644 --- a/lib/Test/Simple/t/overload_threads.t +++ b/lib/Test/Simple/t/overload_threads.t @@ -1,5 +1,4 @@ #!perl -w -# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { diff --git a/lib/Test/Simple/t/plan.t b/lib/Test/Simple/t/plan.t index 3a55521fa8..0d3ce89edb 100644 --- a/lib/Test/Simple/t/plan.t +++ b/lib/Test/Simple/t/plan.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { diff --git a/lib/Test/Simple/t/plan_bad.t b/lib/Test/Simple/t/plan_bad.t index d126e88216..179356dbc1 100644 --- a/lib/Test/Simple/t/plan_bad.t +++ b/lib/Test/Simple/t/plan_bad.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { diff --git a/lib/Test/Simple/t/plan_is_noplan.t b/lib/Test/Simple/t/plan_is_noplan.t index 3ac7574e52..1e696042ef 100644 --- a/lib/Test/Simple/t/plan_is_noplan.t +++ b/lib/Test/Simple/t/plan_is_noplan.t @@ -1,4 +1,5 @@ -# $Id$ +#!/usr/bin/perl -w + BEGIN { if( $ENV{PERL_CORE} ) { chdir 't'; @@ -9,47 +10,23 @@ BEGIN { } } -# 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; } + diff --git a/lib/Test/Simple/t/plan_no_plan.t b/lib/Test/Simple/t/plan_no_plan.t index fbe2408c4b..3111592e97 100644 --- a/lib/Test/Simple/t/plan_no_plan.t +++ b/lib/Test/Simple/t/plan_no_plan.t @@ -1,4 +1,3 @@ -# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { chdir 't'; diff --git a/lib/Test/Simple/t/plan_shouldnt_import.t b/lib/Test/Simple/t/plan_shouldnt_import.t index 9422613af0..b6eb064244 100644 --- a/lib/Test/Simple/t/plan_shouldnt_import.t +++ b/lib/Test/Simple/t/plan_shouldnt_import.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ # plan() used to export functions by mistake [rt.cpan.org 8385] diff --git a/lib/Test/Simple/t/plan_skip_all.t b/lib/Test/Simple/t/plan_skip_all.t index 13335a4927..528df5f50d 100644 --- a/lib/Test/Simple/t/plan_skip_all.t +++ b/lib/Test/Simple/t/plan_skip_all.t @@ -1,4 +1,3 @@ -# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { chdir 't'; diff --git a/lib/Test/Simple/t/require_ok.t b/lib/Test/Simple/t/require_ok.t index 8b1a943172..463a007599 100644 --- a/lib/Test/Simple/t/require_ok.t +++ b/lib/Test/Simple/t/require_ok.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { diff --git a/lib/Test/Simple/t/simple.t b/lib/Test/Simple/t/simple.t index 67bc6f3a1b..7297e9d6dd 100644 --- a/lib/Test/Simple/t/simple.t +++ b/lib/Test/Simple/t/simple.t @@ -1,4 +1,3 @@ -# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { chdir 't'; diff --git a/lib/Test/Simple/t/skip.t b/lib/Test/Simple/t/skip.t index a8a7cb9b33..f2ea9fbf20 100644 --- a/lib/Test/Simple/t/skip.t +++ b/lib/Test/Simple/t/skip.t @@ -1,5 +1,4 @@ #!perl -w -# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { @@ -95,5 +94,5 @@ SKIP: { 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/; } diff --git a/lib/Test/Simple/t/skipall.t b/lib/Test/Simple/t/skipall.t index 1bc170b2ea..5491be126e 100644 --- a/lib/Test/Simple/t/skipall.t +++ b/lib/Test/Simple/t/skipall.t @@ -1,4 +1,5 @@ -# $Id$ +#!/usr/bin/perl -w + BEGIN { if( $ENV{PERL_CORE} ) { chdir 't'; @@ -11,35 +12,22 @@ BEGIN { 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, ""); } diff --git a/lib/Test/Simple/t/tbm_doesnt_set_exported_to.t b/lib/Test/Simple/t/tbm_doesnt_set_exported_to.t index 231235e2f1..8bdd17753b 100644 --- a/lib/Test/Simple/t/tbm_doesnt_set_exported_to.t +++ b/lib/Test/Simple/t/tbm_doesnt_set_exported_to.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { diff --git a/lib/Test/Simple/t/thread_taint.t b/lib/Test/Simple/t/thread_taint.t index 98adc43e32..ef7b89daef 100644 --- a/lib/Test/Simple/t/thread_taint.t +++ b/lib/Test/Simple/t/thread_taint.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ use Test::More tests => 1; diff --git a/lib/Test/Simple/t/threads.t b/lib/Test/Simple/t/threads.t index 65b7bb360e..42ba8c269c 100644 --- a/lib/Test/Simple/t/threads.t +++ b/lib/Test/Simple/t/threads.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { diff --git a/lib/Test/Simple/t/todo.t b/lib/Test/Simple/t/todo.t index 259a661608..91861be3cb 100644 --- a/lib/Test/Simple/t/todo.t +++ b/lib/Test/Simple/t/todo.t @@ -1,5 +1,4 @@ #!perl -w -# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { @@ -43,7 +42,7 @@ TODO: { ok( 'this' eq 'that', 'ok' ); - like( 'this', '/that/', 'like' ); + like( 'this', qr/that/, 'like' ); is( 'this', 'that', 'is' ); isnt( 'this', 'this', 'isnt' ); diff --git a/lib/Test/Simple/t/undef.t b/lib/Test/Simple/t/undef.t index b7f1f2cd90..2e9201c3b4 100644 --- a/lib/Test/Simple/t/undef.t +++ b/lib/Test/Simple/t/undef.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { @@ -12,8 +11,7 @@ BEGIN { } use strict; -use Test::More tests => 20; -use TieOut; +use Test::More tests => 21; BEGIN { $^W = 1; } @@ -53,7 +51,7 @@ Test::More->builder->is_num(undef, undef, 'is_num()'); 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] ); @@ -80,17 +78,21 @@ warnings_like(qr/Use of uninitialized value.* at cmp_ok \[from $Filename line 64 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; +} diff --git a/lib/Test/Simple/t/use_ok.t b/lib/Test/Simple/t/use_ok.t index a53fe25fe4..4a62f3557e 100644 --- a/lib/Test/Simple/t/use_ok.t +++ b/lib/Test/Simple/t/use_ok.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { diff --git a/lib/Test/Simple/t/useing.t b/lib/Test/Simple/t/useing.t index 19dde01b26..c4ce507127 100644 --- a/lib/Test/Simple/t/useing.t +++ b/lib/Test/Simple/t/useing.t @@ -1,4 +1,3 @@ -# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { chdir 't'; diff --git a/lib/Test/Simple/t/utf8.t b/lib/Test/Simple/t/utf8.t index e45e47b37f..c7e93c3ac2 100644 --- a/lib/Test/Simple/t/utf8.t +++ b/lib/Test/Simple/t/utf8.t @@ -1,5 +1,4 @@ #!/usr/bin/perl -w -# $Id$ BEGIN { if( $ENV{PERL_CORE} ) { diff --git a/lib/Test/Simple/t/versions.t b/lib/Test/Simple/t/versions.t new file mode 100644 index 0000000000..e41e7ce3e0 --- /dev/null +++ b/lib/Test/Simple/t/versions.t @@ -0,0 +1,21 @@ +#!/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); diff --git a/lib/Test/Tutorial.pod b/lib/Test/Tutorial.pod index 8ae34448a5..b730918c75 100644 --- a/lib/Test/Tutorial.pod +++ b/lib/Test/Tutorial.pod @@ -1,4 +1,3 @@ -# $Id$ =head1 NAME Test::Tutorial - A tutorial about writing really basic tests |