update to Test::Simple 0.92
authorDavid Mitchell <davem@iabyn.com>
Mon, 6 Jul 2009 13:59:06 +0000 (14:59 +0100)
committerDavid Mitchell <davem@iabyn.com>
Tue, 7 Jul 2009 11:04:04 +0000 (12:04 +0100)
(cherry picked from commit 3e887aae38ef79132cc7112942154a36f73033f5)

118 files changed:
MANIFEST
Porting/Maintainers.pl
lib/Test/Builder.pm
lib/Test/Builder/Module.pm
lib/Test/Builder/Tester.pm
lib/Test/Builder/Tester/Color.pm
lib/Test/More.pm
lib/Test/Simple.pm
lib/Test/Simple/Changes
lib/Test/Simple/README
lib/Test/Simple/TODO
lib/Test/Simple/t/00test_harness_check.t
lib/Test/Simple/t/BEGIN_require_ok.t
lib/Test/Simple/t/BEGIN_use_ok.t
lib/Test/Simple/t/Builder/Builder.t
lib/Test/Simple/t/Builder/carp.t
lib/Test/Simple/t/Builder/create.t
lib/Test/Simple/t/Builder/current_test.t [moved from lib/Test/Simple/t/Builder/curr_test.t with 97% similarity]
lib/Test/Simple/t/Builder/current_test_without_plan.t [new file with mode: 0644]
lib/Test/Simple/t/Builder/details.t
lib/Test/Simple/t/Builder/done_testing.t [new file with mode: 0644]
lib/Test/Simple/t/Builder/done_testing_double.t [new file with mode: 0644]
lib/Test/Simple/t/Builder/done_testing_plan_mismatch.t [new file with mode: 0644]
lib/Test/Simple/t/Builder/done_testing_with_no_plan.t [new file with mode: 0644]
lib/Test/Simple/t/Builder/done_testing_with_number.t [new file with mode: 0644]
lib/Test/Simple/t/Builder/done_testing_with_plan.t [new file with mode: 0644]
lib/Test/Simple/t/Builder/fork_with_new_stdout.t [new file with mode: 0644]
lib/Test/Simple/t/Builder/has_plan.t
lib/Test/Simple/t/Builder/has_plan2.t
lib/Test/Simple/t/Builder/is_fh.t
lib/Test/Simple/t/Builder/maybe_regex.t
lib/Test/Simple/t/Builder/no_diag.t
lib/Test/Simple/t/Builder/no_ending.t
lib/Test/Simple/t/Builder/no_header.t
lib/Test/Simple/t/Builder/no_plan_at_all.t [new file with mode: 0644]
lib/Test/Simple/t/Builder/ok_obj.t
lib/Test/Simple/t/Builder/output.t
lib/Test/Simple/t/Builder/reset.t
lib/Test/Simple/t/Builder/try.t
lib/Test/Simple/t/More.t
lib/Test/Simple/t/Tester/tbt_01basic.t
lib/Test/Simple/t/Tester/tbt_02fhrestore.t
lib/Test/Simple/t/Tester/tbt_03die.t
lib/Test/Simple/t/Tester/tbt_04line_num.t
lib/Test/Simple/t/Tester/tbt_05faildiag.t
lib/Test/Simple/t/Tester/tbt_06errormess.t
lib/Test/Simple/t/Tester/tbt_07args.t
lib/Test/Simple/t/bad_plan.t
lib/Test/Simple/t/bail_out.t
lib/Test/Simple/t/buffer.t
lib/Test/Simple/t/circular_data.t
lib/Test/Simple/t/cmp_ok.t
lib/Test/Simple/t/diag.t
lib/Test/Simple/t/died.t
lib/Test/Simple/t/dont_overwrite_die_handler.t
lib/Test/Simple/t/eq_set.t
lib/Test/Simple/t/exit.t
lib/Test/Simple/t/explain.t
lib/Test/Simple/t/extra.t
lib/Test/Simple/t/extra_one.t
lib/Test/Simple/t/fail-like.t
lib/Test/Simple/t/fail-more.t
lib/Test/Simple/t/fail.t
lib/Test/Simple/t/fail_one.t
lib/Test/Simple/t/filehandles.t
lib/Test/Simple/t/fork.t
lib/Test/Simple/t/harness_active.t
lib/Test/Simple/t/import.t
lib/Test/Simple/t/is_deeply_dne_bug.t
lib/Test/Simple/t/is_deeply_fail.t
lib/Test/Simple/t/is_deeply_with_threads.t
lib/Test/Simple/t/lib/Dummy.pm
lib/Test/Simple/t/lib/MyOverload.pm
lib/Test/Simple/t/lib/NoExporter.pm
lib/Test/Simple/t/lib/SigDie.pm
lib/Test/Simple/t/missing.t
lib/Test/Simple/t/no_plan.t
lib/Test/Simple/t/no_tests.t
lib/Test/Simple/t/note.t
lib/Test/Simple/t/overload.t
lib/Test/Simple/t/overload_threads.t
lib/Test/Simple/t/plan.t
lib/Test/Simple/t/plan_bad.t
lib/Test/Simple/t/plan_is_noplan.t
lib/Test/Simple/t/plan_no_plan.t
lib/Test/Simple/t/plan_shouldnt_import.t
lib/Test/Simple/t/plan_skip_all.t
lib/Test/Simple/t/require_ok.t
lib/Test/Simple/t/simple.t
lib/Test/Simple/t/skip.t
lib/Test/Simple/t/skipall.t
lib/Test/Simple/t/tbm_doesnt_set_exported_to.t
lib/Test/Simple/t/thread_taint.t
lib/Test/Simple/t/threads.t
lib/Test/Simple/t/todo.t
lib/Test/Simple/t/undef.t
lib/Test/Simple/t/use_ok.t
lib/Test/Simple/t/useing.t
lib/Test/Simple/t/utf8.t
lib/Test/Simple/t/versions.t [new file with mode: 0644]
lib/Test/Tutorial.pod
t/lib/Dev/Null.pm
t/lib/Test/Builder/NoOutput.pm [new file with mode: 0644]
t/lib/Test/Simple/Catch.pm
t/lib/Test/Simple/sample_tests/death.plx
t/lib/Test/Simple/sample_tests/death_in_eval.plx
t/lib/Test/Simple/sample_tests/death_with_handler.plx
t/lib/Test/Simple/sample_tests/exit.plx
t/lib/Test/Simple/sample_tests/extras.plx
t/lib/Test/Simple/sample_tests/five_fail.plx
t/lib/Test/Simple/sample_tests/last_minute_death.plx
t/lib/Test/Simple/sample_tests/one_fail.plx
t/lib/Test/Simple/sample_tests/pre_plan_death.plx
t/lib/Test/Simple/sample_tests/require.plx
t/lib/Test/Simple/sample_tests/success.plx
t/lib/Test/Simple/sample_tests/too_few.plx
t/lib/Test/Simple/sample_tests/too_few_fail.plx
t/lib/Test/Simple/sample_tests/two_fail.plx

index 65e690f..72cfc69 100755 (executable)
--- a/MANIFEST
+++ b/MANIFEST
@@ -3112,8 +3112,16 @@ lib/Test/Simple/t/buffer.t       Test::Builder buffering test
 lib/Test/Simple/t/Builder/Builder.t    Test::Builder tests
 lib/Test/Simple/t/Builder/carp.t       Test::Builder test
 lib/Test/Simple/t/Builder/create.t     Test::Builder test 
-lib/Test/Simple/t/Builder/curr_test.t  Test::Builder->curr_test tests
+lib/Test/Simple/t/Builder/current_test.t       Test::Builder tests
+lib/Test/Simple/t/Builder/current_test_without_plan.t  Test::Builder tests
 lib/Test/Simple/t/Builder/details.t    Test::Builder tests
+lib/Test/Simple/t/Builder/done_testing_double.t        Test::Builder tests
+lib/Test/Simple/t/Builder/done_testing_plan_mismatch.t Test::Builder tests
+lib/Test/Simple/t/Builder/done_testing.t               Test::Builder tests
+lib/Test/Simple/t/Builder/done_testing_with_no_plan.t  Test::Builder tests
+lib/Test/Simple/t/Builder/done_testing_with_number.t   Test::Builder tests
+lib/Test/Simple/t/Builder/done_testing_with_plan.t     Test::Builder tests
+lib/Test/Simple/t/Builder/fork_with_new_stdout.t       Test::Builder tests
 lib/Test/Simple/t/Builder/has_plan2.t  Test::Builder tests
 lib/Test/Simple/t/Builder/has_plan.t   Test::Builder tests
 lib/Test/Simple/t/Builder/is_fh.t      Test::Builder tests
@@ -3121,6 +3129,7 @@ lib/Test/Simple/t/Builder/maybe_regex.t   Test::Builder tests
 lib/Test/Simple/t/Builder/no_diag.t    Test::Builder tests
 lib/Test/Simple/t/Builder/no_ending.t  Test::Builder tests
 lib/Test/Simple/t/Builder/no_header.t  Test::Builder tests
+lib/Test/Simple/t/Builder/no_plan_at_all.t     Test::Builder tests
 lib/Test/Simple/t/Builder/ok_obj.t     Test::Builder tests
 lib/Test/Simple/t/Builder/output.t     Test::Builder tests
 lib/Test/Simple/t/Builder/reset.t      Test::Builder tests
@@ -3185,6 +3194,7 @@ lib/Test/Simple/t/undef.t Test::More test, undefs don't cause warnings
 lib/Test/Simple/t/useing.t     Test::More test, compile test
 lib/Test/Simple/t/use_ok.t     Test::More test, use_ok()
 lib/Test/Simple/t/utf8.t       Test::More test
+lib/Test/Simple/t/versions.t   Test::More test
 lib/Test/t/05_about_verbose.t  See if Test works
 lib/Test/t/fail.t              See if Test works
 lib/Test/t/mix.t               See if Test works
@@ -4036,6 +4046,7 @@ t/lib/Sans_mypragma.pm                    Test module for t/lib/mypragma.t
 t/lib/strict/refs              Tests of "use strict 'refs'" for strict.t
 t/lib/strict/subs              Tests of "use strict 'subs'" for strict.t
 t/lib/strict/vars              Tests of "use strict 'vars'" for strict.t
+t/lib/Test/Builder/NoOutput.pm Utility module for testing Test::Builder
 t/lib/Test/Simple/Catch.pm     Utility module for testing Test::Simple
 t/lib/Test/Simple/sample_tests/death_in_eval.plx       for exit.t
 t/lib/Test/Simple/sample_tests/death.plx               for exit.t
index 5529340..0c423db 100755 (executable)
@@ -1719,40 +1719,25 @@ package Maintainers;
     'Test::Simple' =>
        {
        'MAINTAINER'    => 'mschwern',
-       'DISTRIBUTION'  => 'MSCHWERN/Test-Simple-0.86.tar.gz',
+       'DISTRIBUTION'  => 'MSCHWERN/Test-Simple-0.92.tar.gz',
        'FILES'         => q[lib/Test/Simple.pm
                             lib/Test/Simple
                             lib/Test/Builder.pm
                             lib/Test/Builder
                             lib/Test/More.pm
                             lib/Test/Tutorial.pod
-                            t/lib/Test/Simple
+                            t/lib/Test/
                             t/lib/Dev/Null.pm
                            ],
        'EXCLUDED'      => [
                             # NB - TieOut.pm comes with more than one
                             # distro. We use the MM one
-                            # XXX should all these actually be excluded
-                            # from blead ???? - DAPM
                             qw{.perlcriticrc
                                .perltidyrc
                                t/pod.t
                                t/pod-coverage.t
-                               t/versions.t
-                               t/Builder/current_test.t
-                               t/Builder/current_test_without_plan.t
-                               t/Builder/done_testing.t
-                               t/Builder/done_testing_double.t
-                               t/Builder/done_testing_plan_mismatch.t
-                               t/Builder/done_testing_with_no_plan.t
-                               t/Builder/done_testing_with_number.t
-                               t/Builder/done_testing_with_plan.t
-                               t/Builder/fork_with_new_stdout.t
-                               t/Builder/no_plan_at_all.t
-                               t/Builder/reset_outputs.t
 
                                lib/Test/Builder/IO/Scalar.pm
-                               t/lib/Test/Builder/NoOutput.pm
 
                                t/lib/TieOut.pm
                               }
index 87f23f2..cd5779f 100644 (file)
@@ -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>
index 166b9da..a2d8e5b 100644 (file)
@@ -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 {
index d0bfc3f..c019635 100644 (file)
@@ -1,5 +1,4 @@
 package Test::Builder::Tester;
-# $Id$
 
 use strict;
 our $VERSION = "1.18";
index d333b2f..264fddb 100644 (file)
@@ -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
index 875e40a..aaf6d87 100644 (file)
@@ -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>.
index cef0411..48c72e2 100644 (file)
@@ -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;
index 09a5662..0c955f2 100644 (file)
@@ -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
 
index 114aa26..5f825bd 100644 (file)
@@ -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/
index a490688..c596e90 100644 (file)
@@ -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.
 
index 0504be3..3ff4a13 100644 (file)
@@ -1,5 +1,4 @@
 #!/usr/bin/perl -w
-# $Id$
 
 # A test to make sure the new Test::Harness was installed properly.
 
index c3e4cca..733d0bb 100644 (file)
@@ -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);
index aa428d5..476badf 100644 (file)
@@ -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);
+
index ce53097..a5bfd15 100644 (file)
@@ -1,5 +1,4 @@
 #!/usr/bin/perl -w
-# $Id$
 
 BEGIN {
     if( $ENV{PERL_CORE} ) {
index fb7208a..e89eeeb 100644 (file)
@@ -1,5 +1,4 @@
 #!/usr/bin/perl
-# $Id$
 
 BEGIN {
     if( $ENV{PERL_CORE} ) {
index d66ee06..d584b30 100644 (file)
@@ -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");
similarity index 97%
rename from lib/Test/Simple/t/Builder/curr_test.t
rename to lib/Test/Simple/t/Builder/current_test.t
index ec54980..edd201c 100644 (file)
@@ -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 (file)
index 0000000..31f9589
--- /dev/null
@@ -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);
index 82f74c2..05d4828 100644 (file)
@@ -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 (file)
index 0000000..14a8f91
--- /dev/null
@@ -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 (file)
index 0000000..d696384
--- /dev/null
@@ -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 (file)
index 0000000..b815437
--- /dev/null
@@ -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 (file)
index 0000000..ff5f40c
--- /dev/null
@@ -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 (file)
index 0000000..c21458f
--- /dev/null
@@ -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 (file)
index 0000000..c0a3d0f
--- /dev/null
@@ -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 (file)
index 0000000..e38c1d0
--- /dev/null
@@ -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
index 4eecbd0..d0be86a 100644 (file)
@@ -1,5 +1,4 @@
 #!/usr/bin/perl -w
-# $Id$
 
 BEGIN {
     if( $ENV{PERL_CORE} ) {
index c4aca0f..e13ea4a 100644 (file)
@@ -1,5 +1,4 @@
 #!/usr/bin/perl -w
-# $Id$
 
 BEGIN {
     if( $ENV{PERL_CORE} ) {
index a492f01..0eb3ec0 100644 (file)
@@ -1,5 +1,4 @@
 #!/usr/bin/perl -w
-# $Id$
 
 BEGIN {
     if( $ENV{PERL_CORE} ) {
index c352c82..d1927a5 100644 (file)
@@ -1,5 +1,4 @@
 #!/usr/bin/perl -w
-# $Id$
 
 BEGIN {
     if( $ENV{PERL_CORE} ) {
index f861984..6fa538a 100644 (file)
@@ -1,5 +1,4 @@
 #!/usr/bin/perl -w
-# $Id$
 
 use Test::More 'no_diag', tests => 2;
 
index a12bec5..93e6bec 100644 (file)
@@ -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 (file)
index 0000000..3909cfe
--- /dev/null
@@ -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
index f5af1f1..8678dbf 100644 (file)
@@ -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.
index d49d02a..77e0e0b 100644 (file)
@@ -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
+}
index e655725..6bff7fc 100644 (file)
@@ -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);
index fd61ddd..eeb3bcb 100644 (file)
@@ -1,5 +1,4 @@
 #!perl -w
-# $Id$
 
 BEGIN {
     if( $ENV{PERL_CORE} ) {
index 73d71d8..21958cf 100644 (file)
@@ -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 
index f40ab5e..769a1c4 100644 (file)
@@ -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");
index b6ef7e0..e373571 100644 (file)
@@ -1,5 +1,4 @@
 #!/usr/bin/perl
-# $Id$
 
 use Test::Builder::Tester tests => 4;
 use Test::More;
index 8c7d30a..b9dba80 100644 (file)
@@ -1,5 +1,4 @@
 #!/usr/bin/perl
-# $Id$
 
 use Test::Builder::Tester tests => 1;
 use Test::More;
index f18ed01..9e8365a 100644 (file)
@@ -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");
index def6735..59ad721 100644 (file)
@@ -1,5 +1,4 @@
 #!/usr/bin/perl
-# $Id$
 
 use Test::Builder::Tester tests => 5;
 use Test::More;
index c4e6632..d8d8a0f 100644 (file)
@@ -1,5 +1,4 @@
 #!/usr/bin/perl -w
-# $Id$
 
 use Test::More tests => 8;
 use Symbol;
index 8d104b7..1b9393b 100644 (file)
@@ -1,5 +1,4 @@
 #!/usr/bin/perl -w
-# $Id$
 
 use Test::More tests => 18;
 use Symbol;
index 1d4e50d..80e0e65 100644 (file)
@@ -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 "# $@";
-
index 58bcf47..5cdc1f9 100644 (file)
@@ -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
index 04e92b9..6039e4a 100644 (file)
@@ -1,5 +1,4 @@
 #!/usr/bin/perl
-# $Id$
 
 BEGIN {
     if( $ENV{PERL_CORE} ) {
index ce23e0b..2fd819e 100644 (file)
@@ -1,5 +1,4 @@
 #!/usr/bin/perl -w
-# $Id$
 
 # Test is_deeply and friends with circular data structures [rt.cpan.org 7289]
 
index 031940e..de1a7e6 100644 (file)
@@ -1,5 +1,4 @@
 #!/usr/bin/perl -w
-# $Id$
 
 BEGIN {
     if( $ENV{PERL_CORE} ) {
index 91ef58f..f5cb437 100644 (file)
@@ -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
+}
index 2a40d01..b4ee2fb 100644 (file)
@@ -1,5 +1,4 @@
 #!perl -w
-# $Id$
 
 BEGIN {
     if( $ENV{PERL_CORE} ) {
index 03609a8..0657a06 100644 (file)
@@ -1,5 +1,4 @@
 #!/usr/bin/perl -w
-# $Id$
 
 BEGIN {
     if( $ENV{PERL_CORE} ) {
index b090373..fbdc52d 100644 (file)
@@ -1,5 +1,4 @@
 #!perl -w
-# $Id$
 
 BEGIN {
     if( $ENV{PERL_CORE} ) {
index 6c6945c..96f3a7e 100644 (file)
@@ -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;
index 6b67b6c..cf2f550 100644 (file)
@@ -1,5 +1,4 @@
 #!/usr/bin/perl -w
-# $Id$
 
 BEGIN {
     if( $ENV{PERL_CORE} ) {
index 778284d..57235be 100644 (file)
@@ -1,5 +1,4 @@
 #!perl -w
-# $Id$
 
 BEGIN {
     if( $ENV{PERL_CORE} ) {
index 90ba9ab..d77404e 100644 (file)
@@ -1,5 +1,4 @@
 #!/usr/bin/perl -w
-# $Id$
 
 BEGIN {
     if( $ENV{PERL_CORE} ) {
index d1a51d4..0ea5fab 100644 (file)
@@ -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
 
index 4e515c5..423e216 100644 (file)
@@ -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
 
index fd272d1..ccf0c74 100644 (file)
@@ -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);
 }
index 53de454..61d7c08 100644 (file)
@@ -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);
 }
index 1e20470..f7dad5d 100644 (file)
@@ -1,5 +1,4 @@
 #!perl -w
-# $Id$
 
 BEGIN {
     if( $ENV{PERL_CORE} ) {
index cda5bde..55d7aec 100644 (file)
@@ -1,5 +1,4 @@
 #!/usr/bin/perl -w
-# $Id$
 
 BEGIN {
     if( $ENV{PERL_CORE} ) {
index 150c826..7b027a7 100644 (file)
@@ -1,5 +1,4 @@
 #!perl -w
-# $Id$
 
 BEGIN {
     if( $ENV{PERL_CORE} ) {
index fd2aef4..68a3613 100644 (file)
@@ -1,4 +1,3 @@
-# $Id$
 BEGIN {
     if( $ENV{PERL_CORE} ) {
         chdir 't';
index 43cdce9..f4578a6 100644 (file)
@@ -1,5 +1,4 @@
 #!/usr/bin/perl -w
-# $Id$
 
 # test for rt.cpan.org 20768
 #
index 5bcb070..bd9b634 100644 (file)
@@ -1,5 +1,4 @@
 #!/usr/bin/perl -w
-# $Id$
 
 BEGIN {
     if( $ENV{PERL_CORE} ) {
index 634bba3..9908ef6 100644 (file)
@@ -1,5 +1,4 @@
 #!/usr/bin/perl -w
-# $Id$
 
 # Test to see if is_deeply() plays well with threads.
 
index e0cf30a..cdff79d 100644 (file)
@@ -1,6 +1,6 @@
 package Dummy;
-# $Id$
 
-$VERSION = '0.01';
+use strict;
+our $VERSION = '0.01';
 
 1;
index 6d78b93..65f5ea5 100644 (file)
@@ -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} },
index 314d59c..6273e32 100644 (file)
@@ -1,7 +1,7 @@
 package NoExporter;
-# $Id$
 
-$VERSION = 1.02;
+use strict;
+our $VERSION = 1.02;
 
 sub import {
     shift;
index f954e2d..0774728 100644 (file)
@@ -1,6 +1,8 @@
 package SigDie;
 
-use vars qw($DIE);
+use strict;
+
+our $DIE;
 $SIG{__DIE__} = sub { $DIE = $@ };
 
 1;
index 11f2443..3996b6d 100644 (file)
@@ -1,4 +1,3 @@
-# $Id$
 BEGIN {
     if( $ENV{PERL_CORE} ) {
         chdir 't';
index 10e85ab..5f392e4 100644 (file)
@@ -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';
 }
index 9a0ace6..eafa38c 100644 (file)
@@ -1,5 +1,4 @@
 #!perl -w
-# $Id$
 
 BEGIN {
     if( $ENV{PERL_CORE} ) {
index 56ce942..fb98fb4 100644 (file)
@@ -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'), '';
 }
 
index 1f1c9f8..a861037 100644 (file)
@@ -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';
+}
index bbd8e01..379e347 100644 (file)
@@ -1,5 +1,4 @@
 #!perl -w
-# $Id$
 
 BEGIN {
     if( $ENV{PERL_CORE} ) {
index 3a55521..0d3ce89 100644 (file)
@@ -1,5 +1,4 @@
 #!/usr/bin/perl -w
-# $Id$
 
 BEGIN {
     if( $ENV{PERL_CORE} ) {
index d126e88..179356d 100644 (file)
@@ -1,5 +1,4 @@
 #!/usr/bin/perl -w
-# $Id$
 
 BEGIN {
     if( $ENV{PERL_CORE} ) {
index 3ac7574..1e69604 100644 (file)
@@ -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;
 }
+
index fbe2408..3111592 100644 (file)
@@ -1,4 +1,3 @@
-# $Id$
 BEGIN {
     if( $ENV{PERL_CORE} ) {
         chdir 't';
index 9422613..b6eb064 100644 (file)
@@ -1,5 +1,4 @@
 #!/usr/bin/perl -w
-# $Id$
 
 # plan() used to export functions by mistake [rt.cpan.org 8385]
 
index 13335a4..528df5f 100644 (file)
@@ -1,4 +1,3 @@
-# $Id$
 BEGIN {
     if( $ENV{PERL_CORE} ) {
         chdir 't';
index 8b1a943..463a007 100644 (file)
@@ -1,5 +1,4 @@
 #!/usr/bin/perl -w
-# $Id$
 
 BEGIN {
     if( $ENV{PERL_CORE} ) {
index 67bc6f3..7297e9d 100644 (file)
@@ -1,4 +1,3 @@
-# $Id$
 BEGIN {
     if( $ENV{PERL_CORE} ) {
         chdir 't';
index a8a7cb9..f2ea9fb 100644 (file)
@@ -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/;
 }
index 1bc170b..5491be1 100644 (file)
@@ -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, "");
 }
index 231235e..8bdd177 100644 (file)
@@ -1,5 +1,4 @@
 #!/usr/bin/perl -w
-# $Id$
 
 BEGIN {
     if( $ENV{PERL_CORE} ) {
index 98adc43..ef7b89d 100644 (file)
@@ -1,5 +1,4 @@
 #!/usr/bin/perl -w
-# $Id$
 
 use Test::More tests => 1;
 
index 65b7bb3..42ba8c2 100644 (file)
@@ -1,5 +1,4 @@
 #!/usr/bin/perl -w
-# $Id$
 
 BEGIN {
     if( $ENV{PERL_CORE} ) {
index 259a661..91861be 100644 (file)
@@ -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' );
 
index b7f1f2c..2e9201c 100644 (file)
@@ -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;
+}
index a53fe25..4a62f35 100644 (file)
@@ -1,5 +1,4 @@
 #!/usr/bin/perl -w
-# $Id$
 
 BEGIN {
     if( $ENV{PERL_CORE} ) {
index 19dde01..c4ce507 100644 (file)
@@ -1,4 +1,3 @@
-# $Id$
 BEGIN {
     if( $ENV{PERL_CORE} ) {
         chdir 't';
index e45e47b..c7e93c3 100644 (file)
@@ -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 (file)
index 0000000..e41e7ce
--- /dev/null
@@ -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);
index 8ae3444..b730918 100644 (file)
@@ -1,4 +1,3 @@
-# $Id$
 =head1 NAME
 
 Test::Tutorial - A tutorial about writing really basic tests
index 9d2ae12..24ec07a 100644 (file)
@@ -1,7 +1,8 @@
 package Dev::Null;
-# $Id$
 
-sub TIEHANDLE { bless {} }
+use strict;
+
+sub TIEHANDLE { bless {}, shift }
 sub PRINT { 1 }
 
 1;
diff --git a/t/lib/Test/Builder/NoOutput.pm b/t/lib/Test/Builder/NoOutput.pm
new file mode 100644 (file)
index 0000000..d83db9f
--- /dev/null
@@ -0,0 +1,122 @@
+package Test::Builder::NoOutput;
+
+use strict;
+use warnings;
+
+use base qw(Test::Builder);
+
+
+=head1 NAME
+
+Test::Builder::NoOutput - A subclass of Test::Builder which prints nothing
+
+=head1 SYNOPSIS
+
+    use Test::Builder::NoOutput;
+
+    my $tb = Test::Builder::NoOutput->new;
+
+    ...test as normal...
+
+    my $output = $tb->read;
+
+=head1 DESCRIPTION
+
+This is a subclass of Test::Builder which traps all its output.
+It is mostly useful for testing Test::Builder.
+
+=head3 read
+
+    my $all_output = $tb->read;
+    my $output     = $tb->read($stream);
+
+Returns all the output (including failure and todo output) collected
+so far.  It is destructive, each call to read clears the output
+buffer.
+
+If $stream is given it will return just the output from that stream.
+$stream's are...
+
+    out         output()
+    err         failure_output()
+    todo        todo_output()
+    all         all outputs
+
+Defaults to 'all'.
+
+=cut
+
+my $Test = __PACKAGE__->new;
+
+sub create {
+    my $class = shift;
+    my $self = $class->SUPER::create(@_);
+
+    my %outputs = (
+        all  => '',
+        out  => '',
+        err  => '',
+        todo => '',
+    );
+    $self->{_outputs} = \%outputs;
+
+    tie *OUT,  "Test::Builder::NoOutput::Tee", \$outputs{all}, \$outputs{out};
+    tie *ERR,  "Test::Builder::NoOutput::Tee", \$outputs{all}, \$outputs{err};
+    tie *TODO, "Test::Builder::NoOutput::Tee", \$outputs{all}, \$outputs{todo};
+
+    $self->output(*OUT);
+    $self->failure_output(*ERR);
+    $self->todo_output(*TODO);
+
+    return $self;
+}
+
+sub read {
+    my $self = shift;
+    my $stream = @_ ? shift : 'all';
+
+    my $out = $self->{_outputs}{$stream};
+
+    $self->{_outputs}{$stream} = '';
+
+    # Clear all the streams if 'all' is read.
+    if( $stream eq 'all' ) {
+        my @keys = keys %{$self->{_outputs}};
+        $self->{_outputs}{$_} = '' for @keys;
+    }
+
+    return $out;
+}
+
+
+package Test::Builder::NoOutput::Tee;
+
+# A cheap implementation of IO::Tee.
+
+sub TIEHANDLE {
+    my($class, @refs) = @_;
+
+    my @fhs;
+    for my $ref (@refs) {
+        my $fh = Test::Builder->_new_fh($ref);
+        push @fhs, $fh;
+    }
+
+    my $self = [@fhs];
+    return bless $self, $class;
+}
+
+sub PRINT {
+    my $self = shift;
+
+    print $_ @_ for @$self;
+}
+
+sub PRINTF {
+    my $self   = shift;
+    my $format = shift;
+
+    printf $_ @_ for @$self;
+}
+
+1;
index 6f60493..9a2efb1 100644 (file)
@@ -1,7 +1,8 @@
 # For testing Test::Simple;
-# $Id$
 package Test::Simple::Catch;
 
+use strict;
+
 use Symbol;
 use TieOut;
 my( $out_fh, $err_fh ) = ( gensym, gensym );
index 14ec3d6..e682ec0 100644 (file)
@@ -1,5 +1,4 @@
 require Test::Simple;
-# $Id$
 
 push @INC, 't/lib';
 require Test::Simple::Catch;
index d2e9e99..c9c8952 100644 (file)
@@ -1,5 +1,4 @@
 require Test::Simple;
-# $Id$
 
 push @INC, 't/lib';
 require Test::Simple::Catch;
index 6110cb6..c058e1f 100644 (file)
@@ -1,5 +1,4 @@
 require Test::Simple;
-# $Id$
 
 use lib 't/lib';
 require Test::Simple::Catch;
index 80aba31..99c7202 100644 (file)
@@ -1,5 +1,4 @@
 require Test::Simple;
-# $Id$
 
 push @INC, 't/lib';
 require Test::Simple::Catch;
index e947736..f72d3b6 100644 (file)
@@ -1,5 +1,4 @@
 # ID 20020716.013, the exit code would become 0 if the test died
-# $Id$
 # before a plan.
 
 require Test::Simple;
index 99c2d9b..585d6c3 100644 (file)
@@ -1,5 +1,4 @@
 require Test::Simple;
-# $Id$
 
 push @INC, 't/lib';
 require Test::Simple::Catch;
index 003b07d..bbc630d 100644 (file)
@@ -1,5 +1,4 @@
 require Test::Simple;
-# $Id$
 
 push @INC, 't/lib';
 require Test::Simple::Catch;
index 6b2bbf8..9ca4517 100644 (file)
@@ -1,5 +1,4 @@
 require Test::Simple;
-# $Id$
 
 push @INC, 't/lib';
 require Test::Simple::Catch;
index d4d6c37..e3d9229 100644 (file)
@@ -1,5 +1,4 @@
 require Test::Simple;
-# $Id$
 
 push @INC, 't/lib';
 require Test::Simple::Catch;