update Test::Simple to version 0.86

tested in multiple builds on multiple arches by me
ok millert@, simon@

62 files changed, 5547 insertions, 1171 deletions

diff --git a/gnu/usr.bin/perl/lib/Test/Builder.pm b/gnu/usr.bin/perl/lib/Test/Builder.pm
index 06543e696ea..2a136830b5a 100644
--- a/gnu/usr.bin/perl/lib/Test/Builder.pm
+++ b/gnu/usr.bin/perl/lib/Test/Builder.pm
@@ -1,42 +1,66 @@
 package Test::Builder;
 
-use 5.004;
-
-# $^C was only introduced in 5.005-ish.  We do this to prevent
-# use of uninitialized value warnings in older perls.
-$^C ||= 0;
-
+use 5.006;
 use strict;
-use vars qw($VERSION $CLASS);
-$VERSION = '0.15';
-$CLASS = __PACKAGE__;
-
-my $IsVMS = $^O eq 'VMS';
+use warnings;
 
-use vars qw($Level);
-my @Test_Results = ();
-my @Test_Details = ();
-my($Test_Died) = 0;
-my($Have_Plan) = 0;
-my $Curr_Test = 0;
+our $VERSION = '0.86';
+$VERSION = eval $VERSION;    ## no critic (BuiltinFunctions::ProhibitStringyEval)
 
 # Make Test::Builder thread-safe for ithreads.
 BEGIN {
     use Config;
-    if( $] >= 5.008 && $Config{useithreads} ) {
-        require threads;
+    # Load threads::shared when threads are turned on.
+    # 5.8.0's threads are so busted we no longer support them.
+    if( $] >= 5.008001 && $Config{useithreads} && $INC{'threads.pm'} ) {
         require threads::shared;
-        threads::shared->import;
-        share(\$Curr_Test);
-        share(\@Test_Details);
-        share(\@Test_Results);
+
+        # Hack around YET ANOTHER threads::shared bug.  It would
+        # occassionally forget the contents of the variable when sharing it.
+        # So we first copy the data, then share, then put our copy back.
+        *share = sub (\[$@%]) {
+            my $type = ref $_[0];
+            my $data;
+
+            if( $type eq 'HASH' ) {
+                %$data = %{ $_[0] };
+            }
+            elsif( $type eq 'ARRAY' ) {
+                @$data = @{ $_[0] };
+            }
+            elsif( $type eq 'SCALAR' ) {
+                $$data = ${ $_[0] };
+            }
+            else {
+                die( "Unknown type: " . $type );
+            }
+
+            $_[0] = &threads::shared::share( $_[0] );
+
+            if( $type eq 'HASH' ) {
+                %{ $_[0] } = %$data;
+            }
+            elsif( $type eq 'ARRAY' ) {
+                @{ $_[0] } = @$data;
+            }
+            elsif( $type eq 'SCALAR' ) {
+                ${ $_[0] } = $$data;
+            }
+            else {
+                die( "Unknown type: " . $type );
+            }
+
+            return $_[0];
+        };
     }
+    # 5.8.0's threads::shared is busted when threads are off
+    # and earlier Perls just don't have that module at all.
     else {
-        *lock = sub { 0 };
+        *share = sub { return $_[0] };
+        *lock  = sub { 0 };
     }
 }
 
-
 =head1 NAME
 
 Test::Builder - Backend for building test libraries
@@ -44,28 +68,15 @@ Test::Builder - Backend for building test libraries
 =head1 SYNOPSIS
 
   package My::Test::Module;
-  use Test::Builder;
-  require Exporter;
-  @ISA = qw(Exporter);
-  @EXPORT = qw(ok);
+  use base 'Test::Builder::Module';
 
-  my $Test = Test::Builder->new;
-  $Test->output('my_logfile');
-
-  sub import {
-      my($self) = shift;
-      my $pack = caller;
-
-      $Test->exported_to($pack);
-      $Test->plan(@_);
-
-      $self->export_to_level(1, $self, 'ok');
-  }
+  my $CLASS = __PACKAGE__;
 
   sub ok {
       my($test, $name) = @_;
+      my $tb = $CLASS->builder;
 
-      $Test->ok($test, $name);
+      $tb->ok($test, $name);
   }
 
 
@@ -87,48 +98,103 @@ work together>.
 Returns a Test::Builder object representing the current state of the
 test.
 
-Since you only run one test per program, there is B<one and only one>
+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
-getting the same object.  (This is called a singleton).
+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.
+
+If you want a completely new Test::Builder object different from the
+singleton, use C<create>.
 
 =cut
 
-my $Test;
+my $Test = Test::Builder->new;
+
 sub new {
     my($class) = shift;
-    $Test ||= bless ['Move along, nothing to see here'], $class;
+    $Test ||= $class->create;
     return $Test;
 }
 
-=back
+=item B<create>
 
-=head2 Setting up tests
+  my $Test = Test::Builder->create;
 
-These methods are for setting up tests and declaring how many there
-are.  You usually only want to call one of these methods.
+Ok, so there can be more than one Test::Builder object and this is how
+you get it.  You might use this instead of C<new()> if you're testing
+a Test::Builder based module, but otherwise you probably want C<new>.
 
-=over 4
+B<NOTE>: the implementation is not complete.  C<level>, for example, is
+still shared amongst B<all> Test::Builder objects, even ones created using
+this method.  Also, the method name may change in the future.
 
-=item B<exported_to>
+=cut
 
-  my $pack = $Test->exported_to;
-  $Test->exported_to($pack);
+sub create {
+    my $class = shift;
 
-Tells Test::Builder what package you exported your functions to.
-This is important for getting TODO tests right.
+    my $self = bless {}, $class;
+    $self->reset;
+
+    return $self;
+}
+
+=item B<reset>
+
+  $Test->reset;
+
+Reinitializes the Test::Builder singleton to its original state.
+Mostly useful for tests run in persistent environments where the same
+test might be run multiple times in the same process.
 
 =cut
 
-my $Exported_To;
-sub exported_to {
-    my($self, $pack) = @_;
+our $Level;
 
-    if( defined $pack ) {
-        $Exported_To = $pack;
-    }
-    return $Exported_To;
+sub reset {    ## no critic (Subroutines::ProhibitBuiltinHomonyms)
+    my($self) = @_;
+
+    # We leave this a global because it has to be localized and localizing
+    # hash keys is just asking for pain.  Also, it was documented.
+    $Level = 1;
+
+    $self->{Have_Plan}    = 0;
+    $self->{No_Plan}      = 0;
+    $self->{Original_Pid} = $$;
+
+    share( $self->{Curr_Test} );
+    $self->{Curr_Test} = 0;
+    $self->{Test_Results} = &share( [] );
+
+    $self->{Exported_To}    = undef;
+    $self->{Expected_Tests} = 0;
+
+    $self->{Skip_All} = 0;
+
+    $self->{Use_Nums} = 1;
+
+    $self->{No_Header} = 0;
+    $self->{No_Ending} = 0;
+
+    $self->{Todo}       = undef;
+    $self->{Todo_Stack} = [];
+    $self->{Start_Todo} = 0;
+
+    $self->_dup_stdhandles;
+
+    return;
 }
 
+=back
+
+=head2 Setting up tests
+
+These methods are for setting up tests and declaring how many there
+are.  You usually only want to call one of these methods.
+
+=over 4
+
 =item B<plan>
 
   $Test->plan('no_plan');
@@ -143,37 +209,37 @@ If you call plan(), don't call any of the other methods below.
 =cut
 
 sub plan {
-    my($self, $cmd, $arg) = @_;
+    my( $self, $cmd, $arg ) = @_;
 
     return unless $cmd;
 
-    if( $Have_Plan ) {
-        die sprintf "You tried to plan twice!  Second plan at %s line %d\n",
-          ($self->caller)[1,2];
-    }
+    local $Level = $Level + 1;
+
+    $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 ) {
+        if($arg) {
+            local $Level = $Level + 1;
             return $self->expected_tests($arg);
         }
         elsif( !defined $arg ) {
-            die "Got an undefined number of tests.  Looks like you tried to ".
-                "say how many tests you plan to run but made a mistake.\n";
+            $self->croak("Got an undefined number of tests");
         }
-        elsif( !$arg ) {
-            die "You said to run 0 tests!  You've got to run something.\n";
+        else {
+            $self->croak("You said to run 0 tests");
         }
     }
     else {
-        require Carp;
-        my @args = grep { defined } ($cmd, $arg);
-        Carp::croak("plan() doesn't understand @args");
+        my @args = grep { defined } ( $cmd, $arg );
+        $self->croak("plan() doesn't understand @args");
     }
 
     return 1;
@@ -189,20 +255,22 @@ the appropriate headers.
 
 =cut
 
-my $Expected_Tests = 0;
 sub expected_tests {
-    my($self, $max) = @_;
+    my $self = shift;
+    my($max) = @_;
 
-    if( defined $max ) {
-        $Expected_Tests = $max;
-        $Have_Plan      = 1;
+    if(@_) {
+        $self->croak("Number of tests must be a positive integer.  You gave it '$max'")
+          unless $max =~ /^\+?\d+$/;
+
+        $self->{Expected_Tests} = $max;
+        $self->{Have_Plan}      = 1;
 
         $self->_print("1..$max\n") unless $self->no_header;
     }
-    return $Expected_Tests;
+    return $self->{Expected_Tests};
 }
 
-
 =item B<no_plan>
 
   $Test->no_plan;
@@ -211,10 +279,29 @@ Declares that this test will run an indeterminate # of tests.
 
 =cut
 
-my($No_Plan) = 0;
 sub no_plan {
-    $No_Plan    = 1;
-    $Have_Plan  = 1;
+    my $self = shift;
+
+    $self->{No_Plan}   = 1;
+    $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).
+
+=cut
+
+sub has_plan {
+    my $self = shift;
+
+    return( $self->{Expected_Tests} ) if $self->{Expected_Tests};
+    return('no_plan') if $self->{No_Plan};
+    return(undef);
 }
 
 =item B<skip_all>
@@ -226,26 +313,48 @@ Skips all the tests, using the given $reason.  Exits immediately with 0.
 
 =cut
 
-my $Skip_All = 0;
 sub skip_all {
-    my($self, $reason) = @_;
+    my( $self, $reason ) = @_;
 
     my $out = "1..0";
     $out .= " # Skip $reason" if $reason;
     $out .= "\n";
 
-    $Skip_All = 1;
+    $self->{Skip_All} = 1;
 
     $self->_print($out) unless $self->no_header;
     exit(0);
 }
 
+=item B<exported_to>
+
+  my $pack = $Test->exported_to;
+  $Test->exported_to($pack);
+
+Tells Test::Builder what package you exported your functions to.
+
+This method isn't terribly useful since modules which share the same
+Test::Builder object might get exported to different packages and only
+the last one will be honored.
+
+=cut
+
+sub exported_to {
+    my( $self, $pack ) = @_;
+
+    if( defined $pack ) {
+        $self->{Exported_To} = $pack;
+    }
+    return $self->{Exported_To};
+}
+
 =back
 
 =head2 Running tests
 
-These actually run the tests, analogous to the functions in
-Test::More.
+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.
 
@@ -261,59 +370,142 @@ like Test::Simple's ok().
 =cut
 
 sub ok {
-    my($self, $test, $name) = @_;
+    my( $self, $test, $name ) = @_;
 
-    unless( $Have_Plan ) {
-        require Carp;
-        Carp::croak("You tried to run a test without a plan!  Gotta have a plan.");
-    }
+    # $test might contain an object which we don't want to accidentally
+    # store, so we turn it into a boolean.
+    $test = $test ? 1 : 0;
 
-    lock $Curr_Test;
-    $Curr_Test++;
+    $self->_plan_check;
 
-    $self->diag(<<ERR) if defined $name and $name =~ /^[\d\s]+$/;
+    lock $self->{Curr_Test};
+    $self->{Curr_Test}++;
+
+    # In case $name is a string overloaded object, force it to stringify.
+    $self->_unoverload_str( \$name );
+
+    $self->diag(<<"ERR") if defined $name and $name =~ /^[\d\s]+$/;
     You named your test '$name'.  You shouldn't use numbers for your test names.
     Very confusing.
 ERR
 
-    my($pack, $file, $line) = $self->caller;
+    # Capture the value of $TODO for the rest of this ok() call
+    # so it can more easily be found by other routines.
+    my $todo    = $self->todo();
+    my $in_todo = $self->in_todo;
+    local $self->{Todo} = $todo if $in_todo;
 
-    my $todo = $self->todo($pack);
+    $self->_unoverload_str( \$todo );
 
     my $out;
-    unless( $test ) {
+    my $result = &share( {} );
+
+    unless($test) {
         $out .= "not ";
-        $Test_Results[$Curr_Test-1] = $todo ? 1 : 0;
+        @$result{ 'ok', 'actual_ok' } = ( ( $self->in_todo ? 1 : 0 ), 0 );
     }
     else {
-        $Test_Results[$Curr_Test-1] = 1;
+        @$result{ 'ok', 'actual_ok' } = ( 1, $test );
     }
 
     $out .= "ok";
-    $out .= " $Curr_Test" if $self->use_numbers;
+    $out .= " $self->{Curr_Test}" if $self->use_numbers;
 
     if( defined $name ) {
-        $name =~ s|#|\\#|g;     # # in a name can confuse Test::Harness.
-        $out   .= " - $name";
+        $name =~ s|#|\\#|g;    # # in a name can confuse Test::Harness.
+        $out .= " - $name";
+        $result->{name} = $name;
+    }
+    else {
+        $result->{name} = '';
     }
 
-    if( $todo ) {
-        my $what_todo = $todo;
-        $out   .= " # TODO $what_todo";
+    if( $self->in_todo ) {
+        $out .= " # TODO $todo";
+        $result->{reason} = $todo;
+        $result->{type}   = 'todo';
+    }
+    else {
+        $result->{reason} = '';
+        $result->{type}   = '';
     }
 
+    $self->{Test_Results}[ $self->{Curr_Test} - 1 ] = $result;
     $out .= "\n";
 
     $self->_print($out);
 
-    unless( $test ) {
-        my $msg = $todo ? "Failed (TODO)" : "Failed";
-        $self->diag("    $msg test ($file at line $line)\n");
-    } 
+    unless($test) {
+        my $msg = $self->in_todo ? "Failed (TODO)" : "Failed";
+        $self->_print_to_fh( $self->_diag_fh, "\n" ) if $ENV{HARNESS_ACTIVE};
+
+        my( undef, $file, $line ) = $self->caller;
+        if( defined $name ) {
+            $self->diag(qq[  $msg test '$name'\n]);
+            $self->diag(qq[  at $file line $line.\n]);
+        }
+        else {
+            $self->diag(qq[  $msg test at $file line $line.\n]);
+        }
+    }
 
     return $test ? 1 : 0;
 }
 
+sub _unoverload {
+    my $self = shift;
+    my $type = shift;
+
+    $self->_try(sub { require overload; }, die_on_fail => 1);
+
+    foreach my $thing (@_) {
+        if( $self->_is_object($$thing) ) {
+            if( my $string_meth = overload::Method( $$thing, $type ) ) {
+                $$thing = $$thing->$string_meth();
+            }
+        }
+    }
+
+    return;
+}
+
+sub _is_object {
+    my( $self, $thing ) = @_;
+
+    return $self->_try( sub { ref $thing && $thing->isa('UNIVERSAL') } ) ? 1 : 0;
+}
+
+sub _unoverload_str {
+    my $self = shift;
+
+    return $self->_unoverload( q[""], @_ );
+}
+
+sub _unoverload_num {
+    my $self = shift;
+
+    $self->_unoverload( '0+', @_ );
+
+    for my $val (@_) {
+        next unless $self->_is_dualvar($$val);
+        $$val = $$val + 0;
+    }
+
+    return;
+}
+
+# This is a hack to detect a dualvar such as $!
+sub _is_dualvar {
+    my( $self, $val ) = @_;
+
+    # Objects are not dualvars.
+    return 0 if ref $val;
+
+    no warnings 'numeric';
+    my $numval = $val + 0;
+    return $numval != 0 and $numval ne $val ? 1 : 0;
+}
+
 =item B<is_eq>
 
   $Test->is_eq($got, $expected, $name);
@@ -331,62 +523,85 @@ numeric version.
 =cut
 
 sub is_eq {
-    my($self, $got, $expect, $name) = @_;
+    my( $self, $got, $expect, $name ) = @_;
     local $Level = $Level + 1;
 
+    $self->_unoverload_str( \$got, \$expect );
+
     if( !defined $got || !defined $expect ) {
         # undef only matches undef and nothing else
         my $test = !defined $got && !defined $expect;
 
-        $self->ok($test, $name);
-        $self->_is_diag($got, 'eq', $expect) unless $test;
+        $self->ok( $test, $name );
+        $self->_is_diag( $got, 'eq', $expect ) unless $test;
         return $test;
     }
 
-    return $self->cmp_ok($got, 'eq', $expect, $name);
+    return $self->cmp_ok( $got, 'eq', $expect, $name );
 }
 
 sub is_num {
-    my($self, $got, $expect, $name) = @_;
+    my( $self, $got, $expect, $name ) = @_;
     local $Level = $Level + 1;
 
+    $self->_unoverload_num( \$got, \$expect );
+
     if( !defined $got || !defined $expect ) {
         # undef only matches undef and nothing else
         my $test = !defined $got && !defined $expect;
 
-        $self->ok($test, $name);
-        $self->_is_diag($got, '==', $expect) unless $test;
+        $self->ok( $test, $name );
+        $self->_is_diag( $got, '==', $expect ) unless $test;
         return $test;
     }
 
-    return $self->cmp_ok($got, '==', $expect, $name);
+    return $self->cmp_ok( $got, '==', $expect, $name );
 }
 
-sub _is_diag {
-    my($self, $got, $type, $expect) = @_;
+sub _diag_fmt {
+    my( $self, $type, $val ) = @_;
 
-    foreach my $val (\$got, \$expect) {
-        if( defined $$val ) {
-            if( $type eq 'eq' ) {
-                # quote and force string context
-                $$val = "'$$val'"
-            }
-            else {
-                # force numeric context
-                $$val = $$val+0;
-            }
+    if( defined $$val ) {
+        if( $type eq 'eq' or $type eq 'ne' ) {
+            # quote and force string context
+            $$val = "'$$val'";
         }
         else {
-            $$val = 'undef';
+            # force numeric context
+            $self->_unoverload_num($val);
         }
     }
+    else {
+        $$val = 'undef';
+    }
+
+    return;
+}
+
+sub _is_diag {
+    my( $self, $got, $type, $expect ) = @_;
+
+    $self->_diag_fmt( $type, $_ ) for \$got, \$expect;
 
-    return $self->diag(sprintf <<DIAGNOSTIC, $got, $expect);
-         got: %s
-    expected: %s
+    local $Level = $Level + 1;
+    return $self->diag(<<"DIAGNOSTIC");
+         got: $got
+    expected: $expect
 DIAGNOSTIC
 
-}    
+}
+
+sub _isnt_diag {
+    my( $self, $got, $type ) = @_;
+
+    $self->_diag_fmt( $type, \$got );
+
+    local $Level = $Level + 1;
+    return $self->diag(<<"DIAGNOSTIC");
+         got: $got
+    expected: anything else
+DIAGNOSTIC
+}
 
 =item B<isnt_eq>
 
@@ -397,7 +612,7 @@ the string version.
 
 =item B<isnt_num>
 
-  $Test->is_num($got, $dont_expect, $name);
+  $Test->isnt_num($got, $dont_expect, $name);
 
 Like Test::More's isnt().  Checks if $got ne $dont_expect.  This is
 the numeric version.
@@ -405,38 +620,37 @@ the numeric version.
 =cut
 
 sub isnt_eq {
-    my($self, $got, $dont_expect, $name) = @_;
+    my( $self, $got, $dont_expect, $name ) = @_;
     local $Level = $Level + 1;
 
     if( !defined $got || !defined $dont_expect ) {
         # undef only matches undef and nothing else
         my $test = defined $got || defined $dont_expect;
 
-        $self->ok($test, $name);
-        $self->_cmp_diag('ne', $got, $dont_expect) unless $test;
+        $self->ok( $test, $name );
+        $self->_isnt_diag( $got, 'ne' ) unless $test;
         return $test;
     }
 
-    return $self->cmp_ok($got, 'ne', $dont_expect, $name);
+    return $self->cmp_ok( $got, 'ne', $dont_expect, $name );
 }
 
 sub isnt_num {
-    my($self, $got, $dont_expect, $name) = @_;
+    my( $self, $got, $dont_expect, $name ) = @_;
     local $Level = $Level + 1;
 
     if( !defined $got || !defined $dont_expect ) {
         # undef only matches undef and nothing else
         my $test = defined $got || defined $dont_expect;
 
-        $self->ok($test, $name);
-        $self->_cmp_diag('!=', $got, $dont_expect) unless $test;
+        $self->ok( $test, $name );
+        $self->_isnt_diag( $got, '!=' ) unless $test;
         return $test;
     }
 
-    return $self->cmp_ok($got, '!=', $dont_expect, $name);
+    return $self->cmp_ok( $got, '!=', $dont_expect, $name );
 }
 
-
 =item B<like>
 
   $Test->like($this, qr/$regex/, $name);
@@ -457,91 +671,17 @@ given $regex.
 =cut
 
 sub like {
-    my($self, $this, $regex, $name) = @_;
+    my( $self, $this, $regex, $name ) = @_;
 
     local $Level = $Level + 1;
-    $self->_regex_ok($this, $regex, '=~', $name);
+    return $self->_regex_ok( $this, $regex, '=~', $name );
 }
 
 sub unlike {
-    my($self, $this, $regex, $name) = @_;
-
-    local $Level = $Level + 1;
-    $self->_regex_ok($this, $regex, '!~', $name);
-}
-
-=item B<maybe_regex>
-
-  $Test->maybe_regex(qr/$regex/);
-  $Test->maybe_regex('/$regex/');
-
-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
-representing a regular expression.
-
-Returns a Perl value which may be used instead of the corresponding
-regular expression, or undef if it's argument is not recognised.
-
-For example, a version of like(), sans the useful diagnostic messages,
-could be written as:
-
-  sub laconic_like {
-      my ($self, $this, $regex, $name) = @_;
-      my $usable_regex = $self->maybe_regex($regex);
-      die "expecting regex, found '$regex'\n"
-          unless $usable_regex;
-      $self->ok($this =~ m/$usable_regex/, $name);
-  }
-
-=cut
-
-
-sub maybe_regex {
-	my ($self, $regex) = @_;
-    my $usable_regex = undef;
-    if( ref $regex eq 'Regexp' ) {
-        $usable_regex = $regex;
-    }
-    # Check if it looks like '/foo/'
-    elsif( my($re, $opts) = $regex =~ m{^ /(.*)/ (\w*) $ }sx ) {
-        $usable_regex = length $opts ? "(?$opts)$re" : $re;
-    };
-    return($usable_regex)
-};
-
-sub _regex_ok {
-    my($self, $this, $regex, $cmp, $name) = @_;
+    my( $self, $this, $regex, $name ) = @_;
 
     local $Level = $Level + 1;
-
-    my $ok = 0;
-    my $usable_regex = $self->maybe_regex($regex);
-    unless (defined $usable_regex) {
-        $ok = $self->ok( 0, $name );
-        $self->diag("    '$regex' doesn't look much like a regex to me.");
-        return $ok;
-    }
-
-    {
-        local $^W = 0;
-        my $test = $this =~ /$usable_regex/ ? 1 : 0;
-        $test = !$test if $cmp eq '!~';
-        $ok = $self->ok( $test, $name );
-    }
-
-    unless( $ok ) {
-        $this = defined $this ? "'$this'" : 'undef';
-        my $match = $cmp eq '=~' ? "doesn't match" : "matches";
-        $self->diag(sprintf <<DIAGNOSTIC, $this, $match, $regex);
-                  %s
-    %13s '%s'
-DIAGNOSTIC
-
-    }
-
-    return $ok;
+    return $self->_regex_ok( $this, $regex, '!~', $name );
 }
 
 =item B<cmp_ok>
@@ -554,45 +694,96 @@ Works just like Test::More's cmp_ok().
 
 =cut
 
+my %numeric_cmps = map { ( $_, 1 ) } ( "<", "<=", ">", ">=", "==", "!=", "<=>" );
+
 sub cmp_ok {
-    my($self, $got, $type, $expect, $name) = @_;
+    my( $self, $got, $type, $expect, $name ) = @_;
 
     my $test;
+    my $error;
     {
-        local $^W = 0;
-        local($@,$!);   # don't interfere with $@
-                        # eval() sometimes resets $!
-        $test = eval "\$got $type \$expect";
+        ## no critic (BuiltinFunctions::ProhibitStringyEval)
+
+        local( $@, $!, $SIG{__DIE__} );    # isolate eval
+
+        my($pack, $file, $line) = $self->caller();
+
+        $test = eval qq[
+#line 1 "cmp_ok [from $file line $line]"
+\$got $type \$expect;
+];
+        $error = $@;
     }
     local $Level = $Level + 1;
-    my $ok = $self->ok($test, $name);
+    my $ok = $self->ok( $test, $name );
+
+    # Treat overloaded objects as numbers if we're asked to do a
+    # numeric comparison.
+    my $unoverload
+      = $numeric_cmps{$type}
+      ? '_unoverload_num'
+      : '_unoverload_str';
+
+    $self->diag(<<"END") if $error;
+An error occurred while using $type:
+------------------------------------
+$error
+------------------------------------
+END
+
+    unless($ok) {
+        $self->$unoverload( \$got, \$expect );
 
-    unless( $ok ) {
         if( $type =~ /^(eq|==)$/ ) {
-            $self->_is_diag($got, $type, $expect);
+            $self->_is_diag( $got, $type, $expect );
+        }
+        elsif( $type =~ /^(ne|!=)$/ ) {
+            $self->_isnt_diag( $got, $type );
         }
         else {
-            $self->_cmp_diag($got, $type, $expect);
+            $self->_cmp_diag( $got, $type, $expect );
         }
     }
     return $ok;
 }
 
 sub _cmp_diag {
-    my($self, $got, $type, $expect) = @_;
-    
+    my( $self, $got, $type, $expect ) = @_;
+
     $got    = defined $got    ? "'$got'"    : 'undef';
     $expect = defined $expect ? "'$expect'" : 'undef';
-    return $self->diag(sprintf <<DIAGNOSTIC, $got, $type, $expect);
-    %s
-        %s
-    %s
+
+    local $Level = $Level + 1;
+    return $self->diag(<<"DIAGNOSTIC");
+    $got
+        $type
+    $expect
 DIAGNOSTIC
 }
 
-=item B<BAILOUT>
+sub _caller_context {
+    my $self = shift;
+
+    my( $pack, $file, $line ) = $self->caller(1);
+
+    my $code = '';
+    $code .= "#line $line $file\n" if defined $file and defined $line;
 
-    $Test->BAILOUT($reason);
+    return $code;
+}
+
+=back
+
+
+=head2 Other Testing Methods
+
+These are methods which are used in the course of writing a test but are not themselves tests.
+
+=over 4
+
+=item B<BAIL_OUT>
+
+    $Test->BAIL_OUT($reason);
 
 Indicates to the Test::Harness that things are going so badly all
 testing should terminate.  This includes running any additional test
@@ -602,13 +793,21 @@ It will exit with 255.
 
 =cut
 
-sub BAILOUT {
-    my($self, $reason) = @_;
+sub BAIL_OUT {
+    my( $self, $reason ) = @_;
 
+    $self->{Bailed_Out} = 1;
     $self->_print("Bail out!  $reason");
     exit 255;
 }
 
+=for deprecated
+BAIL_OUT() used to be BAILOUT()
+
+=cut
+
+*BAILOUT = \&BAIL_OUT;
+
 =item B<skip>
 
     $Test->skip;
@@ -619,29 +818,36 @@ Skips the current test, reporting $why.
 =cut
 
 sub skip {
-    my($self, $why) = @_;
+    my( $self, $why ) = @_;
     $why ||= '';
+    $self->_unoverload_str( \$why );
 
-    unless( $Have_Plan ) {
-        require Carp;
-        Carp::croak("You tried to run tests without a plan!  Gotta have a plan.");
-    }
+    $self->_plan_check;
 
-    lock($Curr_Test);
-    $Curr_Test++;
+    lock( $self->{Curr_Test} );
+    $self->{Curr_Test}++;
 
-    $Test_Results[$Curr_Test-1] = 1;
+    $self->{Test_Results}[ $self->{Curr_Test} - 1 ] = &share(
+        {
+            'ok'      => 1,
+            actual_ok => 1,
+            name      => '',
+            type      => 'skip',
+            reason    => $why,
+        }
+    );
 
     my $out = "ok";
-    $out   .= " $Curr_Test" if $self->use_numbers;
-    $out   .= " # skip $why\n";
+    $out .= " $self->{Curr_Test}" if $self->use_numbers;
+    $out .= " # skip";
+    $out .= " $why"               if length $why;
+    $out .= "\n";
 
-    $Test->_print($out);
+    $self->_print($out);
 
     return 1;
 }
 
-
 =item B<todo_skip>
 
   $Test->todo_skip;
@@ -655,29 +861,33 @@ to
 =cut
 
 sub todo_skip {
-    my($self, $why) = @_;
+    my( $self, $why ) = @_;
     $why ||= '';
 
-    unless( $Have_Plan ) {
-        require Carp;
-        Carp::croak("You tried to run tests without a plan!  Gotta have a plan.");
-    }
+    $self->_plan_check;
 
-    lock($Curr_Test);
-    $Curr_Test++;
+    lock( $self->{Curr_Test} );
+    $self->{Curr_Test}++;
 
-    $Test_Results[$Curr_Test-1] = 1;
+    $self->{Test_Results}[ $self->{Curr_Test} - 1 ] = &share(
+        {
+            'ok'      => 1,
+            actual_ok => 0,
+            name      => '',
+            type      => 'todo_skip',
+            reason    => $why,
+        }
+    );
 
     my $out = "not ok";
-    $out   .= " $Curr_Test" if $self->use_numbers;
-    $out   .= " # TODO & SKIP $why\n";
+    $out .= " $self->{Curr_Test}" if $self->use_numbers;
+    $out .= " # TODO & SKIP $why\n";
 
-    $Test->_print($out);
+    $self->_print($out);
 
     return 1;
 }
 
-
 =begin _unimplemented
 
 =item B<skip_rest>
@@ -696,8 +906,187 @@ test.
 =back
 
 
+=head2 Test building utility methods
+
+These methods are useful when writing your own test methods.
+
+=over 4
+
+=item B<maybe_regex>
+
+  $Test->maybe_regex(qr/$regex/);
+  $Test->maybe_regex('/$regex/');
+
+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
+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.
+
+For example, a version of like(), sans the useful diagnostic messages,
+could be written as:
+
+  sub laconic_like {
+      my ($self, $this, $regex, $name) = @_;
+      my $usable_regex = $self->maybe_regex($regex);
+      die "expecting regex, found '$regex'\n"
+          unless $usable_regex;
+      $self->ok($this =~ m/$usable_regex/, $name);
+  }
+
+=cut
+
+sub maybe_regex {
+    my( $self, $regex ) = @_;
+    my $usable_regex = undef;
+
+    return $usable_regex unless defined $regex;
+
+    my( $re, $opts );
+
+    # Check for qr/foo/
+    if( _is_qr($regex) ) {
+        $usable_regex = $regex;
+    }
+    # Check for '/foo/' or 'm,foo,'
+    elsif(( $re, $opts )        = $regex =~ m{^ /(.*)/ (\w*) $ }sx              or
+          ( undef, $re, $opts ) = $regex =~ m,^ m([^\w\s]) (.+) \1 (\w*) $,sx
+    )
+    {
+        $usable_regex = length $opts ? "(?$opts)$re" : $re;
+    }
+
+    return $usable_regex;
+}
+
+sub _is_qr {
+    my $regex = shift;
+
+    # is_regexp() checks for regexes in a robust manner, say if they're
+    # blessed.
+    return re::is_regexp($regex) if defined &re::is_regexp;
+    return ref $regex eq 'Regexp';
+}
+
+sub _regex_ok {
+    my( $self, $this, $regex, $cmp, $name ) = @_;
+
+    my $ok           = 0;
+    my $usable_regex = $self->maybe_regex($regex);
+    unless( defined $usable_regex ) {
+        local $Level = $Level + 1;
+        $ok = $self->ok( 0, $name );
+        $self->diag("    '$regex' doesn't look much like a regex to me.");
+        return $ok;
+    }
+
+    {
+        ## no critic (BuiltinFunctions::ProhibitStringyEval)
+
+        my $test;
+        my $code = $self->_caller_context;
+
+        local( $@, $!, $SIG{__DIE__} );    # isolate eval
+
+        # Yes, it has to look like this or 5.4.5 won't see the #line
+        # directive.
+        # Don't ask me, man, I just work here.
+        $test = eval "
+$code" . q{$test = $this =~ /$usable_regex/ ? 1 : 0};
+
+        $test = !$test if $cmp eq '!~';
+
+        local $Level = $Level + 1;
+        $ok = $self->ok( $test, $name );
+    }
+
+    unless($ok) {
+        $this = defined $this ? "'$this'" : 'undef';
+        my $match = $cmp eq '=~' ? "doesn't match" : "matches";
+
+        local $Level = $Level + 1;
+        $self->diag( sprintf <<'DIAGNOSTIC', $this, $match, $regex );
+                  %s
+    %13s '%s'
+DIAGNOSTIC
+
+    }
+
+    return $ok;
+}
+
+# I'm not ready to publish this.  It doesn't deal with array return
+# values from the code or context.
+
+=begin private
+
+=item B<_try>
+
+    my $return_from_code          = $Test->try(sub { code });
+    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
+Perls.
+
+$error is what would normally be in $@.
+
+It is suggested you use this in place of eval BLOCK.
+
+=cut
+
+sub _try {
+    my( $self, $code, %opts ) = @_;
+
+    my $error;
+    my $return;
+    {
+        local $!;               # eval can mess up $!
+        local $@;               # don't set $@ in the test
+        local $SIG{__DIE__};    # don't trip an outside DIE handler.
+        $return = eval { $code->() };
+        $error = $@;
+    }
+
+    die $error if $error and $opts{die_on_fail};
+
+    return wantarray ? ( $return, $error ) : $return;
+}
+
+=end private
+
+
+=item B<is_fh>
+
+    my $is_fh = $Test->is_fh($thing);
+
+Determines if the given $thing can be used as a filehandle.
+
+=cut
+
+sub is_fh {
+    my $self     = shift;
+    my $maybe_fh = shift;
+    return 0 unless defined $maybe_fh;
+
+    return 1 if ref $maybe_fh  eq 'GLOB';    # its a glob ref
+    return 1 if ref \$maybe_fh eq 'GLOB';    # its a glob
+
+    return eval { $maybe_fh->isa("IO::Handle") } ||
+           # 5.5.4's tied() and can() doesn't like getting undef
+           eval { ( tied($maybe_fh) || '' )->can('TIEHANDLE') };
+}
+
+=back
+
+
 =head2 Test style
 
+
 =over 4
 
 =item B<level>
@@ -709,18 +1098,22 @@ test failed.
 
 Defaults to 1.
 
-Setting $Test::Builder::Level overrides.  This is typically useful
+Setting L<$Test::Builder::Level> overrides.  This is typically useful
 localized:
 
-    {
-        local $Test::Builder::Level = 2;
-        $Test->ok($test);
+    sub my_ok {
+        my $test = shift;
+
+        local $Test::Builder::Level = $Test::Builder::Level + 1;
+        $TB->ok($test);
     }
 
+To be polite to other functions wrapping your own you usually want to increment C<$Level> rather than set it to a constant.
+
 =cut
 
 sub level {
-    my($self, $level) = @_;
+    my( $self, $level ) = @_;
 
     if( defined $level ) {
         $Level = $level;
@@ -728,9 +1121,6 @@ sub level {
     return $Level;
 }
 
-$CLASS->level(1);
-
-
 =item B<use_numbers>
 
     $Test->use_numbers($on_or_off);
@@ -750,59 +1140,59 @@ or this if false
 Most useful when you can't depend on the test output order, such as
 when threads or forking is involved.
 
-Test::Harness will accept either, but avoid mixing the two styles.
-
 Defaults to on.
 
 =cut
 
-my $Use_Nums = 1;
 sub use_numbers {
-    my($self, $use_nums) = @_;
+    my( $self, $use_nums ) = @_;
 
     if( defined $use_nums ) {
-        $Use_Nums = $use_nums;
+        $self->{Use_Nums} = $use_nums;
     }
-    return $Use_Nums;
+    return $self->{Use_Nums};
 }
 
-=item B<no_header>
+=item B<no_diag>
 
-    $Test->no_header($no_header);
+    $Test->no_diag($no_diag);
 
-If set to true, no "1..N" header will be printed.
+If set true no diagnostics will be printed.  This includes calls to
+diag().
 
 =item B<no_ending>
 
     $Test->no_ending($no_ending);
 
 Normally, Test::Builder does some extra diagnostics when the test
-ends.  It also changes the exit code as described in Test::Simple.
+ends.  It also changes the exit code as described below.
 
 If this is true, none of that will be done.
 
+=item B<no_header>
+
+    $Test->no_header($no_header);
+
+If set to true, no "1..N" header will be printed.
+
 =cut
 
-my($No_Header, $No_Ending) = (0,0);
-sub no_header {
-    my($self, $no_header) = @_;
+foreach my $attribute (qw(No_Header No_Ending No_Diag)) {
+    my $method = lc $attribute;
 
-    if( defined $no_header ) {
-        $No_Header = $no_header;
-    }
-    return $No_Header;
-}
+    my $code = sub {
+        my( $self, $no ) = @_;
 
-sub no_ending {
-    my($self, $no_ending) = @_;
+        if( defined $no ) {
+            $self->{$attribute} = $no;
+        }
+        return $self->{$attribute};
+    };
 
-    if( defined $no_ending ) {
-        $No_Ending = $no_ending;
-    }
-    return $No_Ending;
+    no strict 'refs';    ## no critic
+    *{ __PACKAGE__ . '::' . $method } = $code;
 }
 
-
 =back
 
 =head2 Output
@@ -818,9 +1208,11 @@ Test::Builder's default output settings will not be affected.
 
     $Test->diag(@msgs);
 
-Prints out the given $message.  Normally, it uses the failure_output()
-handle, but if this is for a TODO test, the todo_output() handle is
-used.
+Prints out the given @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.
 
 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
@@ -839,28 +1231,87 @@ Mark Fowler <mark@twoshortplanks.com>
 =cut
 
 sub diag {
-    my($self, @msgs) = @_;
+    my $self = shift;
+
+    $self->_print_comment( $self->_diag_fh, @_ );
+}
+
+=item B<note>
+
+    $Test->note(@msgs);
+
+Like diag(), but it prints to the C<output()> handle so it will not
+normally be seen by the user except in verbose mode.
+
+=cut
+
+sub note {
+    my $self = shift;
+
+    $self->_print_comment( $self->output, @_ );
+}
+
+sub _diag_fh {
+    my $self = shift;
+
+    local $Level = $Level + 1;
+    return $self->in_todo ? $self->todo_output : $self->failure_output;
+}
+
+sub _print_comment {
+    my( $self, $fh, @msgs ) = @_;
+
+    return if $self->no_diag;
     return unless @msgs;
 
     # Prevent printing headers when compiling (i.e. -c)
     return if $^C;
 
-    # Escape each line with a #.
-    foreach (@msgs) {
-        $_ = 'undef' unless defined;
-        s/^/# /gms;
-    }
+    # Smash args together like print does.
+    # Convert undef to 'undef' so its readable.
+    my $msg = join '', map { defined($_) ? $_ : 'undef' } @msgs;
 
-    push @msgs, "\n" unless $msgs[-1] =~ /\n\Z/;
+    # Escape the beginning, _print will take care of the rest.
+    $msg =~ s/^/# /;
 
     local $Level = $Level + 1;
-    my $fh = $self->todo ? $self->todo_output : $self->failure_output;
-    local($\, $", $,) = (undef, ' ', '');
-    print $fh @msgs;
+    $self->_print_to_fh( $fh, $msg );
 
     return 0;
 }
 
+=item B<explain>
+
+    my @dump = $Test->explain(@msgs);
+
+Will dump the contents of any references in a human readable format.
+Handy for things like...
+
+    is_deeply($have, $want) || diag explain $have;
+
+or
+
+    is_deeply($have, $want) || note explain $have;
+
+=cut
+
+sub explain {
+    my $self = shift;
+
+    return map {
+        ref $_
+          ? do {
+            $self->_try(sub { require Data::Dumper }, die_on_fail => 1);
+
+            my $dumper = Data::Dumper->new( [$_] );
+            $dumper->Indent(1)->Terse(1);
+            $dumper->Sortkeys(1) if $dumper->can("Sortkeys");
+            $dumper->Dump;
+          }
+          : $_
+    } @_;
+}
+
 =begin _private
 
 =item B<_print>
@@ -874,27 +1325,31 @@ Prints to the output() filehandle.
 =cut
 
 sub _print {
-    my($self, @msgs) = @_;
+    my $self = shift;
+    return $self->_print_to_fh( $self->output, @_ );
+}
+
+sub _print_to_fh {
+    my( $self, $fh, @msgs ) = @_;
 
     # Prevent printing headers when only compiling.  Mostly for when
     # tests are deparsed with B::Deparse
     return if $^C;
 
-    local($\, $", $,) = (undef, ' ', '');
-    my $fh = $self->output;
+    my $msg = join '', @msgs;
+
+    local( $\, $", $, ) = ( undef, ' ', '' );
 
     # Escape each line after the first with a # so we don't
     # confuse Test::Harness.
-    foreach (@msgs) {
-        s/\n(.)/\n# $1/sg;
-    }
+    $msg =~ s{\n(?!\z)}{\n# }sg;
 
-    push @msgs, "\n" unless $msgs[-1] =~ /\n\Z/;
+    # Stick a newline on the end if it needs it.
+    $msg .= "\n" unless $msg =~ /\n\z/;
 
-    print $fh @msgs;
+    return print $fh $msg;
 }
 
-
 =item B<output>
 
     $Test->output($fh);
@@ -924,75 +1379,175 @@ Defaults to STDOUT.
 
 =cut
 
-my($Out_FH, $Fail_FH, $Todo_FH);
 sub output {
-    my($self, $fh) = @_;
+    my( $self, $fh ) = @_;
 
     if( defined $fh ) {
-        $Out_FH = _new_fh($fh);
+        $self->{Out_FH} = $self->_new_fh($fh);
     }
-    return $Out_FH;
+    return $self->{Out_FH};
 }
 
 sub failure_output {
-    my($self, $fh) = @_;
+    my( $self, $fh ) = @_;
 
     if( defined $fh ) {
-        $Fail_FH = _new_fh($fh);
+        $self->{Fail_FH} = $self->_new_fh($fh);
     }
-    return $Fail_FH;
+    return $self->{Fail_FH};
 }
 
 sub todo_output {
-    my($self, $fh) = @_;
+    my( $self, $fh ) = @_;
 
     if( defined $fh ) {
-        $Todo_FH = _new_fh($fh);
+        $self->{Todo_FH} = $self->_new_fh($fh);
     }
-    return $Todo_FH;
+    return $self->{Todo_FH};
 }
 
 sub _new_fh {
+    my $self = shift;
     my($file_or_fh) = shift;
 
     my $fh;
-    unless( UNIVERSAL::isa($file_or_fh, 'GLOB') ) {
-        $fh = do { local *FH };
-        open $fh, ">$file_or_fh" or 
-            die "Can't open test output log $file_or_fh: $!";
+    if( $self->is_fh($file_or_fh) ) {
+        $fh = $file_or_fh;
     }
     else {
-        $fh = $file_or_fh;
+        open $fh, ">", $file_or_fh
+          or $self->croak("Can't open test output log $file_or_fh: $!");
+        _autoflush($fh);
     }
 
     return $fh;
 }
 
-unless( $^C ) {
-    # We dup STDOUT and STDERR so people can change them in their
-    # test suites while still getting normal test output.
-    open(TESTOUT, ">&STDOUT") or die "Can't dup STDOUT:  $!";
-    open(TESTERR, ">&STDERR") or die "Can't dup STDERR:  $!";
+sub _autoflush {
+    my($fh) = shift;
+    my $old_fh = select $fh;
+    $| = 1;
+    select $old_fh;
+
+    return;
+}
+
+my( $Testout, $Testerr );
+
+sub _dup_stdhandles {
+    my $self = shift;
+
+    $self->_open_testhandles;
 
     # Set everything to unbuffered else plain prints to STDOUT will
     # come out in the wrong order from our own prints.
-    _autoflush(\*TESTOUT);
-    _autoflush(\*STDOUT);
-    _autoflush(\*TESTERR);
-    _autoflush(\*STDERR);
+    _autoflush($Testout);
+    _autoflush( \*STDOUT );
+    _autoflush($Testerr);
+    _autoflush( \*STDERR );
+
+    $self->reset_outputs;
 
-    $CLASS->output(\*TESTOUT);
-    $CLASS->failure_output(\*TESTERR);
-    $CLASS->todo_output(\*TESTOUT);
+    return;
 }
 
-sub _autoflush {
-    my($fh) = shift;
-    my $old_fh = select $fh;
-    $| = 1;
-    select $old_fh;
+my $Opened_Testhandles = 0;
+
+sub _open_testhandles {
+    my $self = shift;
+
+    return if $Opened_Testhandles;
+
+    # We dup STDOUT and STDERR so people can change them in their
+    # test suites while still getting normal test output.
+    open( $Testout, ">&STDOUT" ) or die "Can't dup STDOUT:  $!";
+    open( $Testerr, ">&STDERR" ) or die "Can't dup STDERR:  $!";
+
+    #    $self->_copy_io_layers( \*STDOUT, $Testout );
+    #    $self->_copy_io_layers( \*STDERR, $Testerr );
+
+    $Opened_Testhandles = 1;
+
+    return;
 }
 
+sub _copy_io_layers {
+    my( $self, $src, $dst ) = @_;
+
+    $self->_try(
+        sub {
+            require PerlIO;
+            my @src_layers = PerlIO::get_layers($src);
+
+            binmode $dst, join " ", map ":$_", @src_layers if @src_layers;
+        }
+    );
+
+    return;
+}
+
+=item reset_outputs
+
+  $tb->reset_outputs;
+
+Resets all the output filehandles back to their defaults.
+
+=cut
+
+sub reset_outputs {
+    my $self = shift;
+
+    $self->output        ($Testout);
+    $self->failure_output($Testerr);
+    $self->todo_output   ($Testout);
+
+    return;
+}
+
+=item carp
+
+  $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>).
+
+=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>).
+
+=cut
+
+sub _message_at_caller {
+    my $self = shift;
+
+    local $Level = $Level + 1;
+    my( $pack, $file, $line ) = $self->caller;
+    return join( "", @_ ) . " at $file line $line.\n";
+}
+
+sub carp {
+    my $self = shift;
+    return warn $self->_message_at_caller(@_);
+}
+
+sub croak {
+    my $self = shift;
+    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
 
@@ -1006,34 +1561,49 @@ sub _autoflush {
     my $curr_test = $Test->current_test;
     $Test->current_test($num);
 
-Gets/sets the current test # we're on.
+Gets/sets the current test number we're on.  You usually shouldn't
+have to set this.
 
-You usually shouldn't have to set this.
+If set forward, the details of the missing tests are filled in as 'unknown'.
+if set backward, the details of the intervening tests are deleted.  You
+can erase history if you really want to.
 
 =cut
 
 sub current_test {
-    my($self, $num) = @_;
+    my( $self, $num ) = @_;
 
-    lock($Curr_Test);
+    lock( $self->{Curr_Test} );
     if( defined $num ) {
-        unless( $Have_Plan ) {
-            require Carp;
-            Carp::croak("Can't change the current test number without a plan!");
-        }
-
-        $Curr_Test = $num;
-        if( $num > @Test_Results ) {
-            my $start = @Test_Results ? $#Test_Results : 0;
-            for ($start..$num-1) {
-                $Test_Results[$_] = 1;
+        $self->croak("Can't change the current test number without a plan!")
+          unless $self->{Have_Plan};
+
+        $self->{Curr_Test} = $num;
+
+        # If the test counter is being pushed forward fill in the details.
+        my $test_results = $self->{Test_Results};
+        if( $num > @$test_results ) {
+            my $start = @$test_results ? @$test_results : 0;
+            for( $start .. $num - 1 ) {
+                $test_results->[$_] = &share(
+                    {
+                        'ok'      => 1,
+                        actual_ok => undef,
+                        reason    => 'incrementing test number',
+                        type      => 'unknown',
+                        name      => undef
+                    }
+                );
             }
         }
+        # If backward, wipe history.  Its their funeral.
+        elsif( $num < @$test_results ) {
+            $#{$test_results} = $num - 1;
+        }
     }
-    return $Curr_Test;
+    return $self->{Curr_Test};
 }
 
-
 =item B<summary>
 
     my @tests = $Test->summary;
@@ -1048,36 +1618,80 @@ Of course, test #1 is $tests[0], etc...
 sub summary {
     my($self) = shift;
 
-    return @Test_Results;
+    return map { $_->{'ok'} } @{ $self->{Test_Results} };
 }
 
-=item B<details>  I<UNIMPLEMENTED>
+=item B<details>
 
     my @tests = $Test->details;
 
 Like summary(), but with a lot more detail.
 
     $tests[$test_num - 1] = 
-            { ok         => is the test considered ok?
+            { 'ok'       => is the test considered a pass?
               actual_ok  => did it literally say 'ok'?
               name       => name of the test (if any)
-              type       => 'skip' or 'todo' (if any)
+              type       => type of test (if any, see below).
               reason     => reason for the above (if any)
             };
 
+'ok' is true if Test::Harness will consider the test to be a pass.
+
+'actual_ok' is a reflection of whether or not the test literally
+printed 'ok' or 'not ok'.  This is for examining the result of 'todo'
+tests.  
+
+'name' is the name of the test.
+
+'type' indicates if it was a special test.  Normal tests have a type
+of ''.  Type can be one of the following:
+
+    skip        see skip()
+    todo        see todo()
+    todo_skip   see todo_skip()
+    unknown     see below
+
+Sometimes the Test::Builder test counter is incremented without it
+printing any test output, for example, when 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.
+
+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
+        actual_ok => 0,   # in absolute terms, it failed
+        name      => 'hole count',
+        type      => 'todo',
+        reason    => 'insufficient donuts'
+      };
+
+=cut
+
+sub details {
+    my $self = shift;
+    return @{ $self->{Test_Results} };
+}
+
 =item B<todo>
 
     my $todo_reason = $Test->todo;
     my $todo_reason = $Test->todo($pack);
 
-todo() looks for a $TODO variable in your tests.  If set, all tests
-will be considered 'todo' (see Test::More and Test::Harness for
-details).  Returns the reason (ie. the value of $TODO) if running as
-todo tests, false otherwise.
+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()>>.
 
-todo() is pretty part about finding the right package to look for
-$TODO in.  It uses the exported_to() package to find it.  If that's
-not set, it's pretty good at guessing the right package to look at.
+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>>
+to determine if you are currently inside a TODO block.
+
+todo() is about finding the right package to look for $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
@@ -1086,13 +1700,134 @@ what $pack to use.
 =cut
 
 sub todo {
-    my($self, $pack) = @_;
+    my( $self, $pack ) = @_;
+
+    return $self->{Todo} if defined $self->{Todo};
+
+    local $Level = $Level + 1;
+    my $todo = $self->find_TODO($pack);
+    return $todo if defined $todo;
+
+    return '';
+}
+
+=item B<find_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()>>.
+
+=cut
+
+sub find_TODO {
+    my( $self, $pack ) = @_;
+
+    $pack = $pack || $self->caller(1) || $self->exported_to;
+    return unless $pack;
+
+    no strict 'refs';    ## no critic
+    return ${ $pack . '::TODO' };
+}
+
+=item B<in_todo>
+
+    my $in_todo = $Test->in_todo;
+
+Returns true if the test is currently inside a TODO block.
+
+=cut
+
+sub in_todo {
+    my $self = shift;
+
+    local $Level = $Level + 1;
+    return( defined $self->{Todo} || $self->find_TODO ) ? 1 : 0;
+}
+
+=item B<todo_start>
+
+    $Test->todo_start();
+    $Test->todo_start($message);
+
+This method allows you declare all subsequent tests as TODO tests, up until
+the C<todo_end> method has been called.
+
+The C<TODO:> and C<$TODO> syntax is generally pretty good about figuring out
+whether or not we're in a TODO test.  However, often we find that this is not
+possible to determine (such as when we want to use C<$TODO> but
+the tests are being executed in other packages which can't be inferred
+beforehand).
+
+Note that you can use this to nest "todo" tests
+
+ $Test->todo_start('working on this');
+ # lots of code
+ $Test->todo_start('working on that');
+ # more code
+ $Test->todo_end;
+ $Test->todo_end;
+
+This is generally not recommended, but large testing systems often have weird
+internal needs.
+
+We've tried to make this also work with the TODO: syntax, but it's not
+guaranteed and its use is also discouraged:
+
+ TODO: {
+     local $TODO = 'We have work to do!';
+     $Test->todo_start('working on this');
+     # lots of code
+     $Test->todo_start('working on that');
+     # more code
+     $Test->todo_end;
+     $Test->todo_end;
+ }
+
+Pick one style or another of "TODO" to be on the safe side.
+
+=cut
+
+sub todo_start {
+    my $self = shift;
+    my $message = @_ ? shift : '';
 
-    $pack = $pack || $self->exported_to || $self->caller(1);
+    $self->{Start_Todo}++;
+    if( $self->in_todo ) {
+        push @{ $self->{Todo_Stack} } => $self->todo;
+    }
+    $self->{Todo} = $message;
 
-    no strict 'refs';
-    return defined ${$pack.'::TODO'} ? ${$pack.'::TODO'}
-                                     : 0;
+    return;
+}
+
+=item C<todo_end>
+
+ $Test->todo_end;
+
+Stops running tests as "TODO" tests.  This method is fatal if called without a
+preceding C<todo_start> method call.
+
+=cut
+
+sub todo_end {
+    my $self = shift;
+
+    if( !$self->{Start_Todo} ) {
+        $self->croak('todo_end() called without todo_start()');
+    }
+
+    $self->{Start_Todo}--;
+
+    if( $self->{Start_Todo} && @{ $self->{Todo_Stack} } ) {
+        $self->{Todo} = pop @{ $self->{Todo_Stack} };
+    }
+    else {
+        delete $self->{Todo};
+    }
+
+    return;
 }
 
 =item B<caller>
@@ -1103,13 +1838,22 @@ sub todo {
 
 Like the normal caller(), except it reports according to your level().
 
+C<$height> will be added to the level().
+
+If caller() winds up off the top of the stack it report the highest context.
+
 =cut
 
-sub caller {
-    my($self, $height) = @_;
+sub caller {    ## no critic (Subroutines::ProhibitBuiltinHomonyms)
+    my( $self, $height ) = @_;
     $height ||= 0;
 
-    my @caller = CORE::caller($self->level + $height + 1);
+    my $level = $self->level + $height + 1;
+    my @caller;
+    do {
+        @caller = CORE::caller( $level );
+        $level--;
+    } until @caller;
     return wantarray ? @caller : $caller[0];
 }
 
@@ -1123,7 +1867,7 @@ sub caller {
 
 =item B<_sanity_check>
 
-  _sanity_check();
+  $self->_sanity_check();
 
 Runs a bunch of end of test sanity checks to make sure reality came
 through ok.  If anything is wrong it will die with a fairly friendly
@@ -1133,16 +1877,20 @@ error message.
 
 #'#
 sub _sanity_check {
-    _whoa($Curr_Test < 0,  'Says here you ran a negative number of tests!');
-    _whoa(!$Have_Plan and $Curr_Test, 
-          'Somehow your tests ran without a plan!');
-    _whoa($Curr_Test != @Test_Results,
-          'Somehow you got a different number of results than tests ran!');
+    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!' );
+
+    return;
 }
 
 =item B<_whoa>
 
-  _whoa($check, $description);
+  $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
@@ -1151,13 +1899,16 @@ a note to contact the author.
 =cut
 
 sub _whoa {
-    my($check, $desc) = @_;
-    if( $check ) {
-        die <<WHOA;
+    my( $self, $check, $desc ) = @_;
+    if($check) {
+        local $Level = $Level + 1;
+        $self->croak(<<"WHOA");
 WHOA!  $desc
 This should never happen!  Please contact the author immediately!
 WHOA
     }
+
+    return;
 }
 
 =item B<_my_exit>
@@ -1172,101 +1923,153 @@ doesn't actually exit, that's your job.
 =cut
 
 sub _my_exit {
-    $? = $_[0];
+    $? = $_[0];    ## no critic (Variables::RequireLocalizedPunctuationVars)
 
     return 1;
 }
 
-
 =back
 
 =end _private
 
 =cut
 
-$SIG{__DIE__} = sub {
-    # We don't want to muck with death in an eval, but $^S isn't
-    # totally reliable.  5.005_03 and 5.6.1 both do the wrong thing
-    # with it.  Instead, we use caller.  This also means it runs under
-    # 5.004!
-    my $in_eval = 0;
-    for( my $stack = 1;  my $sub = (CORE::caller($stack))[3];  $stack++ ) {
-        $in_eval = 1 if $sub =~ /^\(eval\)/;
-    }
-    $Test_Died = 1 unless $in_eval;
-};
-
 sub _ending {
     my $self = shift;
 
-    _sanity_check();
+    my $real_exit_code = $?;
+    $self->_sanity_check();
 
-    # Bailout if plan() was never called.  This is so
-    # "require Test::Simple" doesn't puke.
-    do{ _my_exit(0) && return } if !$Have_Plan;
+    # Don't bother with an ending if this is a forked copy.  Only the parent
+    # should do the ending.
+    if( $self->{Original_Pid} != $$ ) {
+        return;
+    }
+
+    # Exit if plan() was never called.  This is so "require Test::Simple"
+    # doesn't puke.
+    if( !$self->{Have_Plan} ) {
+        return;
+    }
+
+    # Don't do an ending if we bailed out.
+    if( $self->{Bailed_Out} ) {
+        return;
+    }
 
     # Figure out if we passed or failed and print helpful messages.
-    if( @Test_Results ) {
+    my $test_results = $self->{Test_Results};
+    if(@$test_results) {
         # The plan?  We have no plan.
-        if( $No_Plan ) {
-            $self->_print("1..$Curr_Test\n") unless $self->no_header;
-            $Expected_Tests = $Curr_Test;
+        if( $self->{No_Plan} ) {
+            $self->_print("1..$self->{Curr_Test}\n") unless $self->no_header;
+            $self->{Expected_Tests} = $self->{Curr_Test};
         }
 
-        # 5.8.0 threads bug.  Shared arrays will not be auto-extended 
-        # by a slice.
-        $Test_Results[$Expected_Tests-1] = undef
-          unless defined $Test_Results[$Expected_Tests-1];
+        # Auto-extended arrays and elements which aren't explicitly
+        # filled in with a shared reference will puke under 5.8.0
+        # ithreads.  So we have to fill them in by hand. :(
+        my $empty_result = &share( {} );
+        for my $idx ( 0 .. $self->{Expected_Tests} - 1 ) {
+            $test_results->[$idx] = $empty_result
+              unless defined $test_results->[$idx];
+        }
 
-        my $num_failed = grep !$_, @Test_Results[0..$Expected_Tests-1];
-        $num_failed += abs($Expected_Tests - @Test_Results);
+        my $num_failed = grep !$_->{'ok'}, @{$test_results}[ 0 .. $self->{Curr_Test} - 1 ];
 
-        if( $Curr_Test < $Expected_Tests ) {
-            $self->diag(<<"FAIL");
-Looks like you planned $Expected_Tests tests but only ran $Curr_Test.
-FAIL
-        }
-        elsif( $Curr_Test > $Expected_Tests ) {
-            my $num_extra = $Curr_Test - $Expected_Tests;
+        my $num_extra = $self->{Curr_Test} - $self->{Expected_Tests};
+
+        if( $num_extra != 0 ) {
+            my $s = $self->{Expected_Tests} == 1 ? '' : 's';
             $self->diag(<<"FAIL");
-Looks like you planned $Expected_Tests tests but ran $num_extra extra.
+Looks like you planned $self->{Expected_Tests} test$s but ran $self->{Curr_Test}.
 FAIL
         }
-        elsif ( $num_failed ) {
+
+        if($num_failed) {
+            my $num_tests = $self->{Curr_Test};
+            my $s = $num_failed == 1 ? '' : 's';
+
+            my $qualifier = $num_extra == 0 ? '' : ' run';
+
             $self->diag(<<"FAIL");
-Looks like you failed $num_failed tests of $Expected_Tests.
+Looks like you failed $num_failed test$s of $num_tests$qualifier.
 FAIL
         }
 
-        if( $Test_Died ) {
+        if($real_exit_code) {
             $self->diag(<<"FAIL");
-Looks like your test died just after $Curr_Test.
+Looks like your test exited with $real_exit_code just after $self->{Curr_Test}.
 FAIL
 
-            _my_exit( 255 ) && return;
+            _my_exit($real_exit_code) && return;
+        }
+
+        my $exit_code;
+        if($num_failed) {
+            $exit_code = $num_failed <= 254 ? $num_failed : 254;
+        }
+        elsif( $num_extra != 0 ) {
+            $exit_code = 255;
+        }
+        else {
+            $exit_code = 0;
         }
 
-        _my_exit( $num_failed <= 254 ? $num_failed : 254  ) && return;
+        _my_exit($exit_code) && return;
     }
-    elsif ( $Skip_All ) {
-        _my_exit( 0 ) && return;
+    elsif( $self->{Skip_All} ) {
+        _my_exit(0) && return;
+    }
+    elsif($real_exit_code) {
+        $self->diag(<<"FAIL");
+Looks like your test exited with $real_exit_code before it could output anything.
+FAIL
+        _my_exit($real_exit_code) && return;
     }
     else {
         $self->diag("No tests run!\n");
-        _my_exit( 255 ) && return;
+        _my_exit(255) && return;
     }
+
+    $self->_whoa( 1, "We fell off the end of _ending()" );
 }
 
 END {
     $Test->_ending if defined $Test and !$Test->no_ending;
 }
 
+=head1 EXIT CODES
+
+If all your tests passed, Test::Builder will exit with zero (which is
+normal).  If anything failed it will exit with how many failed.  If
+you run less (or more) tests than you planned, the missing (or extras)
+will be considered failures.  If no tests were ever run Test::Builder
+will throw a warning and exit with 255.  If the test died, even after
+having successfully completed all its tests, it will still be
+considered a failure and will exit with 255.
+
+So the exit codes are...
+
+    0                   all tests successful
+    255                 test died or all passed but wrong # of tests run
+    any other number    how many failed (including missing or extras)
+
+If you fail more than 254 tests, it will be reported as 254.
+
+
 =head1 THREADS
 
-In perl 5.8.0 and later, Test::Builder is thread-safe.  The test
+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.
 
+While versions earlier than 5.8.1 had threads they contain too many
+bugs to support.
+
+Test::Builder is only thread-aware if threads.pm is loaded I<before>
+Test::Builder.
+
 =head1 EXAMPLES
 
 CPAN can provide the best examples.  Test::Simple, Test::More,
@@ -1283,8 +2086,8 @@ E<lt>schwern@pobox.comE<gt>
 
 =head1 COPYRIGHT
 
-Copyright 2001 by chromatic E<lt>chromatic@wgz.orgE<gt>,
-                  Michael G Schwern 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 
 modify it under the same terms as Perl itself.
@@ -1294,3 +2097,4 @@ See F<http://www.perl.com/perl/misc/Artistic.html>
 =cut
 
 1;
+
diff --git a/gnu/usr.bin/perl/lib/Test/Builder/Module.pm b/gnu/usr.bin/perl/lib/Test/Builder/Module.pm
index b3ccce63292..75da4aa6b98 100644
--- a/gnu/usr.bin/perl/lib/Test/Builder/Module.pm
+++ b/gnu/usr.bin/perl/lib/Test/Builder/Module.pm
@@ -1,24 +1,23 @@
 package Test::Builder::Module;
 
+use strict;
+
 use Test::Builder;
 
 require Exporter;
-@ISA = qw(Exporter);
+our @ISA = qw(Exporter);
 
-$VERSION = '0.02';
-
-use strict;
+our $VERSION = '0.86';
 
 # 5.004's Exporter doesn't have export_to_level.
 my $_export_to_level = sub {
-      my $pkg = shift;
-      my $level = shift;
-      (undef) = shift;                  # redundant arg
-      my $callpkg = caller($level);
-      $pkg->export($callpkg, @_);
+    my $pkg   = shift;
+    my $level = shift;
+    (undef) = shift;    # redundant arg
+    my $callpkg = caller($level);
+    $pkg->export( $callpkg, @_ );
 };
 
-
 =head1 NAME
 
 Test::Builder::Module - Base class for test modules
@@ -84,33 +83,35 @@ import_extra().
 sub import {
     my($class) = shift;
 
+    # Don't run all this when loading ourself.
+    return 1 if $class eq 'Test::Builder::Module';
+
     my $test = $class->builder;
 
     my $caller = caller;
 
     $test->exported_to($caller);
 
-    $class->import_extra(\@_);
-    my(@imports) = $class->_strip_imports(\@_);
+    $class->import_extra( \@_ );
+    my(@imports) = $class->_strip_imports( \@_ );
 
     $test->plan(@_);
 
-    $class->$_export_to_level(1, $class, @imports);
+    $class->$_export_to_level( 1, $class, @imports );
 }
 
-
 sub _strip_imports {
     my $class = shift;
     my $list  = shift;
 
     my @imports = ();
     my @other   = ();
-    my $idx = 0;
+    my $idx     = 0;
     while( $idx <= $#{$list} ) {
         my $item = $list->[$idx];
 
         if( defined $item and $item eq 'import' ) {
-            push @imports, @{$list->[$idx+1]};
+            push @imports, @{ $list->[ $idx + 1 ] };
             $idx++;
         }
         else {
@@ -125,7 +126,6 @@ sub _strip_imports {
     return @imports;
 }
 
-
 =head3 import_extra
 
     Your::Module->import_extra(\@import_args);
@@ -143,8 +143,7 @@ feels like a bit of an ugly hack in its current form.
 
 =cut
 
-sub import_extra {}
-
+sub import_extra { }
 
 =head2 Builder
 
@@ -178,5 +177,4 @@ sub builder {
     return Test::Builder->new;
 }
 
-
 1;
diff --git a/gnu/usr.bin/perl/lib/Test/Builder/Tester.pm b/gnu/usr.bin/perl/lib/Test/Builder/Tester.pm
index 9e3b9c7b329..c0196355849 100644
--- a/gnu/usr.bin/perl/lib/Test/Builder/Tester.pm
+++ b/gnu/usr.bin/perl/lib/Test/Builder/Tester.pm
@@ -1,8 +1,7 @@
 package Test::Builder::Tester;
 
 use strict;
-use vars qw(@EXPORT $VERSION @ISA);
-$VERSION = "1.02";
+our $VERSION = "1.18";
 
 use Test::Builder;
 use Symbol;
@@ -56,21 +55,20 @@ my $t = Test::Builder->new;
 ###
 
 use Exporter;
-@ISA = qw(Exporter);
+our @ISA = qw(Exporter);
 
-@EXPORT = qw(test_out test_err test_fail test_diag test_test line_num);
+our @EXPORT = qw(test_out test_err test_fail test_diag test_test line_num);
 
 # _export_to_level and import stolen directly from Test::More.  I am
 # the king of cargo cult programming ;-)
 
 # 5.004's Exporter doesn't have export_to_level.
-sub _export_to_level
-{
-      my $pkg = shift;
-      my $level = shift;
-      (undef) = shift;                  # XXX redundant arg
-      my $callpkg = caller($level);
-      $pkg->export($callpkg, @_);
+sub _export_to_level {
+    my $pkg   = shift;
+    my $level = shift;
+    (undef) = shift;    # XXX redundant arg
+    my $callpkg = caller($level);
+    $pkg->export( $callpkg, @_ );
 }
 
 sub import {
@@ -83,14 +81,14 @@ sub import {
     $t->plan(@plan);
 
     my @imports = ();
-    foreach my $idx (0..$#plan) {
+    foreach my $idx ( 0 .. $#plan ) {
         if( $plan[$idx] eq 'import' ) {
-            @imports = @{$plan[$idx+1]};
+            @imports = @{ $plan[ $idx + 1 ] };
             last;
         }
     }
 
-    __PACKAGE__->_export_to_level(1, __PACKAGE__, @imports);
+    __PACKAGE__->_export_to_level( 1, __PACKAGE__, @imports );
 }
 
 ###
@@ -102,8 +100,8 @@ my $output_handle = gensym;
 my $error_handle  = gensym;
 
 # and tie them to this package
-my $out = tie *$output_handle, "Test::Tester::Tie", "STDOUT";
-my $err = tie *$error_handle,  "Test::Tester::Tie", "STDERR";
+my $out = tie *$output_handle, "Test::Builder::Tester::Tie", "STDOUT";
+my $err = tie *$error_handle,  "Test::Builder::Tester::Tie", "STDERR";
 
 ####
 # exported functions
@@ -124,8 +122,7 @@ my $original_harness_state;
 my $original_harness_env;
 
 # function that starts testing and redirects the filehandles for now
-sub _start_testing
-{
+sub _start_testing {
     # even if we're running under Test::Harness pretend we're not
     # for now.  This needed so Test::Builder doesn't add extra spaces
     $original_harness_env = $ENV{HARNESS_ACTIVE} || 0;
@@ -146,7 +143,7 @@ sub _start_testing
     $err->reset();
 
     # remeber that we're testing
-    $testing = 1;
+    $testing     = 1;
     $testing_num = $t->current_test;
     $t->current_test(0);
 
@@ -154,7 +151,7 @@ sub _start_testing
     $t->no_ending(1);
 }
 
-=head2 Methods
+=head2 Functions
 
 These are the six methods that are exported as default.
 
@@ -188,20 +185,18 @@ output filehandles)
 
 =cut
 
-sub test_out(@)
-{
+sub test_out {
     # do we need to do any setup?
     _start_testing() unless $testing;
 
-    $out->expect(@_)
+    $out->expect(@_);
 }
 
-sub test_err(@)
-{
+sub test_err {
     # do we need to do any setup?
     _start_testing() unless $testing;
 
-    $err->expect(@_)
+    $err->expect(@_);
 }
 
 =item test_fail
@@ -214,7 +209,7 @@ so
 
     test_err("# Failed test ($0 at line ".line_num(+1).")");
 
-C<test_fail> exists as a convenience method that can be called
+C<test_fail> exists as a convenience function that can be called
 instead.  It takes one argument, the offset from the current line that
 the line that causes the fail is on.
 
@@ -230,14 +225,13 @@ more simply as:
 
 =cut
 
-sub test_fail
-{
+sub test_fail {
     # do we need to do any setup?
     _start_testing() unless $testing;
 
     # work out what line we should be on
-    my ($package, $filename, $line) = caller;
-    $line = $line + (shift() || 0); # prevent warnings
+    my( $package, $filename, $line ) = caller;
+    $line = $line + ( shift() || 0 );    # prevent warnings
 
     # expect that on stderr
     $err->expect("#     Failed test ($0 at line $line)");
@@ -273,14 +267,13 @@ without the newlines.
 
 =cut
 
-sub test_diag
-{
+sub test_diag {
     # do we need to do any setup?
     _start_testing() unless $testing;
 
     # expect the same thing, but prepended with "#     "
     local $_;
-    $err->expect(map {"# $_"} @_)
+    $err->expect( map { "# $_" } @_ );
 }
 
 =item test_test
@@ -322,24 +315,23 @@ will function normally and cause success/errors for B<Test::Harness>.
 
 =cut
 
-sub test_test
-{
-   # decode the arguements as described in the pod
-   my $mess;
-   my %args;
-   if (@_ == 1)
-     { $mess = shift }
-   else
-   {
-     %args = @_;
-     $mess = $args{name} if exists($args{name});
-     $mess = $args{title} if exists($args{title});
-     $mess = $args{label} if exists($args{label});
-   }
+sub test_test {
+    # decode the arguements as described in the pod
+    my $mess;
+    my %args;
+    if( @_ == 1 ) {
+        $mess = shift
+    }
+    else {
+        %args = @_;
+        $mess = $args{name} if exists( $args{name} );
+        $mess = $args{title} if exists( $args{title} );
+        $mess = $args{label} if exists( $args{label} );
+    }
 
     # er, are we testing?
     croak "Not testing.  You must declare output with a test function first."
-	unless $testing;
+      unless $testing;
 
     # okay, reconnect the test suite back to the saved handles
     $t->output($original_output_handle);
@@ -354,20 +346,20 @@ sub test_test
     $ENV{HARNESS_ACTIVE} = $original_harness_env;
 
     # check the output we've stashed
-    unless ($t->ok(    ($args{skip_out} || $out->check)
-                    && ($args{skip_err} || $err->check),
-                   $mess))
+    unless( $t->ok( ( $args{skip_out} || $out->check ) &&
+                    ( $args{skip_err} || $err->check ), $mess ) 
+    )
     {
-      # print out the diagnostic information about why this
-      # test failed
+        # print out the diagnostic information about why this
+        # test failed
 
-      local $_;
+        local $_;
 
-      $t->diag(map {"$_\n"} $out->complaint)
-	unless $args{skip_out} || $out->check;
+        $t->diag( map { "$_\n" } $out->complaint )
+          unless $args{skip_out} || $out->check;
 
-      $t->diag(map {"$_\n"} $err->complaint)
-	unless $args{skip_err} || $err->check;
+        $t->diag( map { "$_\n" } $err->complaint )
+          unless $args{skip_err} || $err->check;
     }
 }
 
@@ -376,17 +368,16 @@ sub test_test
 A utility function that returns the line number that the function was
 called on.  You can pass it an offset which will be added to the
 result.  This is very useful for working out the correct text of
-diagnostic methods that contain line numbers.
+diagnostic functions that contain line numbers.
 
 Essentially this is the same as the C<__LINE__> macro, but the
 C<line_num(+3)> idiom is arguably nicer.
 
 =cut
 
-sub line_num
-{
-    my ($package, $filename, $line) = caller;
-    return $line + (shift() || 0); # prevent warnings
+sub line_num {
+    my( $package, $filename, $line ) = caller;
+    return $line + ( shift() || 0 );    # prevent warnings
 }
 
 =back
@@ -432,20 +423,20 @@ the PERL5LIB.
 =cut
 
 my $color;
-sub color
-{
-  $color = shift if @_;
-  $color;
+
+sub color {
+    $color = shift if @_;
+    $color;
 }
 
 =back
 
 =head1 BUGS
 
-Calls B<Test::Builder>'s C<no_ending> method turning off the ending
-tests.  This is needed as otherwise it will trip out because we've run
-more tests than we strictly should have and it'll register any
-failures we had that we were testing for as real failures.
+Calls C<<Test::Builder->no_ending>> turning off the ending tests.
+This is needed as otherwise it will trip out because we've run more
+tests than we strictly should have and it'll register any failures we
+had that we were testing for as real failures.
 
 The color function doesn't work unless B<Term::ANSIColor> is installed
 and is compatible with your terminal.
@@ -485,49 +476,44 @@ L<Test::Builder>, L<Test::Builder::Tester::Color>, L<Test::More>.
 ####################################################################
 # Helper class that is used to remember expected and received data
 
-package Test::Tester::Tie;
+package Test::Builder::Tester::Tie;
 
 ##
 # add line(s) to be expected
 
-sub expect
-{
+sub expect {
     my $self = shift;
 
     my @checks = @_;
     foreach my $check (@checks) {
         $check = $self->_translate_Failed_check($check);
-        push @{$self->[2]}, ref $check ? $check : "$check\n";
+        push @{ $self->{wanted} }, ref $check ? $check : "$check\n";
     }
 }
 
+sub _translate_Failed_check {
+    my( $self, $check ) = @_;
 
-sub _translate_Failed_check 
-{
-    my($self, $check) = @_;
-
-    if( $check =~ /\A(.*)#     (Failed .*test) \((.*?) at line (\d+)\)\z/ ) {
-        $check = qr/\Q$1\E#\s+\Q$2\E.*?\n?.*?\Q$3\E at line \Q$4\E.*\n?/;
+    if( $check =~ /\A(.*)#     (Failed .*test) \((.*?) at line (\d+)\)\Z(?!\n)/ ) {
+        $check = "/\Q$1\E#\\s+\Q$2\E.*?\\n?.*?\Qat $3\E line \Q$4\E.*\\n?/";
     }
 
     return $check;
 }
 
-
 ##
 # return true iff the expected data matches the got data
 
-sub check
-{
+sub check {
     my $self = shift;
 
     # turn off warnings as these might be undef
     local $^W = 0;
 
-    my @checks = @{$self->[2]};
-    my $got = $self->[1];
+    my @checks = @{ $self->{wanted} };
+    my $got    = $self->{got};
     foreach my $check (@checks) {
-        $check = qr/^\Q$check\E/ unless ref $check;
+        $check = "\Q$check\E" unless( $check =~ s,^/(.*)/$,$1, or ref $check );
         return 0 unless $got =~ s/^$check//;
     }
 
@@ -538,103 +524,97 @@ sub check
 # a complaint message about the inputs not matching (to be
 # used for debugging messages)
 
-sub complaint
-{
-    my $self = shift;
+sub complaint {
+    my $self   = shift;
     my $type   = $self->type;
     my $got    = $self->got;
-    my $wanted = join "\n", @{$self->wanted};
+    my $wanted = join "\n", @{ $self->wanted };
 
     # are we running in colour mode?
-    if (Test::Builder::Tester::color)
-    {
-      # get color
-      eval "require Term::ANSIColor";
-      unless ($@)
-      {
-	# colours
-
-	my $green = Term::ANSIColor::color("black").
-	            Term::ANSIColor::color("on_green");
-        my $red   = Term::ANSIColor::color("black").
-                    Term::ANSIColor::color("on_red");
-	my $reset = Term::ANSIColor::color("reset");
-
-	# work out where the two strings start to differ
-	my $char = 0;
-	$char++ while substr($got, $char, 1) eq substr($wanted, $char, 1);
-
-	# get the start string and the two end strings
-	my $start     = $green . substr($wanted, 0,   $char);
-	my $gotend    = $red   . substr($got   , $char) . $reset;
-	my $wantedend = $red   . substr($wanted, $char) . $reset;
-
-	# make the start turn green on and off
-	$start =~ s/\n/$reset\n$green/g;
-
-	# make the ends turn red on and off
-	$gotend    =~ s/\n/$reset\n$red/g;
-	$wantedend =~ s/\n/$reset\n$red/g;
-
-	# rebuild the strings
-	$got    = $start . $gotend;
-	$wanted = $start . $wantedend;
-      }
+    if(Test::Builder::Tester::color) {
+        # get color
+        eval { require Term::ANSIColor };
+        unless($@) {
+            # colours
+
+            my $green = Term::ANSIColor::color("black") . Term::ANSIColor::color("on_green");
+            my $red   = Term::ANSIColor::color("black") . Term::ANSIColor::color("on_red");
+            my $reset = Term::ANSIColor::color("reset");
+
+            # work out where the two strings start to differ
+            my $char = 0;
+            $char++ while substr( $got, $char, 1 ) eq substr( $wanted, $char, 1 );
+
+            # get the start string and the two end strings
+            my $start = $green . substr( $wanted, 0, $char );
+            my $gotend    = $red . substr( $got,    $char ) . $reset;
+            my $wantedend = $red . substr( $wanted, $char ) . $reset;
+
+            # make the start turn green on and off
+            $start =~ s/\n/$reset\n$green/g;
+
+            # make the ends turn red on and off
+            $gotend    =~ s/\n/$reset\n$red/g;
+            $wantedend =~ s/\n/$reset\n$red/g;
+
+            # rebuild the strings
+            $got    = $start . $gotend;
+            $wanted = $start . $wantedend;
+        }
     }
 
-    return "$type is:\n" .
-           "$got\nnot:\n$wanted\nas expected"
+    return "$type is:\n" . "$got\nnot:\n$wanted\nas expected";
 }
 
 ##
 # forget all expected and got data
 
-sub reset
-{
+sub reset {
     my $self = shift;
-    @$self = ($self->[0], '', []);
+    %$self = (
+        type   => $self->{type},
+        got    => '',
+        wanted => [],
+    );
 }
 
-
-sub got
-{
+sub got {
     my $self = shift;
-    return $self->[1];
+    return $self->{got};
 }
 
-sub wanted
-{
+sub wanted {
     my $self = shift;
-    return $self->[2];
+    return $self->{wanted};
 }
 
-sub type
-{
+sub type {
     my $self = shift;
-    return $self->[0];
+    return $self->{type};
 }
 
 ###
 # tie interface
 ###
 
-sub PRINT  {
+sub PRINT {
     my $self = shift;
-    $self->[1] .= join '', @_;
+    $self->{got} .= join '', @_;
 }
 
 sub TIEHANDLE {
-    my($class, $type) = @_;
+    my( $class, $type ) = @_;
+
+    my $self = bless { type => $type }, $class;
 
-    my $self = bless [$type], $class;
     $self->reset;
 
     return $self;
 }
 
-sub READ {}
-sub READLINE {}
-sub GETC {}
-sub FILENO {}
+sub READ     { }
+sub READLINE { }
+sub GETC     { }
+sub FILENO   { }
 
 1;
diff --git a/gnu/usr.bin/perl/lib/Test/Builder/Tester/Color.pm b/gnu/usr.bin/perl/lib/Test/Builder/Tester/Color.pm
index b479e71a946..125ecc52857 100644
--- a/gnu/usr.bin/perl/lib/Test/Builder/Tester/Color.pm
+++ b/gnu/usr.bin/perl/lib/Test/Builder/Tester/Color.pm
@@ -25,8 +25,7 @@ from the command line.
 
 =cut
 
-sub import
-{
+sub import {
     Test::Builder::Tester::color(1);
 }
 
diff --git a/gnu/usr.bin/perl/lib/Test/More.pm b/gnu/usr.bin/perl/lib/Test/More.pm
index 9be5ea8b928..71611b88e89 100644
--- a/gnu/usr.bin/perl/lib/Test/More.pm
+++ b/gnu/usr.bin/perl/lib/Test/More.pm
@@ -1,50 +1,39 @@
 package Test::More;
 
-use 5.004;
-
+use 5.006;
 use strict;
-use Test::Builder;
+use warnings;
+
+#---- perlcritic exemptions. ----#
 
+# We use a lot of subroutine prototypes
+## no critic (Subroutines::ProhibitSubroutinePrototypes)
 
 # Can't use Carp because it might cause use_ok() to accidentally succeed
 # even though the module being used forgot to use Carp.  Yes, this
 # actually happened.
 sub _carp {
-    my($file, $line) = (caller(1))[1,2];
-    warn @_, " at $file line $line\n";
-}
-
-
-
-require Exporter;
-use vars qw($VERSION @ISA @EXPORT %EXPORT_TAGS $TODO);
-$VERSION = '0.45';
-@ISA    = qw(Exporter);
-@EXPORT = qw(ok use_ok require_ok
-             is isnt like unlike is_deeply
-             cmp_ok
-             skip todo todo_skip
-             pass fail
-             eq_array eq_hash eq_set
-             $TODO
-             plan
-             can_ok  isa_ok
-             diag
-            );
-
-my $Test = Test::Builder->new;
-
-
-# 5.004's Exporter doesn't have export_to_level.
-sub _export_to_level
-{
-      my $pkg = shift;
-      my $level = shift;
-      (undef) = shift;                  # redundant arg
-      my $callpkg = caller($level);
-      $pkg->export($callpkg, @_);
+    my( $file, $line ) = ( caller(1) )[ 1, 2 ];
+    return warn @_, " at $file line $line\n";
 }
 
+our $VERSION = '0.86';
+$VERSION = eval $VERSION;    ## no critic (BuiltinFunctions::ProhibitStringyEval)
+
+use Test::Builder::Module;
+our @ISA    = qw(Test::Builder::Module);
+our @EXPORT = qw(ok use_ok require_ok
+  is isnt like unlike is_deeply
+  cmp_ok
+  skip todo todo_skip
+  pass fail
+  eq_array eq_hash eq_set
+  $TODO
+  plan
+  can_ok isa_ok new_ok
+  diag note explain
+  BAIL_OUT
+);
 
 =head1 NAME
 
@@ -52,7 +41,7 @@ Test::More - yet another framework for writing test scripts
 
 =head1 SYNOPSIS
 
-  use Test::More tests => $Num_Tests;
+  use Test::More tests => 23;
   # or
   use Test::More qw(no_plan);
   # or
@@ -62,20 +51,20 @@ Test::More - yet another framework for writing test scripts
   require_ok( 'Some::Module' );
 
   # Various ways to say "ok"
-  ok($this eq $that, $test_name);
+  ok($got eq $expected, $test_name);
 
-  is  ($this, $that,    $test_name);
-  isnt($this, $that,    $test_name);
+  is  ($got, $expected, $test_name);
+  isnt($got, $expected, $test_name);
 
   # Rather than print STDERR "# here's what went wrong\n"
   diag("here's what went wrong");
 
-  like  ($this, qr/that/, $test_name);
-  unlike($this, qr/that/, $test_name);
+  like  ($got, qr/expected/, $test_name);
+  unlike($got, qr/expected/, $test_name);
 
-  cmp_ok($this, '==', $that, $test_name);
+  cmp_ok($got, '==', $expected, $test_name);
 
-  is_deeply($complex_structure1, $complex_structure2, $test_name);
+  is_deeply($got_complex_structure, $expected_complex_structure, $test_name);
 
   SKIP: {
       skip $why, $how_many unless $have_some_feature;
@@ -97,17 +86,11 @@ Test::More - yet another framework for writing test scripts
   pass($test_name);
   fail($test_name);
 
-  # Utility comparison functions.
-  eq_array(\@this, \@that);
-  eq_hash(\%this, \%that);
-  eq_set(\@this, \@that);
+  BAIL_OUT($why);
 
   # UNIMPLEMENTED!!!
   my @status = Test::More::status;
 
-  # UNIMPLEMENTED!!!
-  BAIL_OUT($why);
-
 
 =head1 DESCRIPTION
 
@@ -130,7 +113,7 @@ failure.
 
 The preferred way to do this is to declare a plan when you C<use Test::More>.
 
-  use Test::More tests => $Num_Tests;
+  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
@@ -138,6 +121,9 @@ have no plan.  (Try to avoid using this as it weakens your test.)
 
   use Test::More qw(no_plan);
 
+B<NOTE>: using no_plan requires a Test::Harness upgrade else it will
+think everything has failed.  See L<CAVEATS and NOTES>).
+
 In some cases, you'll want to completely skip an entire testing script.
 
   use Test::More skip_all => $skip_reason;
@@ -171,32 +157,37 @@ or for deciding between running the tests at all:
 =cut
 
 sub plan {
-    my(@plan) = @_;
+    my $tb = Test::More->builder;
+
+    return $tb->plan(@_);
+}
 
-    my $caller = caller;
+# This implements "use Test::More 'no_diag'" but the behavior is
+# deprecated.
+sub import_extra {
+    my $class = shift;
+    my $list  = shift;
 
-    $Test->exported_to($caller);
+    my @other = ();
+    my $idx   = 0;
+    while( $idx <= $#{$list} ) {
+        my $item = $list->[$idx];
 
-    my @imports = ();
-    foreach my $idx (0..$#plan) {
-        if( $plan[$idx] eq 'import' ) {
-            my($tag, $imports) = splice @plan, $idx, 2;
-            @imports = @$imports;
-            last;
+        if( defined $item and $item eq 'no_diag' ) {
+            $class->builder->no_diag(1);
+        }
+        else {
+            push @other, $item;
         }
-    }
 
-    $Test->plan(@plan);
+        $idx++;
+    }
 
-    __PACKAGE__->_export_to_level(1, __PACKAGE__, @imports);
-}
+    @$list = @other;
 
-sub import {
-    my($class) = shift;
-    goto &plan;
+    return;
 }
 
-
 =head2 Test names
 
 By convention, each test is assigned a number in order.  This is
@@ -235,9 +226,9 @@ respectively.
 
 =item B<ok>
 
-  ok($this eq $that, $test_name);
+  ok($got eq $expected, $test_name);
 
-This simply evaluates any expression (C<$this eq $that> is just a
+This simply evaluates any expression (C<$got eq $expected> is just a
 simple example) and uses that to determine if the test succeeded or
 failed.  A true expression passes, a false one fails.  Very simple.
 
@@ -258,23 +249,26 @@ but we B<very> strongly encourage its use.
 Should an ok() fail, it will produce some diagnostics:
 
     not ok 18 - sufficient mucus
-    #     Failed test 18 (foo.t at line 42)
+    #   Failed test 'sufficient mucus'
+    #   in foo.t at line 42.
 
-This is actually Test::Simple's ok() routine.
+This is the same as Test::Simple's ok() routine.
 
 =cut
 
 sub ok ($;$) {
-    my($test, $name) = @_;
-    $Test->ok($test, $name);
+    my( $test, $name ) = @_;
+    my $tb = Test::More->builder;
+
+    return $tb->ok( $test, $name );
 }
 
 =item B<is>
 
 =item B<isnt>
 
-  is  ( $this, $that, $test_name );
-  isnt( $this, $that, $test_name );
+  is  ( $got, $expected, $test_name );
+  isnt( $got, $expected, $test_name );
 
 Similar to ok(), is() and isnt() compare their two arguments
 with C<eq> and C<ne> respectively and use the result of that to
@@ -304,7 +298,8 @@ test:
 Will produce something like this:
 
     not ok 17 - Is foo the same as bar?
-    #     Failed test 1 (foo.t at line 139)
+    #   Failed test 'Is foo the same as bar?'
+    #   in foo.t at line 139.
     #          got: 'waffle'
     #     expected: 'yarblokos'
 
@@ -314,14 +309,14 @@ You are encouraged to use is() and isnt() over ok() where possible,
 however do not be tempted to use them to find out if something is
 true or false!
 
-  # XXX BAD!  $pope->isa('Catholic') eq 1
-  is( $pope->isa('Catholic'), 1,        'Is the Pope Catholic?' );
+  # XXX BAD!
+  is( exists $brooklyn{tree}, 1, 'A tree grows in Brooklyn' );
 
-This does not check if C<$pope->isa('Catholic')> is true, it checks if
+This does not check if C<exists $brooklyn{tree}> is true, it checks if
 it returns 1.  Very different.  Similar caveats exist for false and 0.
 In these cases, use ok().
 
-  ok( $pope->isa('Catholic') ),         'Is the Pope Catholic?' );
+  ok( exists $brooklyn{tree},    'A tree grows in Brooklyn' );
 
 For those grammatical pedants out there, there's an C<isn't()>
 function which is an alias of isnt().
@@ -329,29 +324,32 @@ function which is an alias of isnt().
 =cut
 
 sub is ($$;$) {
-    $Test->is_eq(@_);
+    my $tb = Test::More->builder;
+
+    return $tb->is_eq(@_);
 }
 
 sub isnt ($$;$) {
-    $Test->isnt_eq(@_);
+    my $tb = Test::More->builder;
+
+    return $tb->isnt_eq(@_);
 }
 
 *isn't = \&isnt;
 
-
 =item B<like>
 
-  like( $this, qr/that/, $test_name );
+  like( $got, qr/expected/, $test_name );
 
-Similar to ok(), like() matches $this against the regex C<qr/that/>.
+Similar to ok(), like() matches $got against the regex C<qr/expected/>.
 
 So this:
 
-    like($this, qr/that/, 'this is like that');
+    like($got, qr/expected/, 'this is like that');
 
 is similar to:
 
-    ok( $this =~ /that/, 'this is like that');
+    ok( $got =~ /expected/, 'this is like that');
 
 (Mnemonic "This is like that".)
 
@@ -360,9 +358,9 @@ regex reference (i.e. C<qr//>) or (for better compatibility with older
 perls) as a string that looks like a regex (alternative delimiters are
 currently not supported):
 
-    like( $this, '/that/', 'this is like that' );
+    like( $got, '/expected/', 'this is like that' );
 
-Regex options may be placed on the end (C<'/that/i'>).
+Regex options may be placed on the end (C<'/expected/i'>).
 
 Its advantages over ok() are similar to that of is() and isnt().  Better
 diagnostics on failure.
@@ -370,46 +368,48 @@ diagnostics on failure.
 =cut
 
 sub like ($$;$) {
-    $Test->like(@_);
-}
+    my $tb = Test::More->builder;
 
+    return $tb->like(@_);
+}
 
 =item B<unlike>
 
-  unlike( $this, qr/that/, $test_name );
+  unlike( $got, qr/expected/, $test_name );
 
-Works exactly as like(), only it checks if $this B<does not> match the
+Works exactly as like(), only it checks if $got B<does not> match the
 given pattern.
 
 =cut
 
-sub unlike {
-    $Test->unlike(@_);
-}
+sub unlike ($$;$) {
+    my $tb = Test::More->builder;
 
+    return $tb->unlike(@_);
+}
 
 =item B<cmp_ok>
 
-  cmp_ok( $this, $op, $that, $test_name );
+  cmp_ok( $got, $op, $expected, $test_name );
 
 Halfway between ok() and is() lies cmp_ok().  This allows you to
 compare two arguments using any binary perl operator.
 
-    # ok( $this eq $that );
-    cmp_ok( $this, 'eq', $that, 'this eq that' );
+    # ok( $got eq $expected );
+    cmp_ok( $got, 'eq', $expected, 'this eq that' );
 
-    # ok( $this == $that );
-    cmp_ok( $this, '==', $that, 'this == that' );
+    # ok( $got == $expected );
+    cmp_ok( $got, '==', $expected, 'this == that' );
 
-    # ok( $this && $that );
-    cmp_ok( $this, '&&', $that, 'this || that' );
+    # ok( $got && $expected );
+    cmp_ok( $got, '&&', $expected, 'this && that' );
     ...etc...
 
-Its advantage over ok() is when the test fails you'll know what $this
-and $that were:
+Its advantage over ok() is when the test fails you'll know what $got
+and $expected were:
 
     not ok 1
-    #     Failed test (foo.t at line 12)
+    #   Failed test in foo.t at line 12.
     #     '23'
     #         &&
     #     undef
@@ -422,9 +422,10 @@ is()'s use of C<eq> will interfere:
 =cut
 
 sub cmp_ok($$$;$) {
-    $Test->cmp_ok(@_);
-}
+    my $tb = Test::More->builder;
 
+    return $tb->cmp_ok(@_);
+}
 
 =item B<can_ok>
 
@@ -456,29 +457,33 @@ as one test.  If you desire otherwise, use:
 =cut
 
 sub can_ok ($@) {
-    my($proto, @methods) = @_;
+    my( $proto, @methods ) = @_;
     my $class = ref $proto || $proto;
+    my $tb = Test::More->builder;
+
+    unless($class) {
+        my $ok = $tb->ok( 0, "->can(...)" );
+        $tb->diag('    can_ok() called with empty class or reference');
+        return $ok;
+    }
 
-    unless( @methods ) {
-        my $ok = $Test->ok( 0, "$class->can(...)" );
-        $Test->diag('    can_ok() called with no methods');
+    unless(@methods) {
+        my $ok = $tb->ok( 0, "$class->can(...)" );
+        $tb->diag('    can_ok() called with no methods');
         return $ok;
     }
 
     my @nok = ();
     foreach my $method (@methods) {
-        local($!, $@);  # don't interfere with caller's $@
-                        # eval sometimes resets $!
-        eval { $proto->can($method) } || push @nok, $method;
+        $tb->_try( sub { $proto->can($method) } ) or push @nok, $method;
     }
 
-    my $name;
-    $name = @methods == 1 ? "$class->can('$methods[0]')" 
-                          : "$class->can(...)";
-    
-    my $ok = $Test->ok( !@nok, $name );
+    my $name = (@methods == 1) ? "$class->can('$methods[0]')" :
+                                 "$class->can(...)"           ;
+
+    my $ok = $tb->ok( !@nok, $name );
 
-    $Test->diag(map "    $class->can('$_') failed\n", @nok);
+    $tb->diag( map "    $class->can('$_') failed\n", @nok );
 
     return $ok;
 }
@@ -488,7 +493,7 @@ sub can_ok ($@) {
   isa_ok($object, $class, $object_name);
   isa_ok($ref,    $type,  $ref_name);
 
-Checks to see if the given $object->isa($class).  Also checks to make
+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
 of thing:
 
@@ -513,7 +518,8 @@ you'd like them to be more specific, you can supply an $object_name
 =cut
 
 sub isa_ok ($$;$) {
-    my($object, $class, $obj_name) = @_;
+    my( $object, $class, $obj_name ) = @_;
+    my $tb = Test::More->builder;
 
     my $diag;
     $obj_name = 'The object' unless defined $obj_name;
@@ -526,20 +532,20 @@ sub isa_ok ($$;$) {
     }
     else {
         # We can't use UNIVERSAL::isa because we want to honor isa() overrides
-        local($@, $!);  # eval sometimes resets $!
-        my $rslt = eval { $object->isa($class) };
-        if( $@ ) {
-            if( $@ =~ /^Can't call method "isa" on unblessed reference/ ) {
-                if( !UNIVERSAL::isa($object, $class) ) {
+        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
+                if( !UNIVERSAL::isa( $object, $class ) ) {
                     my $ref = ref $object;
                     $diag = "$obj_name isn't a '$class' it's a '$ref'";
                 }
-            } else {
+            }
+            else {
                 die <<WHOA;
 WHOA! I tried to call ->isa on your object and got some weird error.
-This should never happen.  Please contact the author immediately.
 Here's the error.
-$@
+$error
 WHOA
             }
         }
@@ -548,21 +554,62 @@ WHOA
             $diag = "$obj_name isn't a '$class' it's a '$ref'";
         }
     }
-            
-      
 
     my $ok;
-    if( $diag ) {
-        $ok = $Test->ok( 0, $name );
-        $Test->diag("    $diag\n");
+    if($diag) {
+        $ok = $tb->ok( 0, $name );
+        $tb->diag("    $diag\n");
     }
     else {
-        $ok = $Test->ok( 1, $name );
+        $ok = $tb->ok( 1, $name );
     }
 
     return $ok;
 }
 
+=item B<new_ok>
+
+  my $obj = new_ok( $class );
+  my $obj = new_ok( $class => \@args );
+  my $obj = new_ok( $class => \@args, $object_name );
+
+A convenience function which combines creating an object and calling
+isa_ok() on that object.
+
+It is basically equivalent to:
+
+    my $obj = $class->new(@args);
+    isa_ok $obj, $class, $object_name;
+
+If @args is not given, an empty list will be used.
+
+This function only works on new() and it assumes new() will return
+just a single object which isa C<$class>.
+
+=cut
+
+sub new_ok {
+    my $tb = Test::More->builder;
+    $tb->croak("new_ok() must be given at least a class") unless @_;
+
+    my( $class, $args, $object_name ) = @_;
+
+    $args ||= [];
+    $object_name = "The object" unless defined $object_name;
+
+    my $obj;
+    my( $success, $error ) = $tb->_try( sub { $obj = $class->new(@$args); 1 } );
+    if($success) {
+        local $Test::Builder::Level = $Test::Builder::Level + 1;
+        isa_ok $obj, $class, $object_name;
+    }
+    else {
+        $tb->ok( 0, "new() died" );
+        $tb->diag("    Error was:  $error");
+    }
+
+    return $obj;
+}
 
 =item B<pass>
 
@@ -582,56 +629,20 @@ Use these very, very, very sparingly.
 =cut
 
 sub pass (;$) {
-    $Test->ok(1, @_);
-}
+    my $tb = Test::More->builder;
 
-sub fail (;$) {
-    $Test->ok(0, @_);
+    return $tb->ok( 1, @_ );
 }
 
-=back
-
-=head2 Diagnostics
-
-If you pick the right test function, you'll usually get a good idea of
-what went wrong when it failed.  But sometimes it doesn't work out
-that way.  So here we have ways for you to write your own diagnostic
-messages which are safer than just C<print STDERR>.
-
-=over 4
-
-=item B<diag>
-
-  diag(@diagnostic_message);
-
-Prints a diagnostic message which is guaranteed not to interfere with
-test output.  Handy for this sort of thing:
-
-    ok( grep(/foo/, @users), "There's a foo user" ) or
-        diag("Since there's no foo, check that /etc/bar is set up right");
-
-which would produce:
-
-    not ok 42 - There's a foo user
-    #     Failed test (foo.t at line 52)
-    # Since there's no foo, check that /etc/bar is set up right.
-
-You might remember C<ok() or diag()> with the mnemonic C<open() or
-die()>.
-
-B<NOTE> The exact formatting of the diagnostic output is still
-changing, but it is guaranteed that whatever you throw at it it won't
-interfere with the test.
-
-=cut
+sub fail (;$) {
+    my $tb = Test::More->builder;
 
-sub diag {
-    $Test->diag(@_);
+    return $tb->ok( 0, @_ );
 }
 
-
 =back
 
+
 =head2 Module tests
 
 You usually want to test if the module you're testing loads ok, rather
@@ -658,7 +669,12 @@ is like doing this:
 
    use Some::Module qw(foo bar);
 
-don't try to do this:
+Version numbers can be checked like so:
+
+   # Just like "use Some::Module 1.02"
+   BEGIN { use_ok('Some::Module', 1.02) }
+
+Don't try to do this:
 
    BEGIN {
        use_ok('Some::Module');
@@ -667,7 +683,7 @@ don't try to do this:
        ...happening at compile time...
    }
 
-instead, you want:
+because the notion of "compile-time" is relative.  Instead, you want:
 
   BEGIN { use_ok('Some::Module') }
   BEGIN { ...some code that depends on the use... }
@@ -676,25 +692,40 @@ instead, you want:
 =cut
 
 sub use_ok ($;@) {
-    my($module, @imports) = @_;
+    my( $module, @imports ) = @_;
     @imports = () unless @imports;
+    my $tb = Test::More->builder;
 
-    my $pack = caller;
+    my( $pack, $filename, $line ) = caller;
 
-    local($@,$!);   # eval sometimes interferes with $!
-    eval <<USE;
+    my $code;
+    if( @imports == 1 and $imports[0] =~ /^\d+(?:\.\d+)?$/ ) {
+        # probably a version check.  Perl needs to see the bare number
+        # for it to work with non-Exporter based modules.
+        $code = <<USE;
 package $pack;
-require $module;
-'$module'->import(\@imports);
+use $module $imports[0];
+1;
+USE
+    }
+    else {
+        $code = <<USE;
+package $pack;
+use $module \@{\$args[0]};
+1;
 USE
+    }
 
-    my $ok = $Test->ok( !$@, "use $module;" );
+    my( $eval_result, $eval_error ) = _eval( $code, \@imports );
+    my $ok = $tb->ok( $eval_result, "use $module;" );
 
-    unless( $ok ) {
-        chomp $@;
-        $Test->diag(<<DIAGNOSTIC);
+    unless($ok) {
+        chomp $eval_error;
+        $@ =~ s{^BEGIN failed--compilation aborted at .*$}
+                {BEGIN failed--compilation aborted at $filename line $line.}m;
+        $tb->diag(<<DIAGNOSTIC);
     Tried to use '$module'.
-    Error:  $@
+    Error:  $eval_error
 DIAGNOSTIC
 
     }
@@ -702,32 +733,57 @@ DIAGNOSTIC
     return $ok;
 }
 
+sub _eval {
+    my( $code, @args ) = @_;
+
+    # Work around oddities surrounding resetting of $@ by immediately
+    # storing it.
+    my( $sigdie, $eval_result, $eval_error );
+    {
+        local( $@, $!, $SIG{__DIE__} );    # isolate eval
+        $eval_result = eval $code;              ## no critic (BuiltinFunctions::ProhibitStringyEval)
+        $eval_error  = $@;
+        $sigdie      = $SIG{__DIE__} || undef;
+    }
+    # make sure that $code got a chance to set $SIG{__DIE__}
+    $SIG{__DIE__} = $sigdie if defined $sigdie;
+
+    return( $eval_result, $eval_error );
+}
+
 =item B<require_ok>
 
    require_ok($module);
+   require_ok($file);
 
-Like use_ok(), except it requires the $module.
+Like use_ok(), except it requires the $module or $file.
 
 =cut
 
 sub require_ok ($) {
     my($module) = shift;
+    my $tb = Test::More->builder;
 
     my $pack = caller;
 
-    local($!, $@); # eval sometimes interferes with $!
-    eval <<REQUIRE;
+    # Try to deterine if we've been given a module name or file.
+    # Module names must be barewords, files not.
+    $module = qq['$module'] unless _is_module_name($module);
+
+    my $code = <<REQUIRE;
 package $pack;
 require $module;
+1;
 REQUIRE
 
-    my $ok = $Test->ok( !$@, "require $module;" );
+    my( $eval_result, $eval_error ) = _eval($code);
+    my $ok = $tb->ok( $eval_result, "require $module;" );
 
-    unless( $ok ) {
-        chomp $@;
-        $Test->diag(<<DIAGNOSTIC);
+    unless($ok) {
+        chomp $eval_error;
+        $tb->diag(<<DIAGNOSTIC);
     Tried to require '$module'.
-    Error:  $@
+    Error:  $eval_error
 DIAGNOSTIC
 
     }
@@ -735,8 +791,245 @@ DIAGNOSTIC
     return $ok;
 }
 
+sub _is_module_name {
+    my $module = shift;
+
+    # Module names start with a letter.
+    # End with an alphanumeric.
+    # The rest is an alphanumeric or ::
+    $module =~ s/\b::\b//g;
+
+    return $module =~ /^[a-zA-Z]\w*$/ ? 1 : 0;
+}
+
 =back
 
+
+=head2 Complex data structures
+
+Not everything is a simple eq check or regex.  There are times you
+need to see if two data structures are equivalent.  For these
+instances Test::More provides a handful of useful functions.
+
+B<NOTE> I'm not quite sure what will happen with filehandles.
+
+=over 4
+
+=item B<is_deeply>
+
+  is_deeply( $got, $expected, $test_name );
+
+Similar to is(), except that if $got and $expected are references, it
+does a deep comparison walking each data structure to see if they are
+equivalent.  If the two structures are different, it will display the
+place where they start differing.
+
+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
+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
+along these lines.
+
+=cut
+
+our( @Data_Stack, %Refs_Seen );
+my $DNE = bless [], 'Does::Not::Exist';
+
+sub _dne {
+    return ref $_[0] eq ref $DNE;
+}
+
+## no critic (Subroutines::RequireArgUnpacking)
+sub is_deeply {
+    my $tb = Test::More->builder;
+
+    unless( @_ == 2 or @_ == 3 ) {
+        my $msg = <<'WARNING';
+is_deeply() takes two or three args, you gave %d.
+This usually means you passed an array or hash instead 
+of a reference to it
+WARNING
+        chop $msg;    # clip off newline so carp() will put in line/file
+
+        _carp sprintf $msg, scalar @_;
+
+        return $tb->ok(0);
+    }
+
+    my( $got, $expected, $name ) = @_;
+
+    $tb->_unoverload_str( \$expected, \$got );
+
+    my $ok;
+    if( !ref $got and !ref $expected ) {    # neither is a reference
+        $ok = $tb->is_eq( $got, $expected, $name );
+    }
+    elsif( !ref $got xor !ref $expected ) {    # one's a reference, one isn't
+        $ok = $tb->ok( 0, $name );
+        $tb->diag( _format_stack({ vals => [ $got, $expected ] }) );
+    }
+    else {                                     # both references
+        local @Data_Stack = ();
+        if( _deep_check( $got, $expected ) ) {
+            $ok = $tb->ok( 1, $name );
+        }
+        else {
+            $ok = $tb->ok( 0, $name );
+            $tb->diag( _format_stack(@Data_Stack) );
+        }
+    }
+
+    return $ok;
+}
+
+sub _format_stack {
+    my(@Stack) = @_;
+
+    my $var       = '$FOO';
+    my $did_arrow = 0;
+    foreach my $entry (@Stack) {
+        my $type = $entry->{type} || '';
+        my $idx = $entry->{'idx'};
+        if( $type eq 'HASH' ) {
+            $var .= "->" unless $did_arrow++;
+            $var .= "{$idx}";
+        }
+        elsif( $type eq 'ARRAY' ) {
+            $var .= "->" unless $did_arrow++;
+            $var .= "[$idx]";
+        }
+        elsif( $type eq 'REF' ) {
+            $var = "\${$var}";
+        }
+    }
+
+    my @vals = @{ $Stack[-1]{vals} }[ 0, 1 ];
+    my @vars = ();
+    ( $vars[0] = $var ) =~ s/\$FOO/     \$got/;
+    ( $vars[1] = $var ) =~ s/\$FOO/\$expected/;
+
+    my $out = "Structures begin differing at:\n";
+    foreach my $idx ( 0 .. $#vals ) {
+        my $val = $vals[$idx];
+        $vals[$idx]
+          = !defined $val ? 'undef'
+          : _dne($val)    ? "Does not exist"
+          : ref $val      ? "$val"
+          :                 "'$val'";
+    }
+
+    $out .= "$vars[0] = $vals[0]\n";
+    $out .= "$vars[1] = $vals[1]\n";
+
+    $out =~ s/^/    /msg;
+    return $out;
+}
+
+sub _type {
+    my $thing = shift;
+
+    return '' if !ref $thing;
+
+    for my $type (qw(ARRAY HASH REF SCALAR GLOB CODE Regexp)) {
+        return $type if UNIVERSAL::isa( $thing, $type );
+    }
+
+    return '';
+}
+
+=back
+
+
+=head2 Diagnostics
+
+If you pick the right test function, you'll usually get a good idea of
+what went wrong when it failed.  But sometimes it doesn't work out
+that way.  So here we have ways for you to write your own diagnostic
+messages which are safer than just C<print STDERR>.
+
+=over 4
+
+=item B<diag>
+
+  diag(@diagnostic_message);
+
+Prints a diagnostic message which is guaranteed not to interfere with
+test output.  Like C<print> @diagnostic_message is simply concatenated
+together.
+
+Returns false, so as to preserve failure.
+
+Handy for this sort of thing:
+
+    ok( grep(/foo/, @users), "There's a foo user" ) or
+        diag("Since there's no foo, check that /etc/bar is set up right");
+
+which would produce:
+
+    not ok 42 - There's a foo user
+    #   Failed test 'There's a foo user'
+    #   in foo.t at line 52.
+    # Since there's no foo, check that /etc/bar is set up right.
+
+You might remember C<ok() or diag()> with the mnemonic C<open() or
+die()>.
+
+B<NOTE> The exact formatting of the diagnostic output is still
+changing, but it is guaranteed that whatever you throw at it it won't
+interfere with the test.
+
+=item B<note>
+
+  note(@diagnostic_message);
+
+Like diag(), except the message will not be seen when the test is run
+in a harness.  It will only be visible in the verbose TAP stream.
+
+Handy for putting in notes which might be useful for debugging, but
+don't indicate a problem.
+
+    note("Tempfile is $tempfile");
+
+=cut
+
+sub diag {
+    return Test::More->builder->diag(@_);
+}
+
+sub note {
+    return Test::More->builder->note(@_);
+}
+
+=item B<explain>
+
+  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>.
+
+Handy for things like...
+
+    is_deeply($have, $want) || diag explain $have;
+
+or
+
+    note explain \%args;
+    Some::Class->method(%args);
+
+=cut
+
+sub explain {
+    return Test::More->builder->explain(@_);
+}
+
+=back
+
+
 =head2 Conditional tests
 
 Sometimes running a test under certain conditions will cause the
@@ -773,17 +1066,19 @@ the easiest way to illustrate:
         skip "HTML::Lint not installed", 2 if $@;
 
         my $lint = new HTML::Lint;
-        ok( $lint, "Created object" );
+        isa_ok( $lint, "HTML::Lint" );
 
         $lint->parse( $html );
-        is( scalar $lint->errors, 0, "No errors found in HTML" );
+        is( $lint->errors, 0, "No errors found in HTML" );
     }
 
 If the user does not have HTML::Lint installed, the whole block of
 code I<won't be run at all>.  Test::More will output special ok's
 which Test::Harness interprets as skipped, but passing, tests.
+
 It's important that $how_many accurately reflects the number of tests
 in the SKIP block so the # of tests run will match up with your plan.
+If your plan is C<no_plan> $how_many is optional and will default to 1.
 
 It's perfectly safe to nest SKIP blocks.  Each SKIP block must have
 the label C<SKIP>, or Test::More can't work its magic.
@@ -794,26 +1089,32 @@ use TODO.  Read on.
 
 =cut
 
-#'#
+## no critic (Subroutines::RequireFinalReturn)
 sub skip {
-    my($why, $how_many) = @_;
+    my( $why, $how_many ) = @_;
+    my $tb = Test::More->builder;
 
     unless( defined $how_many ) {
         # $how_many can only be avoided when no_plan is in use.
         _carp "skip() needs to know \$how_many tests are in the block"
-          unless $Test::Builder::No_Plan;
+          unless $tb->has_plan eq 'no_plan';
         $how_many = 1;
     }
 
-    for( 1..$how_many ) {
-        $Test->skip($why);
+    if( defined $how_many and $how_many =~ /\D/ ) {
+        _carp
+          "skip() was passed a non-numeric number of tests.  Did you get the arguments backwards?";
+        $how_many = 1;
+    }
+
+    for( 1 .. $how_many ) {
+        $tb->skip($why);
     }
 
-    local $^W = 0;
+    no warnings 'exiting';
     last SKIP;
 }
 
-
 =item B<TODO: BLOCK>
 
     TODO: {
@@ -851,6 +1152,9 @@ and you'll know immediately when they're fixed.
 Once a todo test starts succeeding, simply move it outside the block.
 When the block is empty, delete it.
 
+B<NOTE>: TODO tests require a Test::Harness upgrade else it will
+treat it as a normal failure.  See L<CAVEATS and NOTES>).
+
 
 =item B<todo_skip>
 
@@ -873,20 +1177,21 @@ interpret them as passing.
 =cut
 
 sub todo_skip {
-    my($why, $how_many) = @_;
+    my( $why, $how_many ) = @_;
+    my $tb = Test::More->builder;
 
     unless( defined $how_many ) {
         # $how_many can only be avoided when no_plan is in use.
         _carp "todo_skip() needs to know \$how_many tests are in the block"
-          unless $Test::Builder::No_Plan;
+          unless $tb->has_plan eq 'no_plan';
         $how_many = 1;
     }
 
-    for( 1..$how_many ) {
-        $Test->todo_skip($why);
+    for( 1 .. $how_many ) {
+        $tb->todo_skip($why);
     }
 
-    local $^W = 0;
+    no warnings 'exiting';
     last TODO;
 }
 
@@ -904,101 +1209,59 @@ but want to put tests in your testing script (always a good idea).
 
 =back
 
-=head2 Comparison functions
-
-Not everything is a simple eq check or regex.  There are times you
-need to see if two arrays are equivalent, for instance.  For these
-instances, Test::More provides a handful of useful functions.
 
-B<NOTE> These are NOT well-tested on circular references.  Nor am I
-quite sure what will happen with filehandles.
+=head2 Test control
 
 =over 4
 
-=item B<is_deeply>
+=item B<BAIL_OUT>
 
-  is_deeply( $this, $that, $test_name );
+    BAIL_OUT($reason);
 
-Similar to is(), except that if $this and $that are hash or array
-references, it does a deep comparison walking each data structure to
-see if they are equivalent.  If the two structures are different, it
-will display the place where they start differing.
+Indicates to the harness that things are going so badly all testing
+should terminate.  This includes the running any additional test scripts.
 
-Barrie Slaymaker's Test::Differences module provides more in-depth
-functionality along these lines, and it plays well with Test::More.
+This is typically used when testing cannot continue such as a critical
+module failing to compile or a necessary external utility not being
+available such as a database connection failing.
 
-B<NOTE> Display of scalar refs is not quite 100%
+The test will exit with 255.
 
 =cut
 
-use vars qw(@Data_Stack);
-my $DNE = bless [], 'Does::Not::Exist';
-sub is_deeply {
-    my($this, $that, $name) = @_;
+sub BAIL_OUT {
+    my $reason = shift;
+    my $tb     = Test::More->builder;
 
-    my $ok;
-    if( !ref $this || !ref $that ) {
-        $ok = $Test->is_eq($this, $that, $name);
-    }
-    else {
-        local @Data_Stack = ();
-        if( _deep_check($this, $that) ) {
-            $ok = $Test->ok(1, $name);
-        }
-        else {
-            $ok = $Test->ok(0, $name);
-            $ok = $Test->diag(_format_stack(@Data_Stack));
-        }
-    }
-
-    return $ok;
+    $tb->BAIL_OUT($reason);
 }
 
-sub _format_stack {
-    my(@Stack) = @_;
+=back
 
-    my $var = '$FOO';
-    my $did_arrow = 0;
-    foreach my $entry (@Stack) {
-        my $type = $entry->{type} || '';
-        my $idx  = $entry->{'idx'};
-        if( $type eq 'HASH' ) {
-            $var .= "->" unless $did_arrow++;
-            $var .= "{$idx}";
-        }
-        elsif( $type eq 'ARRAY' ) {
-            $var .= "->" unless $did_arrow++;
-            $var .= "[$idx]";
-        }
-        elsif( $type eq 'REF' ) {
-            $var = "\${$var}";
-        }
-    }
 
-    my @vals = @{$Stack[-1]{vals}}[0,1];
-    my @vars = ();
-    ($vars[0] = $var) =~ s/\$FOO/     \$got/;
-    ($vars[1] = $var) =~ s/\$FOO/\$expected/;
+=head2 Discouraged comparison functions
 
-    my $out = "Structures begin differing at:\n";
-    foreach my $idx (0..$#vals) {
-        my $val = $vals[$idx];
-        $vals[$idx] = !defined $val ? 'undef' : 
-                      $val eq $DNE  ? "Does not exist"
-                                    : "'$val'";
-    }
+The use of the following functions is discouraged as they are not
+actually testing functions and produce no diagnostics to help figure
+out what went wrong.  They were written before is_deeply() existed
+because I couldn't figure out how to display a useful diff of two
+arbitrary data structures.
 
-    $out .= "$vars[0] = $vals[0]\n";
-    $out .= "$vars[1] = $vals[1]\n";
+These functions are usually used inside an ok().
 
-    $out =~ s/^/    /msg;
-    return $out;
-}
+    ok( eq_array(\@got, \@expected) );
+
+C<is_deeply()> can do that better and with diagnostics.  
+
+    is_deeply( \@got, \@expected );
 
+They may be deprecated in future versions.
+
+=over 4
 
 =item B<eq_array>
 
-  eq_array(\@this, \@that);
+  my $is_eq = eq_array(\@got, \@expected);
 
 Checks if two arrays are equivalent.  This is a deep check, so
 multi-level structures are handled correctly.
@@ -1006,64 +1269,108 @@ multi-level structures are handled correctly.
 =cut
 
 #'#
-sub eq_array  {
-    my($a1, $a2) = @_;
+sub eq_array {
+    local @Data_Stack = ();
+    _deep_check(@_);
+}
+
+sub _eq_array {
+    my( $a1, $a2 ) = @_;
+
+    if( grep _type($_) ne 'ARRAY', $a1, $a2 ) {
+        warn "eq_array passed a non-array ref";
+        return 0;
+    }
+
     return 1 if $a1 eq $a2;
 
     my $ok = 1;
     my $max = $#$a1 > $#$a2 ? $#$a1 : $#$a2;
-    for (0..$max) {
+    for( 0 .. $max ) {
         my $e1 = $_ > $#$a1 ? $DNE : $a1->[$_];
         my $e2 = $_ > $#$a2 ? $DNE : $a2->[$_];
 
-        push @Data_Stack, { type => 'ARRAY', idx => $_, vals => [$e1, $e2] };
-        $ok = _deep_check($e1,$e2);
+        push @Data_Stack, { type => 'ARRAY', idx => $_, vals => [ $e1, $e2 ] };
+        $ok = _deep_check( $e1, $e2 );
         pop @Data_Stack if $ok;
 
         last unless $ok;
     }
+
     return $ok;
 }
 
 sub _deep_check {
-    my($e1, $e2) = @_;
+    my( $e1, $e2 ) = @_;
+    my $tb = Test::More->builder;
+
     my $ok = 0;
 
-    my $eq;
+    # Effectively turn %Refs_Seen into a stack.  This avoids picking up
+    # the same referenced used twice (such as [\$a, \$a]) to be considered
+    # circular.
+    local %Refs_Seen = %Refs_Seen;
+
     {
         # Quiet uninitialized value warnings when comparing undefs.
-        local $^W = 0; 
+        no warnings 'uninitialized';
+
+        $tb->_unoverload_str( \$e1, \$e2 );
+
+        # Either they're both references or both not.
+        my $same_ref = !( !ref $e1 xor !ref $e2 );
+        my $not_ref = ( !ref $e1 and !ref $e2 );
 
-        if( $e1 eq $e2 ) {
+        if( defined $e1 xor defined $e2 ) {
+            $ok = 0;
+        }
+        elsif( _dne($e1) xor _dne($e2) ) {
+            $ok = 0;
+        }
+        elsif( $same_ref and( $e1 eq $e2 ) ) {
             $ok = 1;
         }
+        elsif($not_ref) {
+            push @Data_Stack, { type => '', vals => [ $e1, $e2 ] };
+            $ok = 0;
+        }
         else {
-            if( UNIVERSAL::isa($e1, 'ARRAY') and
-                UNIVERSAL::isa($e2, 'ARRAY') )
-            {
-                $ok = eq_array($e1, $e2);
+            if( $Refs_Seen{$e1} ) {
+                return $Refs_Seen{$e1} eq $e2;
+            }
+            else {
+                $Refs_Seen{$e1} = "$e2";
+            }
+
+            my $type = _type($e1);
+            $type = 'DIFFERENT' unless _type($e2) eq $type;
+
+            if( $type eq 'DIFFERENT' ) {
+                push @Data_Stack, { type => $type, vals => [ $e1, $e2 ] };
+                $ok = 0;
+            }
+            elsif( $type eq 'ARRAY' ) {
+                $ok = _eq_array( $e1, $e2 );
+            }
+            elsif( $type eq 'HASH' ) {
+                $ok = _eq_hash( $e1, $e2 );
             }
-            elsif( UNIVERSAL::isa($e1, 'HASH') and
-                   UNIVERSAL::isa($e2, 'HASH') )
-            {
-                $ok = eq_hash($e1, $e2);
+            elsif( $type eq 'REF' ) {
+                push @Data_Stack, { type => $type, vals => [ $e1, $e2 ] };
+                $ok = _deep_check( $$e1, $$e2 );
+                pop @Data_Stack if $ok;
             }
-            elsif( UNIVERSAL::isa($e1, 'REF') and
-                   UNIVERSAL::isa($e2, 'REF') )
-            {
-                push @Data_Stack, { type => 'REF', vals => [$e1, $e2] };
-                $ok = _deep_check($$e1, $$e2);
+            elsif( $type eq 'SCALAR' ) {
+                push @Data_Stack, { type => 'REF', vals => [ $e1, $e2 ] };
+                $ok = _deep_check( $$e1, $$e2 );
                 pop @Data_Stack if $ok;
             }
-            elsif( UNIVERSAL::isa($e1, 'SCALAR') and
-                   UNIVERSAL::isa($e2, 'SCALAR') )
-            {
-                push @Data_Stack, { type => 'REF', vals => [$e1, $e2] };
-                $ok = _deep_check($$e1, $$e2);
+            elsif($type) {
+                push @Data_Stack, { type => $type, vals => [ $e1, $e2 ] };
+                $ok = 0;
             }
             else {
-                push @Data_Stack, { vals => [$e1, $e2] };
-                $ok = 0;
+                _whoa( 1, "No type in _deep_check" );
             }
         }
     }
@@ -1071,10 +1378,19 @@ sub _deep_check {
     return $ok;
 }
 
+sub _whoa {
+    my( $check, $desc ) = @_;
+    if($check) {
+        die <<"WHOA";
+WHOA!  $desc
+This should never happen!  Please contact the author immediately!
+WHOA
+    }
+}
 
 =item B<eq_hash>
 
-  eq_hash(\%this, \%that);
+  my $is_eq = eq_hash(\%got, \%expected);
 
 Determines if the two hashes contain the same keys and values.  This
 is a deep check.
@@ -1082,17 +1398,28 @@ is a deep check.
 =cut
 
 sub eq_hash {
-    my($a1, $a2) = @_;
+    local @Data_Stack = ();
+    return _deep_check(@_);
+}
+
+sub _eq_hash {
+    my( $a1, $a2 ) = @_;
+
+    if( grep _type($_) ne 'HASH', $a1, $a2 ) {
+        warn "eq_hash passed a non-hash ref";
+        return 0;
+    }
+
     return 1 if $a1 eq $a2;
 
     my $ok = 1;
     my $bigger = keys %$a1 > keys %$a2 ? $a1 : $a2;
-    foreach my $k (keys %$bigger) {
+    foreach my $k ( keys %$bigger ) {
         my $e1 = exists $a1->{$k} ? $a1->{$k} : $DNE;
         my $e2 = exists $a2->{$k} ? $a2->{$k} : $DNE;
 
-        push @Data_Stack, { type => 'HASH', idx => $k, vals => [$e1, $e2] };
-        $ok = _deep_check($e1, $e2);
+        push @Data_Stack, { type => 'HASH', idx => $k, vals => [ $e1, $e2 ] };
+        $ok = _deep_check( $e1, $e2 );
         pop @Data_Stack if $ok;
 
         last unless $ok;
@@ -1103,25 +1430,51 @@ sub eq_hash {
 
 =item B<eq_set>
 
-  eq_set(\@this, \@that);
+  my $is_eq = eq_set(\@got, \@expected);
 
 Similar to eq_array(), except the order of the elements is B<not>
 important.  This is a deep check, but the irrelevancy of order only
 applies to the top level.
 
-=cut
+    ok( eq_set(\@got, \@expected) );
+
+Is better written:
+
+    is_deeply( [sort @got], [sort @expected] );
+
+B<NOTE> By historical accident, this is not a true set comparison.
+While the order of elements does not matter, duplicate elements do.
 
-# We must make sure that references are treated neutrally.  It really
-# doesn't matter how we sort them, as long as both arrays are sorted
-# with the same algorithm.
-sub _bogus_sort { local $^W = 0;  ref $a ? 0 : $a cmp $b }
+B<NOTE> eq_set() does not know how to deal with references at the top
+level.  The following is an example of a comparison which might not work:
 
-sub eq_set  {
-    my($a1, $a2) = @_;
+    eq_set([\1, \2], [\2, \1]);
+
+Test::Deep contains much better set comparison functions.
+
+=cut
+
+sub eq_set {
+    my( $a1, $a2 ) = @_;
     return 0 unless @$a1 == @$a2;
 
-    # There's faster ways to do this, but this is easiest.
-    return eq_array( [sort _bogus_sort @$a1], [sort _bogus_sort @$a2] );
+    no warnings 'uninitialized';
+
+    # It really doesn't matter how we sort them, as long as both arrays are
+    # sorted with the same algorithm.
+    #
+    # Ensure that references are not accidentally treated the same as a
+    # string containing the reference.
+    #
+    # Have to inline the sort routine due to a threading/sort bug.
+    # See [rt.cpan.org 6782]
+    #
+    # I don't know how references would be sorted so we just don't sort
+    # them.  This means eq_set doesn't really work with refs.
+    return eq_array(
+        [ grep( ref, @$a1 ), sort( grep( !ref, @$a1 ) ) ],
+        [ grep( ref, @$a2 ), sort( grep( !ref, @$a2 ) ) ],
+    );
 }
 
 =back
@@ -1147,33 +1500,72 @@ you can access the underlying Test::Builder object like so:
 Returns the Test::Builder object underlying Test::More for you to play
 with.
 
-=cut
-
-sub builder {
-    return Test::Builder->new;
-}
 
 =back
 
 
-=head1 NOTES
+=head1 EXIT CODES
+
+If all your tests passed, Test::Builder will exit with zero (which is
+normal).  If anything failed it will exit with how many failed.  If
+you run less (or more) tests than you planned, the missing (or extras)
+will be considered failures.  If no tests were ever run Test::Builder
+will throw a warning and exit with 255.  If the test died, even after
+having successfully completed all its tests, it will still be
+considered a failure and will exit with 255.
+
+So the exit codes are...
+
+    0                   all tests successful
+    255                 test died or all passed but wrong # of tests run
+    any other number    how many failed (including missing or extras)
+
+If you fail more than 254 tests, it will be reported as 254.
 
-Test::More is B<explicitly> tested all the way back to perl 5.004.
+B<NOTE>  This behavior may go away in future versions.
 
-Test::More is thread-safe for perl 5.8.0 and up.
 
-=head1 BUGS and CAVEATS
+=head1 CAVEATS and NOTES
 
 =over 4
 
-=item Making your own ok()
+=item Backwards compatibility
+
+Test::More works with Perls as old as 5.6.0.
+
+
+=item Overloaded objects
+
+String overloaded objects are compared B<as strings> (or in cmp_ok()'s
+case, strings or numbers as appropriate to the comparison op).  This
+prevents Test::More from piercing an object's interface allowing
+better blackbox testing.  So if a function starts returning overloaded
+objects instead of bare strings your tests won't notice the
+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
+complex data structures.
+
 
-If you are trying to extend Test::More, don't.  Use Test::Builder
-instead.
+=item Threads
 
-=item The eq_* family has some caveats.
+Test::More will only be aware of threads if "use threads" has been done
+I<before> Test::More is loaded.  This is ok:
 
-=item Test::Harness upgrades
+    use threads;
+    use Test::More;
+
+This may cause problems:
+
+    use Test::More
+    use threads;
+
+5.8.1 and above are supported.  Anything below that has too many bugs.
+
+
+=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
@@ -1181,8 +1573,7 @@ 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.
 
-If you simply depend on Test::More, it's own dependencies will cause a
-Test::Harness upgrade.
+Installing Test::More should also upgrade Test::Harness.
 
 =back
 
@@ -1208,34 +1599,44 @@ L<Test::Simple> if all this confuses you and you just want to write
 some tests.  You can upgrade to Test::More later (it's forward
 compatible).
 
+L<Test::Harness> is the test runner and output interpreter for Perl.
+It's the thing that powers C<make test> and where the C<prove> utility
+comes from.
+
+L<Test::Legacy> tests written with Test.pm, the original testing
+module, do not play well with other testing libraries.  Test::Legacy
+emulates the Test.pm interface and does play well with others.
+
 L<Test::Differences> for more ways to test complex data structures.
 And it plays well with Test::More.
 
-L<Test> is the old testing module.  Its main benefit is that it has
-been distributed with Perl since 5.004_05.
-
-L<Test::Harness> for details on how your test results are interpreted
-by Perl.
+L<Test::Class> is like xUnit but more perlish.
 
-L<Test::Unit> describes a very featureful unit testing interface.
+L<Test::Deep> gives you more powerful complex data structure testing.
 
 L<Test::Inline> shows the idea of embedded testing.
 
-L<SelfTest> is another approach to embedded testing.
+L<Bundle::Test> installs a whole bunch of useful test modules.
 
 
 =head1 AUTHORS
 
 Michael G Schwern E<lt>schwern@pobox.comE<gt> with much inspiration
 from Joshua Pritikin's Test module and lots of help from Barrie
-Slaymaker, Tony Bowden, chromatic and the perl-qa gang.
+Slaymaker, Tony Bowden, blackstar.co.uk, chromatic, Fergal Daly and
+the perl-qa gang.
+
+
+=head1 BUGS
+
+See F<http://rt.cpan.org> to report and view bugs.
 
 
 =head1 COPYRIGHT
 
-Copyright 2001 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
+Copyright 2001-2008 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
 
-This program is free software; you can redistribute it and/or 
+This program is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
 
 See F<http://www.perl.com/perl/misc/Artistic.html>
diff --git a/gnu/usr.bin/perl/lib/Test/Simple.pm b/gnu/usr.bin/perl/lib/Test/Simple.pm
index 464fffd782f..319c7b23b39 100644
--- a/gnu/usr.bin/perl/lib/Test/Simple.pm
+++ b/gnu/usr.bin/perl/lib/Test/Simple.pm
@@ -2,23 +2,16 @@ package Test::Simple;
 
 use 5.004;
 
-use strict 'vars';
-use vars qw($VERSION);
-$VERSION = '0.45';
+use strict;
 
+our $VERSION = '0.86';
+$VERSION = eval $VERSION;    ## no critic (BuiltinFunctions::ProhibitStringyEval)
 
-use Test::Builder;
-my $Test = Test::Builder->new;
-
-sub import {
-    my $self = shift;
-    my $caller = caller;
-    *{$caller.'::ok'} = \&ok;
-
-    $Test->exported_to($caller);
-    $Test->plan(@_);
-}
+use Test::Builder::Module;
+our @ISA    = qw(Test::Builder::Module);
+our @EXPORT = qw(ok);
 
+my $CLASS = __PACKAGE__;
 
 =head1 NAME
 
@@ -83,11 +76,10 @@ will do what you mean (fail if stuff is empty)
 
 =cut
 
-sub ok ($;$) {
-    $Test->ok(@_);
+sub ok ($;$) {    ## no critic (Subroutines::ProhibitSubroutinePrototypes)
+    return $CLASS->builder->ok(@_);
 }
 
-
 =back
 
 Test::Simple will start by printing number of tests run in the form
@@ -106,7 +98,7 @@ considered a failure and will exit with 255.
 So the exit codes are...
 
     0                   all tests successful
-    255                 test died
+    255                 test died or all passed but wrong # of tests run
     any other number    how many failed (including missing or extras)
 
 If you fail more than 254 tests, it will be reported as 254.
@@ -129,7 +121,7 @@ Here's an example of a simple .t file for the fictional Film module.
                              Rating   => 'R',
                              NumExplodingSheep => 1
                            });
-    ok( defined($btaste) and ref $btaste eq 'Film',     'new() works' );
+    ok( defined($btaste) && ref $btaste eq 'Film,     'new() works' );
 
     ok( $btaste->Title      eq 'Bad Taste',     'Title() get'    );
     ok( $btaste->Director   eq 'Peter Jackson', 'Director() get' );
@@ -143,7 +135,8 @@ It will produce output like this:
     ok 2 - Title() get
     ok 3 - Director() get
     not ok 4 - Rating() get
-    #    Failed test (t/film.t at line 14)
+    #   Failed test 'Rating() get'
+    #   in t/film.t at line 14.
     ok 5 - NumExplodingSheep() get
     # Looks like you failed 1 tests of 5
 
@@ -196,24 +189,10 @@ Test::More.  Test::Simple is 100% forward compatible with Test::More
 (i.e. you can just use Test::More instead of Test::Simple in your
 programs and things will still work).
 
-=item L<Test>
-
-The original Perl testing module.
-
-=item L<Test::Unit>
-
-Elaborate unit testing.
-
-=item L<Test::Inline>, L<SelfTest>
-
-Embed tests in your code!
-
-=item L<Test::Harness>
-
-Interprets the output of your test program.
-
 =back
 
+Look in Test::More's SEE ALSO for more testing modules.
+
 
 =head1 AUTHORS
 
@@ -223,7 +202,7 @@ E<lt>schwern@pobox.comE<gt>, wardrobe by Calvin Klein.
 
 =head1 COPYRIGHT
 
-Copyright 2001 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
+Copyright 2001-2008 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
 
 This program is free software; you can redistribute it and/or 
 modify it under the same terms as Perl itself.
diff --git a/gnu/usr.bin/perl/lib/Test/t/00test_harness_check.t b/gnu/usr.bin/perl/lib/Test/t/00test_harness_check.t
new file mode 100644
index 00000000000..3ff4a13c639
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Test/t/00test_harness_check.t
@@ -0,0 +1,26 @@
+#!/usr/bin/perl -w
+
+# A test to make sure the new Test::Harness was installed properly.
+
+use Test::More;
+plan tests => 1;
+
+my $TH_Version = 2.03;
+
+require Test::Harness;
+unless( cmp_ok( eval $Test::Harness::VERSION, '>=', $TH_Version, "T::H version" ) ) {
+    diag <<INSTRUCTIONS;
+
+Test::Simple/More/Builder has features which depend on a version of
+Test::Harness greater than $TH_Version.  You have $Test::Harness::VERSION.
+Please install a new version from CPAN.
+
+If you've already tried to upgrade Test::Harness and still get this
+message, the new version may be "shadowed" by the old.  Check the
+output of Test::Harness's "make install" for "## Differing version"
+messages.  You can delete the old version by running 
+"make install UNINST=1".
+
+INSTRUCTIONS
+}
+
diff --git a/gnu/usr.bin/perl/lib/Test/t/BEGIN_require_ok.t b/gnu/usr.bin/perl/lib/Test/t/BEGIN_require_ok.t
new file mode 100644
index 00000000000..289ebc564f3
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Test/t/BEGIN_require_ok.t
@@ -0,0 +1,24 @@
+#!/usr/bin/perl -w
+
+BEGIN {
+    if( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = ('../lib', 'lib');
+    }
+    else {
+        unshift @INC, 't/lib';
+    }
+}
+
+use Test::More;
+
+my $result;
+BEGIN {
+    eval {
+        require_ok("Wibble");
+    };
+    $result = $@;
+}
+
+plan tests => 1;
+like $result, '/^You tried to run a test without a plan/';
diff --git a/gnu/usr.bin/perl/lib/Test/t/BEGIN_use_ok.t b/gnu/usr.bin/perl/lib/Test/t/BEGIN_use_ok.t
new file mode 100644
index 00000000000..26caaa127e6
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Test/t/BEGIN_use_ok.t
@@ -0,0 +1,28 @@
+#!/usr/bin/perl -w
+
+# [rt.cpan.org 28345]
+#
+# A use_ok() inside a BEGIN block lacking a plan would be silently ignored.
+
+BEGIN {
+    if( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = ('../lib', 'lib');
+    }
+    else {
+        unshift @INC, 't/lib';
+    }
+}
+
+use Test::More;
+
+my $result;
+BEGIN {
+    eval {
+        use_ok("Wibble");
+    };
+    $result = $@;
+}
+
+plan tests => 1;
+like $result, '/^You tried to run a test without a plan/';
diff --git a/gnu/usr.bin/perl/lib/Test/t/More.t b/gnu/usr.bin/perl/lib/Test/t/More.t
new file mode 100644
index 00000000000..eabd0fa8a42
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Test/t/More.t
@@ -0,0 +1,174 @@
+#!perl -w
+
+BEGIN {
+    if( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = qw(../lib ../lib/Test/Simple/t/lib);
+    }
+}
+
+use lib 't/lib';
+use Test::More tests => 52;
+
+# Make sure we don't mess with $@ or $!.  Test at bottom.
+my $Err   = "this should not be touched";
+my $Errno = 42;
+$@ = $Err;
+$! = $Errno;
+
+use_ok('Dummy');
+is( $Dummy::VERSION, '0.01', 'use_ok() loads a module' );
+require_ok('Test::More');
+
+
+ok( 2 eq 2,             'two is two is two is two' );
+is(   "foo", "foo",       'foo is foo' );
+isnt( "foo", "bar",     'foo isnt bar');
+isn't("foo", "bar",     'foo isn\'t bar');
+
+#'#
+like("fooble", '/^foo/',    'foo is like fooble');
+like("FooBle", '/foo/i',   'foo is like FooBle');
+like("/usr/local/pr0n/", '/^\/usr\/local/',   'regexes with slashes in like' );
+
+unlike("fbar", '/^bar/',    'unlike bar');
+unlike("FooBle", '/foo/',   'foo is unlike FooBle');
+unlike("/var/local/pr0n/", '/^\/usr\/local/','regexes with slashes in unlike' );
+
+my @foo = qw(foo bar baz);
+unlike(@foo, '/foo/');
+
+can_ok('Test::More', qw(require_ok use_ok ok is isnt like skip can_ok
+                        pass fail eq_array eq_hash eq_set));
+can_ok(bless({}, "Test::More"), qw(require_ok use_ok ok is isnt like skip 
+                                   can_ok pass fail eq_array eq_hash eq_set));
+
+
+isa_ok(bless([], "Foo"), "Foo");
+isa_ok([], 'ARRAY');
+isa_ok(\42, 'SCALAR');
+
+
+# can_ok() & isa_ok should call can() & isa() on the given object, not 
+# just class, in case of custom can()
+{
+       local *Foo::can;
+       local *Foo::isa;
+       *Foo::can = sub { $_[0]->[0] };
+       *Foo::isa = sub { $_[0]->[0] };
+       my $foo = bless([0], 'Foo');
+       ok( ! $foo->can('bar') );
+       ok( ! $foo->isa('bar') );
+       $foo->[0] = 1;
+       can_ok( $foo, 'blah');
+       isa_ok( $foo, 'blah');
+}
+
+
+pass('pass() passed');
+
+ok( eq_array([qw(this that whatever)], [qw(this that whatever)]),
+    'eq_array with simple arrays' );
+is @Test::More::Data_Stack, 0, '@Data_Stack not holding onto things';
+
+ok( eq_hash({ foo => 42, bar => 23 }, {bar => 23, foo => 42}),
+    'eq_hash with simple hashes' );
+is @Test::More::Data_Stack, 0;
+
+ok( eq_set([qw(this that whatever)], [qw(that whatever this)]),
+    'eq_set with simple sets' );
+is @Test::More::Data_Stack, 0;
+
+my @complex_array1 = (
+                      [qw(this that whatever)],
+                      {foo => 23, bar => 42},
+                      "moo",
+                      "yarrow",
+                      [qw(498 10 29)],
+                     );
+my @complex_array2 = (
+                      [qw(this that whatever)],
+                      {foo => 23, bar => 42},
+                      "moo",
+                      "yarrow",
+                      [qw(498 10 29)],
+                     );
+
+is_deeply( \@complex_array1, \@complex_array2,    'is_deeply with arrays' );
+ok( eq_array(\@complex_array1, \@complex_array2),
+    'eq_array with complicated arrays' );
+ok( eq_set(\@complex_array1, \@complex_array2),
+    'eq_set with complicated arrays' );
+
+my @array1 = (qw(this that whatever),
+              {foo => 23, bar => 42} );
+my @array2 = (qw(this that whatever),
+              {foo => 24, bar => 42} );
+
+ok( !eq_array(\@array1, \@array2),
+    'eq_array with slightly different complicated arrays' );
+is @Test::More::Data_Stack, 0;
+
+ok( !eq_set(\@array1, \@array2),
+    'eq_set with slightly different complicated arrays' );
+is @Test::More::Data_Stack, 0;
+
+my %hash1 = ( foo => 23,
+              bar => [qw(this that whatever)],
+              har => { foo => 24, bar => 42 },
+            );
+my %hash2 = ( foo => 23,
+              bar => [qw(this that whatever)],
+              har => { foo => 24, bar => 42 },
+            );
+
+is_deeply( \%hash1, \%hash2,    'is_deeply with complicated hashes' );
+ok( eq_hash(\%hash1, \%hash2),  'eq_hash with complicated hashes');
+
+%hash1 = ( foo => 23,
+           bar => [qw(this that whatever)],
+           har => { foo => 24, bar => 42 },
+         );
+%hash2 = ( foo => 23,
+           bar => [qw(this tha whatever)],
+           har => { foo => 24, bar => 42 },
+         );
+
+ok( !eq_hash(\%hash1, \%hash2),
+    'eq_hash with slightly different complicated hashes' );
+is @Test::More::Data_Stack, 0;
+
+is( Test::Builder->new, Test::More->builder,    'builder()' );
+
+
+cmp_ok(42, '==', 42,        'cmp_ok ==');
+cmp_ok('foo', 'eq', 'foo',  '       eq');
+cmp_ok(42.5, '<', 42.6,     '       <');
+cmp_ok(0, '||', 1,          '       ||');
+
+
+# Piers pointed out sometimes people override isa().
+{
+    package Wibble;
+    sub isa {
+        my($self, $class) = @_;
+        return 1 if $class eq 'Wibblemeister';
+    }
+    sub new { bless {} }
+}
+isa_ok( Wibble->new, 'Wibblemeister' );
+
+my $sub = sub {};
+is_deeply( $sub, $sub, 'the same function ref' );
+
+use Symbol;
+my $glob = gensym;
+is_deeply( $glob, $glob, 'the same glob' );
+
+is_deeply( { foo => $sub, bar => [1, $glob] },
+           { foo => $sub, bar => [1, $glob] }
+         );
+
+# These two tests must remain at the end.
+is( $@, $Err,               '$@ untouched' );
+cmp_ok( $!, '==', $Errno,   '$! untouched' );
diff --git a/gnu/usr.bin/perl/lib/Test/t/bad_plan.t b/gnu/usr.bin/perl/lib/Test/t/bad_plan.t
new file mode 100644
index 00000000000..442fee86f09
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Test/t/bad_plan.t
@@ -0,0 +1,38 @@
+#!/usr/bin/perl -w
+
+BEGIN {
+    if( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = '../lib';
+    }
+}
+
+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;
+
+print "1..2\n";
+
+eval { $Test->plan(7); };
+ok( $@ =~ /^plan\(\) doesn't understand 7/, 'bad plan()' ) ||
+    print STDERR "# $@";
+
+eval { $Test->plan(wibble => 7); };
+ok( $@ =~ /^plan\(\) doesn't understand wibble 7/, 'bad plan()' ) ||
+    print STDERR "# $@";
+
diff --git a/gnu/usr.bin/perl/lib/Test/t/bail_out.t b/gnu/usr.bin/perl/lib/Test/t/bail_out.t
new file mode 100644
index 00000000000..d60c1509a4e
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Test/t/bail_out.t
@@ -0,0 +1,51 @@
+#!/usr/bin/perl -w
+
+BEGIN {
+    if( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = ('../lib', 'lib');
+    }
+    else {
+        unshift @INC, 't/lib';
+    }
+}
+
+my $Exit_Code;
+BEGIN {
+    *CORE::GLOBAL::exit = sub { $Exit_Code = shift; };
+}
+
+
+use Test::Builder;
+use Test::More;
+use TieOut;
+
+my $output = tie *FAKEOUT, 'TieOut';
+my $TB = Test::More->builder;
+$TB->output(\*FAKEOUT);
+
+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');
+}
+
+
+plan tests => 4;
+
+BAIL_OUT("ROCKS FALL! EVERYONE DIES!");
+
+
+$Test->is_eq( $output->read, <<'OUT' );
+1..4
+Bail out!  ROCKS FALL! EVERYONE DIES!
+OUT
+
+$Test->is_eq( $Exit_Code, 255 );
+
+$Test->ok( $Test->can("BAILOUT"), "Backwards compat" );
diff --git a/gnu/usr.bin/perl/lib/Test/t/buffer.t b/gnu/usr.bin/perl/lib/Test/t/buffer.t
new file mode 100644
index 00000000000..6039e4a6f72
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Test/t/buffer.t
@@ -0,0 +1,22 @@
+#!/usr/bin/perl
+
+BEGIN {
+    if( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = '../lib';
+    }
+}
+
+# Ensure that intermixed prints to STDOUT and tests come out in the
+# right order (ie. no buffering problems).
+
+use Test::More tests => 20;
+my $T = Test::Builder->new;
+$T->no_ending(1);
+
+for my $num (1..10) {
+    $tnum = $num * 2;
+    pass("I'm ok");
+    $T->current_test($tnum);
+    print "ok $tnum - You're ok\n";
+}
diff --git a/gnu/usr.bin/perl/lib/Test/t/c_flag.t b/gnu/usr.bin/perl/lib/Test/t/c_flag.t
new file mode 100644
index 00000000000..a33963415ed
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Test/t/c_flag.t
@@ -0,0 +1,21 @@
+#!/usr/bin/perl -w
+
+# Test::More should not print anything when Perl is only doing
+# a compile as with the -c flag or B::Deparse or perlcc.
+
+# HARNESS_ACTIVE=1 was causing an error with -c
+{
+    local $ENV{HARNESS_ACTIVE} = 1;
+    local $^C = 1;
+
+    require Test::More;
+    Test::More->import(tests => 1);
+
+    fail("This should not show up");
+}
+
+Test::More->builder->no_ending(1);
+
+print "1..1\n";
+print "ok 1\n";
+
diff --git a/gnu/usr.bin/perl/lib/Test/t/circular_data.t b/gnu/usr.bin/perl/lib/Test/t/circular_data.t
new file mode 100644
index 00000000000..2fd819e1f4a
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Test/t/circular_data.t
@@ -0,0 +1,71 @@
+#!/usr/bin/perl -w
+
+# Test is_deeply and friends with circular data structures [rt.cpan.org 7289]
+
+BEGIN {
+    if( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = ('../lib', 'lib');
+    }
+    else {
+        unshift @INC, 't/lib';
+    }
+}
+
+use strict;
+use Test::More tests => 11;
+
+my $a1 = [ 1, 2, 3 ];
+push @$a1, $a1;
+my $a2 = [ 1, 2, 3 ];
+push @$a2, $a2;
+
+is_deeply $a1, $a2;
+ok( eq_array ($a1, $a2) );
+ok( eq_set   ($a1, $a2) );
+
+my $h1 = { 1=>1, 2=>2, 3=>3 };
+$h1->{4} = $h1;
+my $h2 = { 1=>1, 2=>2, 3=>3 };
+$h2->{4} = $h2;
+
+is_deeply $h1, $h2;
+ok( eq_hash  ($h1, $h2) );
+
+my ($r, $s);
+
+$r = \$r;
+$s = \$s;
+
+ok( eq_array ([$s], [$r]) );
+
+
+{
+    # Classic set of circular scalar refs.
+    my($a,$b,$c);
+    $a = \$b;
+    $b = \$c;
+    $c = \$a;
+
+    my($d,$e,$f);
+    $d = \$e;
+    $e = \$f;
+    $f = \$d;
+
+    is_deeply( $a, $a );
+    is_deeply( $a, $d );
+}
+
+
+{
+    # rt.cpan.org 11623
+    # Make sure the circular ref checks don't get confused by a reference 
+    # which is simply repeating.
+    my $a = {};
+    my $b = {};
+    my $c = {};
+
+    is_deeply( [$a, $a], [$b, $c] );
+    is_deeply( { foo => $a, bar => $a }, { foo => $b, bar => $c } );
+    is_deeply( [\$a, \$a], [\$b, \$c] );
+}
diff --git a/gnu/usr.bin/perl/lib/Test/t/cmp_ok.t b/gnu/usr.bin/perl/lib/Test/t/cmp_ok.t
new file mode 100644
index 00000000000..5741fa0f82d
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Test/t/cmp_ok.t
@@ -0,0 +1,75 @@
+#!/usr/bin/perl -w
+
+BEGIN {
+    if( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = ('../lib', 'lib');
+    }
+    else {
+        unshift @INC, 't/lib';
+    }
+}
+
+use strict;
+
+require Test::Simple::Catch;
+my($out, $err) = Test::Simple::Catch::caught();
+local $ENV{HARNESS_ACTIVE} = 0;
+
+require Test::Builder;
+my $TB = Test::Builder->create;
+$TB->level(0);
+
+sub try_cmp_ok {
+    my($left, $cmp, $right) = @_;
+    
+    my %expect;
+    $expect{ok}    = eval "\$left $cmp \$right";
+    $expect{error} = $@;
+    $expect{error} =~ s/ at .*\n?//;
+
+    local $Test::Builder::Level = $Test::Builder::Level + 1;
+    my $ok = cmp_ok($left, $cmp, $right, "cmp_ok");
+    $TB->is_num(!!$ok, !!$expect{ok}, "  right return");
+    
+    my $diag = $err->read;
+    if( !$ok and $expect{error} ) {
+        $diag =~ s/^# //mg;
+        $TB->like( $diag, qr/\Q$expect{error}\E/, "  expected error" );
+    }
+    elsif( $ok ) {
+        $TB->is_eq( $diag, '', "  passed without diagnostic" );
+    }
+    else {
+        $TB->ok(1, "  failed without diagnostic");
+    }
+}
+
+
+use Test::More;
+Test::More->builder->no_ending(1);
+
+require MyOverload;
+my $cmp = Overloaded::Compare->new("foo", 42);
+my $ify = Overloaded::Ify->new("bar", 23);
+
+my @Tests = (
+    [1, '==', 1],
+    [1, '==', 2],
+    ["a", "eq", "b"],
+    ["a", "eq", "a"],
+    [1, "+", 1],
+    [1, "-", 1],
+
+    [$cmp, '==', 42],
+    [$cmp, 'eq', "foo"],
+    [$ify, 'eq', "bar"],
+    [$ify, "==", 23],
+);
+
+plan tests => scalar @Tests;
+$TB->plan(tests => @Tests * 2);
+
+for my $test (@Tests) {
+    try_cmp_ok(@$test);
+}
diff --git a/gnu/usr.bin/perl/lib/Test/t/diag.t b/gnu/usr.bin/perl/lib/Test/t/diag.t
new file mode 100644
index 00000000000..912725199ec
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Test/t/diag.t
@@ -0,0 +1,89 @@
+#!perl -w
+
+BEGIN {
+    if( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = ('../lib', 'lib');
+    }
+    else {
+        unshift @INC, 't/lib';
+    }
+}
+
+
+# Turn on threads here, if available, since this test tends to find
+# lots of threading bugs.
+use Config;
+BEGIN {
+    if( $] >= 5.008001 && $Config{useithreads} ) {
+        require threads;
+        'threads'->import;
+    }
+}
+
+
+use strict;
+
+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';
+
+
+# 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' );
+# a single line
+DIAG
+
+    my $ret = $test->diag("multiple\n", "lines");
+    is( $output->read, <<'DIAG',   '  multi line' );
+# multiple
+# lines
+DIAG
+    ok( !$ret, 'diag returns false' );
+
+    $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" );
+
+    $test->diag("foo\n\nbar");
+    is( $output->read, <<'DIAG', "  blank lines get escaped" );
+# foo
+# 
+# bar
+DIAG
+
+
+    $test->diag("foo\n\nbar\n\n");
+    is( $output->read, <<'DIAG', "  even at the end" );
+# foo
+# 
+# bar
+# 
+DIAG
+}
+
+
+# [rt.cpan.org 8392]
+{
+    $test->diag(qw(one two));
+}
+is( $output->read, <<'DIAG' );
+# onetwo
+DIAG
diff --git a/gnu/usr.bin/perl/lib/Test/t/died.t b/gnu/usr.bin/perl/lib/Test/t/died.t
new file mode 100644
index 00000000000..b4ee2fbbffd
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Test/t/died.t
@@ -0,0 +1,45 @@
+#!perl -w
+
+BEGIN {
+    if( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = '../lib';
+    }
+}
+
+# Can't use Test.pm, that's a 5.005 thing.
+package My::Test;
+
+# This has to be a require or else the END block below runs before
+# Test::Builder's own and the ending diagnostics don't come out right.
+require Test::Builder;
+my $TB = Test::Builder->create;
+$TB->plan(tests => 3);
+
+
+package main;
+
+require Test::Simple;
+
+chdir 't';
+push @INC, '../t/lib/';
+require Test::Simple::Catch;
+my($out, $err) = Test::Simple::Catch::caught();
+local $ENV{HARNESS_ACTIVE} = 0;
+
+Test::Simple->import(tests => 1);
+exit 250;
+
+END {
+    $TB->is_eq($out->read, <<OUT);
+1..1
+OUT
+
+    $TB->is_eq($err->read, <<ERR);
+# Looks like your test exited with 250 before it could output anything.
+ERR
+
+    $TB->is_eq($?, 250, "exit code");
+
+    exit grep { !$_ } $TB->summary;
+}
diff --git a/gnu/usr.bin/perl/lib/Test/t/dont_overwrite_die_handler.t b/gnu/usr.bin/perl/lib/Test/t/dont_overwrite_die_handler.t
new file mode 100644
index 00000000000..0657a06ca33
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Test/t/dont_overwrite_die_handler.t
@@ -0,0 +1,19 @@
+#!/usr/bin/perl -w
+
+BEGIN {
+    if( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = '../lib';
+    }
+}
+
+# Make sure this is in place before Test::More is loaded.
+my $handler_called;
+BEGIN {
+    $SIG{__DIE__} = sub { $handler_called++ };
+}
+
+use Test::More tests => 2;
+
+ok !eval { die };
+is $handler_called, 1, 'existing DIE handler not overridden';
diff --git a/gnu/usr.bin/perl/lib/Test/t/eq_set.t b/gnu/usr.bin/perl/lib/Test/t/eq_set.t
new file mode 100644
index 00000000000..fbdc52db1fa
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Test/t/eq_set.t
@@ -0,0 +1,34 @@
+#!perl -w
+
+BEGIN {
+    if( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = ('../lib', 'lib');
+    }
+    else {
+        unshift @INC, 't/lib';
+    }
+}
+chdir 't';
+
+use strict;
+use Test::More;
+
+plan tests => 4;
+
+# RT 3747
+ok( eq_set([1, 2, [3]], [[3], 1, 2]) );
+ok( eq_set([1,2,[3]], [1,[3],2]) );
+
+# bugs.perl.org 36354
+my $ref = \2;
+ok( eq_set( [$ref, "$ref", "$ref", $ref],
+            ["$ref", $ref, $ref, "$ref"] 
+          ) );
+
+TODO: {
+    local $TODO = q[eq_set() doesn't really handle references];
+
+    ok( eq_set( [\1, \2, \3], [\2, \3, \1] ) );
+}
+
diff --git a/gnu/usr.bin/perl/lib/Test/t/exit.t b/gnu/usr.bin/perl/lib/Test/t/exit.t
new file mode 100644
index 00000000000..d20452ed043
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Test/t/exit.t
@@ -0,0 +1,97 @@
+#!/usr/bin/perl -w
+
+# Can't use Test.pm, that's a 5.005 thing.
+package My::Test;
+
+BEGIN {
+    if( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = '../lib';
+    }
+}
+
+unless( eval { require File::Spec } ) {
+    print "1..0 # Skip Need File::Spec to run this test\n";
+    exit 0;
+}
+
+if( $^O eq 'VMS' && $] <= 5.00503 ) {
+    print "1..0 # Skip test will hang on older VMS perls\n";
+    exit 0;
+}
+
+if( $^O eq 'MacOS' ) {
+    print "1..0 # Skip exit status broken on Mac OS\n";
+    exit 0;
+}
+
+require Test::Builder;
+my $TB = Test::Builder->create();
+$TB->level(0);
+
+
+package main;
+
+my $IsVMS = $^O eq 'VMS';
+
+print "# Ahh!  I see you're running VMS.\n" if $IsVMS;
+
+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],
+            );
+
+$TB->plan( tests => scalar keys(%Tests) );
+
+eval { require POSIX; &POSIX::WEXITSTATUS(0) };
+if( $@ ) {
+    *exitstatus = sub { $_[0] >> 8 };
+}
+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];
+
+    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 $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,
+                      "$test_name exited with $actual_exit ".
+                      "(expected $exit_code)");
+    }
+    else {
+        $TB->is_num( $actual_exit, $exit_code, 
+                      "$test_name exited with $actual_exit ".
+                      "(expected $exit_code)");
+    }
+}
diff --git a/gnu/usr.bin/perl/lib/Test/t/explain.t b/gnu/usr.bin/perl/lib/Test/t/explain.t
new file mode 100644
index 00000000000..cf2f550e950
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Test/t/explain.t
@@ -0,0 +1,27 @@
+#!/usr/bin/perl -w
+
+BEGIN {
+    if( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = ('../lib', 'lib');
+    }
+    else {
+        unshift @INC, 't/lib';
+    }
+}
+
+use strict;
+use warnings;
+
+use Test::More tests => 5;
+
+can_ok "main", "explain";
+
+is_deeply [explain("foo")],             ["foo"];
+is_deeply [explain("foo", "bar")],      ["foo", "bar"];
+
+# Avoid future dump formatting changes from breaking tests by just eval'ing
+# the dump
+is_deeply [map { eval $_ } explain([], {})],           [[], {}];
+
+is_deeply [map { eval $_ } explain(23, [42,91], 99)],  [23, [42, 91], 99];
diff --git a/gnu/usr.bin/perl/lib/Test/t/extra.t b/gnu/usr.bin/perl/lib/Test/t/extra.t
new file mode 100644
index 00000000000..57235be1956
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Test/t/extra.t
@@ -0,0 +1,59 @@
+#!perl -w
+
+BEGIN {
+    if( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = '../lib';
+    }
+}
+
+# Can't use Test.pm, that's a 5.005 thing.
+package My::Test;
+
+# This has to be a require or else the END block below runs before
+# Test::Builder's own and the ending diagnostics don't come out right.
+require Test::Builder;
+my $TB = Test::Builder->create;
+$TB->plan(tests => 2);
+
+
+package main;
+
+require Test::Simple;
+
+chdir 't';
+push @INC, '../t/lib/';
+require Test::Simple::Catch;
+my($out, $err) = Test::Simple::Catch::caught();
+local $ENV{HARNESS_ACTIVE} = 0;
+
+Test::Simple->import(tests => 3);
+
+#line 30
+ok(1, 'Foo');
+ok(0, 'Bar');
+ok(1, 'Yar');
+ok(1, 'Car');
+ok(0, 'Sar');
+
+END {
+    $TB->is_eq($$out, <<OUT);
+1..3
+ok 1 - Foo
+not ok 2 - Bar
+ok 3 - Yar
+ok 4 - Car
+not ok 5 - Sar
+OUT
+
+    $TB->is_eq($$err, <<ERR);
+#   Failed test 'Bar'
+#   at $0 line 31.
+#   Failed test 'Sar'
+#   at $0 line 34.
+# Looks like you planned 3 tests but ran 5.
+# Looks like you failed 2 tests of 5 run.
+ERR
+
+    exit 0;
+}
diff --git a/gnu/usr.bin/perl/lib/Test/t/extra_one.t b/gnu/usr.bin/perl/lib/Test/t/extra_one.t
new file mode 100644
index 00000000000..d77404e15de
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Test/t/extra_one.t
@@ -0,0 +1,52 @@
+#!/usr/bin/perl -w
+
+BEGIN {
+    if( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = ('../lib', 'lib');
+    }
+    else {
+        unshift @INC, 't/lib';
+    }
+}
+
+use strict;
+
+require Test::Simple::Catch;
+my($out, $err) = Test::Simple::Catch::caught();
+
+# Can't use Test.pm, that's a 5.005 thing.
+package My::Test;
+
+# This has to be a require or else the END block below runs before
+# Test::Builder's own and the ending diagnostics don't come out right.
+require Test::Builder;
+my $TB = Test::Builder->create;
+$TB->plan(tests => 2);
+
+sub is { $TB->is_eq(@_) }
+
+
+package main;
+
+require Test::Simple;
+Test::Simple->import(tests => 1);
+ok(1);
+ok(1);
+ok(1);
+
+END {
+    My::Test::is($$out, <<OUT);
+1..1
+ok 1
+ok 2
+ok 3
+OUT
+
+    My::Test::is($$err, <<ERR);
+# Looks like you planned 1 test but ran 3.
+ERR
+
+    # Prevent Test::Simple from existing with non-zero
+    exit 0;
+}
diff --git a/gnu/usr.bin/perl/lib/Test/t/fail-like.t b/gnu/usr.bin/perl/lib/Test/t/fail-like.t
new file mode 100644
index 00000000000..a0ee7305893
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Test/t/fail-like.t
@@ -0,0 +1,74 @@
+#!/usr/bin/perl -w
+
+BEGIN {
+    if( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = ('../lib', 'lib');
+    }
+    else {
+        unshift @INC, 't/lib';
+    }
+}
+
+# There was a bug with like() involving a qr// not failing properly.
+# This tests against that.
+
+use strict;
+
+
+# Can't use Test.pm, that's a 5.005 thing.
+package My::Test;
+
+# This has to be a require or else the END block below runs before
+# Test::Builder's own and the ending diagnostics don't come out right.
+require Test::Builder;
+my $TB = Test::Builder->create;
+$TB->plan(tests => 4);
+
+
+require Test::Simple::Catch;
+my($out, $err) = Test::Simple::Catch::caught();
+local $ENV{HARNESS_ACTIVE} = 0;
+
+
+package main;
+
+require Test::More;
+Test::More->import(tests => 1);
+
+{
+    eval q{ like( "foo", qr/that/, 'is foo like that' ); };
+
+    $TB->is_eq($out->read, <<OUT, 'failing output');
+1..1
+not ok 1 - is foo like that
+OUT
+
+    my $err_re = <<ERR;
+#   Failed test 'is foo like that'
+#   at .* line 1\.
+#                   'foo'
+#     doesn't match '\\(\\?-xism:that\\)'
+ERR
+
+    $TB->like($err->read, qr/^$err_re$/, 'failing errors');
+}
+
+{
+    # line 60
+    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.
+#     'not a regex' doesn't look much like a regex to me.
+OUT
+
+}
+
+END {
+    # Test::More thinks it failed.  Override that.
+    exit(scalar grep { !$_ } $TB->summary);
+}
diff --git a/gnu/usr.bin/perl/lib/Test/t/fail-more.t b/gnu/usr.bin/perl/lib/Test/t/fail-more.t
new file mode 100644
index 00000000000..3af7456a1be
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Test/t/fail-more.t
@@ -0,0 +1,388 @@
+#!perl -w
+
+BEGIN {
+    if( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = ('../lib', 'lib');
+    }
+    else {
+        unshift @INC, 't/lib';
+    }
+}
+
+use strict;
+
+require Test::Simple::Catch;
+my($out, $err) = Test::Simple::Catch::caught();
+local $ENV{HARNESS_ACTIVE} = 0;
+
+
+# Can't use Test.pm, that's a 5.005 thing.
+package My::Test;
+
+# This has to be a require or else the END block below runs before
+# 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);
+
+sub like ($$;$) {
+    $TB->like(@_);
+}
+
+sub is ($$;$) {
+    $TB->is_eq(@_);
+}
+
+sub main::err_ok ($) {
+    my($expect) = @_;
+    my $got = $err->read;
+
+    return $TB->is_eq( $got, $expect );
+}
+
+sub main::err_like ($) {
+    my($expect) = @_;
+    my $got = $err->read;
+
+    return $TB->like( $got, qr/$expect/ );
+}
+
+
+package main;
+
+require Test::More;
+my $Total = 36;
+Test::More->import(tests => $Total);
+
+# This should all work in the presence of a __DIE__ handler.
+local $SIG{__DIE__} = sub { $TB->ok(0, "DIE handler called: ".join "", @_); };
+
+
+my $tb = Test::More->builder;
+$tb->use_numbers(0);
+
+my $Filename = quotemeta $0;
+
+# Preserve the line numbers.
+#line 38
+ok( 0, 'failing' );
+err_ok( <<ERR );
+#   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 );
+#   Failed test 'foo is bar?'
+#   at $0 line 40.
+#          got: 'foo'
+#     expected: 'bar'
+#   Failed test 'undef is empty string?'
+#   at $0 line 41.
+#          got: undef
+#     expected: ''
+#   Failed test 'undef is 0?'
+#   at $0 line 42.
+#          got: undef
+#     expected: '0'
+#   Failed test 'empty string is 0?'
+#   at $0 line 43.
+#          got: ''
+#     expected: '0'
+ERR
+
+#line 45
+isnt("foo", "foo", 'foo isnt foo?' );
+isn't("foo", "foo",'foo isn\'t foo?' );
+isnt(undef, undef, 'undef isnt undef?');
+err_ok( <<ERR );
+#   Failed test 'foo isnt foo?'
+#   at $0 line 45.
+#          got: 'foo'
+#     expected: anything else
+#   Failed test 'foo isn\'t foo?'
+#   at $0 line 46.
+#          got: 'foo'
+#     expected: anything else
+#   Failed test 'undef isnt undef?'
+#   at $0 line 47.
+#          got: undef
+#     expected: anything else
+ERR
+
+#line 48
+like( "foo", '/that/',  'is foo like that' );
+unlike( "foo", '/foo/', 'is foo unlike foo' );
+err_ok( <<ERR );
+#   Failed test 'is foo like that'
+#   at $0 line 48.
+#                   'foo'
+#     doesn't match '/that/'
+#   Failed test 'is foo unlike foo'
+#   at $0 line 49.
+#                   'foo'
+#           matches '/foo/'
+ERR
+
+# Nick Clark found this was a bug.  Fixed in 0.40.
+# line 60
+like( "bug", '/(%)/',   'regex with % in it' );
+err_ok( <<ERR );
+#   Failed test 'regex with % in it'
+#   at $0 line 60.
+#                   'bug'
+#     doesn't match '/(%)/'
+ERR
+
+#line 67
+fail('fail()');
+err_ok( <<ERR );
+#   Failed test 'fail()'
+#   at $0 line 67.
+ERR
+
+#line 52
+can_ok('Mooble::Hooble::Yooble', qw(this that));
+can_ok('Mooble::Hooble::Yooble', ());
+can_ok(undef, undef);
+can_ok([], "foo");
+err_ok( <<ERR );
+#   Failed test 'Mooble::Hooble::Yooble->can(...)'
+#   at $0 line 52.
+#     Mooble::Hooble::Yooble->can('this') failed
+#     Mooble::Hooble::Yooble->can('that') failed
+#   Failed test 'Mooble::Hooble::Yooble->can(...)'
+#   at $0 line 53.
+#     can_ok() called with no methods
+#   Failed test '->can(...)'
+#   at $0 line 54.
+#     can_ok() called with empty class or reference
+#   Failed test 'ARRAY->can('foo')'
+#   at $0 line 55.
+#     ARRAY->can('foo') failed
+ERR
+
+#line 55
+isa_ok(bless([], "Foo"), "Wibble");
+isa_ok(42,    "Wibble", "My Wibble");
+isa_ok(undef, "Wibble", "Another Wibble");
+isa_ok([],    "HASH");
+err_ok( <<ERR );
+#   Failed test 'The object isa Wibble'
+#   at $0 line 55.
+#     The object isn't a 'Wibble' it's a 'Foo'
+#   Failed test 'My Wibble isa Wibble'
+#   at $0 line 56.
+#     My Wibble isn't a reference
+#   Failed test 'Another Wibble isa Wibble'
+#   at $0 line 57.
+#     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 188
+new_ok(undef);
+err_like( <<ERR );
+#   Failed test 'new\\(\\) died'
+#   at $Filename line 188.
+#     Error was:  Can't call method "new" on an undefined value at .*
+ERR
+
+#line 211
+new_ok( "Does::Not::Exist" );
+err_like( <<ERR );
+#   Failed test 'new\\(\\) died'
+#   at $Filename line 211.
+#     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
+new_ok( "Foo" );
+err_ok( <<ERR );
+#   Failed test 'The object isa Foo'
+#   at $0 line 219.
+#     The object isn't defined
+ERR
+
+# line 231
+new_ok( "Bar" );
+err_ok( <<ERR );
+#   Failed test 'The object isa Bar'
+#   at $0 line 231.
+#     The object isn't a 'Bar' it's a 'HASH'
+ERR
+
+#line 239
+new_ok( "Baz" );
+err_ok( <<ERR );
+#   Failed test 'The object isa Baz'
+#   at $0 line 239.
+#     The object isn't a 'Baz' it's a 'Wibble'
+ERR
+
+#line 247
+new_ok( "Baz", [], "no args" );
+err_ok( <<ERR );
+#   Failed test 'no args isa Baz'
+#   at $0 line 247.
+#     no args isn't a 'Baz' it's a 'Wibble'
+ERR
+
+
+#line 68
+cmp_ok( 'foo', 'eq', 'bar', 'cmp_ok eq' );
+cmp_ok( 42.1,  '==', 23,  , '       ==' );
+cmp_ok( 42,    '!=', 42   , '       !=' );
+cmp_ok( 1,     '&&', 0    , '       &&' );
+err_ok( <<ERR );
+#   Failed test 'cmp_ok eq'
+#   at $0 line 68.
+#          got: 'foo'
+#     expected: 'bar'
+#   Failed test '       =='
+#   at $0 line 69.
+#          got: 42.1
+#     expected: 23
+#   Failed test '       !='
+#   at $0 line 70.
+#          got: 42
+#     expected: anything else
+#   Failed test '       &&'
+#   at $0 line 71.
+#     '1'
+#         &&
+#     '0'
+ERR
+
+
+# line 196
+cmp_ok( 42,    'eq', "foo", '       eq with numbers' );
+err_ok( <<ERR );
+#   Failed test '       eq with numbers'
+#   at $0 line 196.
+#          got: '42'
+#     expected: 'foo'
+ERR
+
+
+{
+    my $warnings;
+    local $SIG{__WARN__} = sub { $warnings .= join '', @_ };
+
+# line 211
+    cmp_ok( 42,    '==', "foo", '       == with strings' );
+    err_ok( <<ERR );
+#   Failed test '       == with strings'
+#   at $0 line 211.
+#          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$/;
+
+}
+
+
+# generate a $!, it changes its value by context.
+-e "wibblehibble";
+my $Errno_Number = $!+0;
+my $Errno_String = $!.'';
+#line 80
+cmp_ok( $!,    'eq', '',    '       eq with stringified errno' );
+cmp_ok( $!,    '==', -1,    '       eq with numerified errno' );
+err_ok( <<ERR );
+#   Failed test '       eq with stringified errno'
+#   at $0 line 80.
+#          got: '$Errno_String'
+#     expected: ''
+#   Failed test '       eq with numerified errno'
+#   at $0 line 81.
+#          got: $Errno_Number
+#     expected: -1
+ERR
+
+#line 84
+use_ok('Hooble::mooble::yooble');
+
+my $more_err_re = <<ERR;
+#   Failed test 'use Hooble::mooble::yooble;'
+#   at $Filename line 84\\.
+#     Tried to use 'Hooble::mooble::yooble'.
+#     Error:  Can't locate Hooble.* in \\\@INC .*
+ERR
+
+My::Test::like($err->read, "/^$more_err_re/");
+
+
+#line 85
+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\\.
+#     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/");
+
+
+#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
+
+err_ok( <<ERR );
+# Looks like you failed $Total tests of $Total.
+ERR
+
+    exit(0);
+}
diff --git a/gnu/usr.bin/perl/lib/Test/t/fail.t b/gnu/usr.bin/perl/lib/Test/t/fail.t
index ce37464d04a..6be111893d5 100644
--- a/gnu/usr.bin/perl/lib/Test/t/fail.t
+++ b/gnu/usr.bin/perl/lib/Test/t/fail.t
@@ -1,95 +1,72 @@
-# -*-perl-*-
-use strict;
-use vars qw($Expect);
-use Test qw($TESTOUT $TESTERR $ntest ok skip plan); 
-plan tests => 14;
-
-open F, ">fails";
-$TESTOUT = *F{IO};
-$TESTERR = *F{IO};
+#!perl -w
 
-my $r=0;
-{
-    # Shut up deprecated usage warning.
-    local $^W = 0;
-    $r |= skip(0,0);
+BEGIN {
+    if( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = ('../lib', 'lib');
+    }
+    else {
+        unshift @INC, 't/lib';
+    }
 }
-$r |= ok(0);
-$r |= ok(0,1);
-$r |= ok(sub { 1+1 }, 3);
-$r |= ok(sub { 1+1 }, sub { 2 * 0});
-
-my @list = (0,0);
-$r |= ok @list, 1, "\@list=".join(',',@list);
-$r |= ok @list, 1, sub { "\@list=".join ',',@list };
-$r |= ok 'segmentation fault', '/bongo/';
 
-for (1..2) { $r |= ok(0); }
-
-$r |= ok(1, undef);
-$r |= ok(undef, 1);
-
-ok($r); # (failure==success :-)
-
-close F;
-$TESTOUT = *STDOUT{IO};
-$TESTERR = *STDERR{IO};
-$ntest = 1;
+use strict;
 
-open F, "fails";
-my $O;
-while (<F>) { $O .= $_; }
-close F;
-unlink "fails";
+require Test::Simple::Catch;
+my($out, $err) = Test::Simple::Catch::caught();
+local $ENV{HARNESS_ACTIVE} = 0;
 
-ok join(' ', map { m/(\d+)/; $1 } grep /^not ok/, split /\n+/, $O),
-    join(' ', 1..13);
 
-my @got = split /not ok \d+\n/, $O;
-shift @got;
+# Can't use Test.pm, that's a 5.005 thing.
+package My::Test;
 
-$Expect =~ s/\n+$//;
-my @expect = split /\n\n/, $Expect;
+print "1..2\n";
 
-for (my $x=0; $x < @got; $x++) {
-    ok $got[$x], $expect[$x]."\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++;
 }
 
 
-BEGIN {
-    $Expect = <<"EXPECT";
-# Failed test 1 in $0 at line 15
-
-# Failed test 2 in $0 at line 17
-
-# Test 3 got: '0' ($0 at line 18)
-#   Expected: '1'
-
-# Test 4 got: '2' ($0 at line 19)
-#   Expected: '3'
-
-# Test 5 got: '2' ($0 at line 20)
-#   Expected: '0'
-
-# Test 6 got: '2' ($0 at line 23)
-#   Expected: '1' (\@list=0,0)
-
-# Test 7 got: '2' ($0 at line 24)
-#   Expected: '1' (\@list=0,0)
-
-# Test 8 got: 'segmentation fault' ($0 at line 25)
-#   Expected: qr{bongo}
+package main;
 
-# Failed test 9 in $0 at line 27
+require Test::Simple;
+Test::Simple->import(tests => 5);
 
-# Failed test 10 in $0 at line 27 fail #2
+#line 35
+ok( 1, 'passing' );
+ok( 2, 'passing still' );
+ok( 3, 'still passing' );
+ok( 0, 'oh no!' );
+ok( 0, 'damnit' );
 
-# Failed test 11 in $0 at line 29
 
-# Test 12 got: <UNDEF> ($0 at line 30)
-#    Expected: '1'
+END {
+    My::Test::ok($$out eq <<OUT);
+1..5
+ok 1 - passing
+ok 2 - passing still
+ok 3 - still passing
+not ok 4 - oh no!
+not ok 5 - damnit
+OUT
 
-# Failed test 13 in $0 at line 32
-EXPECT
+    My::Test::ok($$err eq <<ERR);
+#   Failed test 'oh no!'
+#   at $0 line 38.
+#   Failed test 'damnit'
+#   at $0 line 39.
+# Looks like you failed 2 tests of 5.
+ERR
 
+    # Prevent Test::Simple from exiting with non zero
+    exit 0;
 }
diff --git a/gnu/usr.bin/perl/lib/Test/t/fail_one.t b/gnu/usr.bin/perl/lib/Test/t/fail_one.t
new file mode 100644
index 00000000000..46b181d6a10
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Test/t/fail_one.t
@@ -0,0 +1,62 @@
+#!/usr/bin/perl -w
+
+BEGIN {
+    if( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = ('../lib', 'lib');
+    }
+    else {
+        unshift @INC, 't/lib';
+    }
+}
+
+use strict;
+
+require Test::Simple::Catch;
+my($out, $err) = Test::Simple::Catch::caught();
+local $ENV{HARNESS_ACTIVE} = 0;
+
+
+# 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++;
+
+    return $test ? 1 : 0;
+}
+
+
+package main;
+
+require Test::Simple;
+Test::Simple->import(tests => 1);
+
+#line 45
+ok(0);
+
+END {
+    My::Test::ok($$out eq <<OUT);
+1..1
+not ok 1
+OUT
+
+    My::Test::ok($$err eq <<ERR) || print $$err;
+#   Failed test at $0 line 45.
+# Looks like you failed 1 test of 1.
+ERR
+
+    # Prevent Test::Simple from existing with non-zero
+    exit 0;
+}
diff --git a/gnu/usr.bin/perl/lib/Test/t/filehandles.t b/gnu/usr.bin/perl/lib/Test/t/filehandles.t
new file mode 100644
index 00000000000..f7dad5d7ea6
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Test/t/filehandles.t
@@ -0,0 +1,18 @@
+#!perl -w
+
+BEGIN {
+    if( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = ('../lib', 'lib');
+    }
+}
+
+use lib 't/lib';
+use Test::More tests => 1;
+use Dev::Null;
+
+tie *STDOUT, "Dev::Null" or die $!;
+
+print "not ok 1\n";     # this should not print.
+pass 'STDOUT can be mucked with';
+
diff --git a/gnu/usr.bin/perl/lib/Test/t/fork.t b/gnu/usr.bin/perl/lib/Test/t/fork.t
new file mode 100644
index 00000000000..55d7aec1f9a
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Test/t/fork.t
@@ -0,0 +1,32 @@
+#!/usr/bin/perl -w
+
+BEGIN {
+    if( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = '../lib';
+    }
+}
+
+use Test::More;
+use Config;
+
+my $Can_Fork = $Config{d_fork} ||
+               (($^O eq 'MSWin32' || $^O eq 'NetWare') and
+                $Config{useithreads} and 
+                $Config{ccflags} =~ /-DPERL_IMPLICIT_SYS/
+               );
+
+if( !$Can_Fork ) {
+    plan skip_all => "This system cannot fork";
+}
+else {
+    plan tests => 1;
+}
+
+if( fork ) { # parent
+    pass("Only the parent should process the ending, not the child");
+}
+else {
+    exit;   # child
+}
+
diff --git a/gnu/usr.bin/perl/lib/Test/t/harness_active.t b/gnu/usr.bin/perl/lib/Test/t/harness_active.t
new file mode 100644
index 00000000000..7b027a7b404
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Test/t/harness_active.t
@@ -0,0 +1,88 @@
+#!perl -w
+
+BEGIN {
+    if( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = ('../lib', 'lib');
+    }
+    else {
+        unshift @INC, 't/lib';
+    }
+}
+
+use strict;
+
+use Test::Simple::Catch;
+my($out, $err) = Test::Simple::Catch::caught();
+
+
+# Can't use Test.pm, that's a 5.005 thing.
+package My::Test;
+
+# This has to be a require or else the END block below runs before
+# Test::Builder's own and the ending diagnostics don't come out right.
+require Test::Builder;
+my $TB = Test::Builder->create;
+$TB->plan(tests => 4);
+
+# Utility testing functions.
+sub ok ($;$) {
+    return $TB->ok(@_);
+}
+
+
+sub main::err_ok ($) {
+    my($expect) = @_;
+    my $got = $err->read;
+
+    return $TB->is_eq( $got, $expect );
+}
+
+
+package main;
+
+require Test::More;
+Test::More->import(tests => 4);
+Test::More->builder->no_ending(1);
+
+{
+    local $ENV{HARNESS_ACTIVE} = 0;
+
+#line 62
+    fail( "this fails" );
+    err_ok( <<ERR );
+#   Failed test 'this fails'
+#   at $0 line 62.
+ERR
+
+#line 72
+    is( 1, 0 );
+    err_ok( <<ERR );
+#   Failed test at $0 line 72.
+#          got: '1'
+#     expected: '0'
+ERR
+}
+
+{
+    local $ENV{HARNESS_ACTIVE} = 1;
+                   
+#line 71
+    fail( "this fails" );
+    err_ok( <<ERR );
+
+#   Failed test 'this fails'
+#   at $0 line 71.
+ERR
+
+
+#line 84
+    is( 1, 0 );
+    err_ok( <<ERR );
+
+#   Failed test at $0 line 84.
+#          got: '1'
+#     expected: '0'
+ERR
+
+}
diff --git a/gnu/usr.bin/perl/lib/Test/t/import.t b/gnu/usr.bin/perl/lib/Test/t/import.t
new file mode 100644
index 00000000000..68a36138bc9
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Test/t/import.t
@@ -0,0 +1,12 @@
+BEGIN {
+    if( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = '../lib';
+    }
+}
+
+
+use Test::More tests => 2, import => [qw(!fail)];
+
+can_ok(__PACKAGE__, qw(ok pass like isa_ok));
+ok( !__PACKAGE__->can('fail'),  'fail() not exported' );
diff --git a/gnu/usr.bin/perl/lib/Test/t/is_deeply_dne_bug.t b/gnu/usr.bin/perl/lib/Test/t/is_deeply_dne_bug.t
new file mode 100644
index 00000000000..f4578a6460e
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Test/t/is_deeply_dne_bug.t
@@ -0,0 +1,47 @@
+#!/usr/bin/perl -w
+
+# test for rt.cpan.org 20768
+#
+# There was a bug where the internal "does not exist" object could get
+# confused with an overloaded object.
+
+BEGIN {
+    if( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = ('../lib', 'lib');
+    }
+    else {
+        unshift @INC, 't/lib';
+    }
+}
+
+use strict;
+use Test::More tests => 2;
+
+{
+    package Foo;
+
+    use overload
+    'eq' => \&overload_equiv,
+    '==' => \&overload_equiv;
+
+    sub new {
+        return bless {}, shift;
+    }
+
+    sub overload_equiv {
+        if (ref($_[0]) ne 'Foo' || ref($_[1]) ne 'Foo') {
+            print ref($_[0]), " ", ref($_[1]), "\n";
+            die "Invalid object passed to overload_equiv\n";
+        }
+
+        return 1; # change to 0 ... makes little difference
+    }
+}
+
+my $obj1 = Foo->new();
+my $obj2 = Foo->new();
+
+eval { is_deeply([$obj1, $obj2], [$obj1, $obj2]); };
+is $@, '';
+
diff --git a/gnu/usr.bin/perl/lib/Test/t/is_deeply_fail.t b/gnu/usr.bin/perl/lib/Test/t/is_deeply_fail.t
new file mode 100644
index 00000000000..bd9b6342333
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Test/t/is_deeply_fail.t
@@ -0,0 +1,371 @@
+#!/usr/bin/perl -w
+
+BEGIN {
+    if( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = ('../lib', 'lib');
+    }
+    else {
+        unshift @INC, 't/lib';
+    }
+}
+
+use strict;
+
+use Test::Builder;
+require Test::Simple::Catch;
+my($out, $err) = Test::Simple::Catch::caught();
+Test::Builder->new->no_header(1);
+Test::Builder->new->no_ending(1);
+local $ENV{HARNESS_ACTIVE} = 0;
+
+
+# Can't use Test.pm, that's a 5.005 thing.
+package main;
+
+
+my $TB = Test::Builder->create;
+$TB->plan(tests => 73);
+
+# Utility testing functions.
+sub ok ($;$) {
+    return $TB->ok(@_);
+}
+
+sub is ($$;$) {
+    my($this, $that, $name) = @_;
+
+    my $ok = $TB->is_eq($$this, $that, $name);
+
+    $$this = '';
+
+    return $ok;
+}
+
+sub like ($$;$) {
+    my($this, $regex, $name) = @_;
+    $regex = "/$regex/" if !ref $regex and $regex !~ m{^/.*/$}s;
+
+    my $ok = $TB->like($$this, $regex, $name);
+
+    $$this = '';
+
+    return $ok;
+}
+
+
+require Test::More;
+Test::More->import(tests => 11, import => ['is_deeply']);
+
+my $Filename = quotemeta $0;
+
+#line 68
+ok !is_deeply('foo', 'bar', 'plain strings');
+is( $out, "not ok 1 - plain strings\n",     'plain strings' );
+is( $err, <<ERR,                            '    right diagnostic' );
+#   Failed test 'plain strings'
+#   at $0 line 68.
+#          got: 'foo'
+#     expected: 'bar'
+ERR
+
+
+#line 78
+ok !is_deeply({}, [], 'different types');
+is( $out, "not ok 2 - different types\n",   'different types' );
+like( $err, <<ERR,                          '   right diagnostic' );
+#   Failed test 'different types'
+#   at $Filename line 78.
+#     Structures begin differing at:
+#          \\\$got = HASH\\(0x[0-9a-f]+\\)
+#     \\\$expected = ARRAY\\(0x[0-9a-f]+\\)
+ERR
+
+#line 88
+ok !is_deeply({ this => 42 }, { this => 43 }, 'hashes with different values');
+is( $out, "not ok 3 - hashes with different values\n", 
+                                        'hashes with different values' );
+is( $err, <<ERR,                        '   right diagnostic' );
+#   Failed test 'hashes with different values'
+#   at $0 line 88.
+#     Structures begin differing at:
+#          \$got->{this} = '42'
+#     \$expected->{this} = '43'
+ERR
+
+#line 99
+ok !is_deeply({ that => 42 }, { this => 42 }, 'hashes with different keys');
+is( $out, "not ok 4 - hashes with different keys\n",
+                                        'hashes with different keys' );
+is( $err, <<ERR,                        '    right diagnostic' );
+#   Failed test 'hashes with different keys'
+#   at $0 line 99.
+#     Structures begin differing at:
+#          \$got->{this} = Does not exist
+#     \$expected->{this} = '42'
+ERR
+
+#line 110
+ok !is_deeply([1..9], [1..10],    'arrays of different length');
+is( $out, "not ok 5 - arrays of different length\n",
+                                        'arrays of different length' );
+is( $err, <<ERR,                        '    right diagnostic' );
+#   Failed test 'arrays of different length'
+#   at $0 line 110.
+#     Structures begin differing at:
+#          \$got->[9] = Does not exist
+#     \$expected->[9] = '10'
+ERR
+
+#line 121
+ok !is_deeply([undef, undef], [undef], 'arrays of undefs' );
+is( $out, "not ok 6 - arrays of undefs\n",  'arrays of undefs' );
+is( $err, <<ERR,                            '    right diagnostic' );
+#   Failed test 'arrays of undefs'
+#   at $0 line 121.
+#     Structures begin differing at:
+#          \$got->[1] = undef
+#     \$expected->[1] = Does not exist
+ERR
+
+#line 131
+ok !is_deeply({ foo => undef }, {},    'hashes of undefs' );
+is( $out, "not ok 7 - hashes of undefs\n",  'hashes of undefs' );
+is( $err, <<ERR,                            '    right diagnostic' );
+#   Failed test 'hashes of undefs'
+#   at $0 line 131.
+#     Structures begin differing at:
+#          \$got->{foo} = undef
+#     \$expected->{foo} = Does not exist
+ERR
+
+#line 141
+ok !is_deeply(\42, \23,   'scalar refs');
+is( $out, "not ok 8 - scalar refs\n",   'scalar refs' );
+is( $err, <<ERR,                        '    right diagnostic' );
+#   Failed test 'scalar refs'
+#   at $0 line 141.
+#     Structures begin differing at:
+#     \${     \$got} = '42'
+#     \${\$expected} = '23'
+ERR
+
+#line 151
+ok !is_deeply([], \23,    'mixed scalar and array refs');
+is( $out, "not ok 9 - mixed scalar and array refs\n",
+                                        'mixed scalar and array refs' );
+like( $err, <<ERR,                      '    right diagnostic' );
+#   Failed test 'mixed scalar and array refs'
+#   at $Filename line 151.
+#     Structures begin differing at:
+#          \\\$got = ARRAY\\(0x[0-9a-f]+\\)
+#     \\\$expected = SCALAR\\(0x[0-9a-f]+\\)
+ERR
+
+
+my($a1, $a2, $a3);
+$a1 = \$a2;  $a2 = \$a3;
+$a3 = 42;
+
+my($b1, $b2, $b3);
+$b1 = \$b2;  $b2 = \$b3;
+$b3 = 23;
+
+#line 173
+ok !is_deeply($a1, $b1, 'deep scalar refs');
+is( $out, "not ok 10 - deep scalar refs\n",     'deep scalar refs' );
+is( $err, <<ERR,                              '    right diagnostic' );
+#   Failed test 'deep scalar refs'
+#   at $0 line 173.
+#     Structures begin differing at:
+#     \${\${     \$got}} = '42'
+#     \${\${\$expected}} = '23'
+ERR
+
+# I don't know how to properly display this structure.
+# $a2 = { foo => \$a3 };
+# $b2 = { foo => \$b3 };
+# is_deeply([$a1], [$b1], 'deep mixed scalar refs');
+
+my $foo = {
+           this => [1..10],
+           that => { up => "down", left => "right" },
+          };
+
+my $bar = {
+           this => [1..10],
+           that => { up => "down", left => "right", foo => 42 },
+          };
+
+#line 198
+ok !is_deeply( $foo, $bar, 'deep structures' );
+ok( @Test::More::Data_Stack == 0, '@Data_Stack not holding onto things' );
+is( $out, "not ok 11 - deep structures\n",  'deep structures' );
+is( $err, <<ERR,                            '    right diagnostic' );
+#   Failed test 'deep structures'
+#   at $0 line 198.
+#     Structures begin differing at:
+#          \$got->{that}{foo} = Does not exist
+#     \$expected->{that}{foo} = '42'
+ERR
+
+
+#line 221
+my @tests = ([],
+             [qw(42)],
+             [qw(42 23), qw(42 23)]
+            );
+
+foreach my $test (@tests) {
+    my $num_args = @$test;
+
+    my $warning;
+    local $SIG{__WARN__} = sub { $warning .= join '', @_; };
+    ok !is_deeply(@$test);
+
+    like \$warning, 
+         "/^is_deeply\\(\\) takes two or three args, you gave $num_args\.\n/";
+}
+
+
+#line 240
+# [rt.cpan.org 6837]
+ok !is_deeply([{Foo => undef}],[{Foo => ""}]), 'undef != ""';
+ok( @Test::More::Data_Stack == 0, '@Data_Stack not holding onto things' );
+
+
+#line 258
+# [rt.cpan.org 7031]
+my $a = [];
+ok !is_deeply($a, $a.''),       "don't compare refs like strings";
+ok !is_deeply([$a], [$a.'']),   "  even deep inside";
+
+
+#line 265
+# [rt.cpan.org 7030]
+ok !is_deeply( {}, {key => []} ),  '[] could match non-existent values';
+ok !is_deeply( [], [[]] );
+
+
+#line 273
+$$err = $$out = '';
+ok !is_deeply( [\'a', 'b'], [\'a', 'c'] );
+is( $out, "not ok 20\n",  'scalar refs in an array' );
+is( $err, <<ERR,        '    right diagnostic' );
+#   Failed test at $0 line 274.
+#     Structures begin differing at:
+#          \$got->[1] = 'b'
+#     \$expected->[1] = 'c'
+ERR
+
+
+#line 285
+my $ref = \23;
+ok !is_deeply( 23, $ref );
+is( $out, "not ok 21\n", 'scalar vs ref' );
+is( $err, <<ERR,        '  right diagnostic');
+#   Failed test at $0 line 286.
+#     Structures begin differing at:
+#          \$got = '23'
+#     \$expected = $ref
+ERR
+
+#line 296
+ok !is_deeply( $ref, 23 );
+is( $out, "not ok 22\n", 'ref vs scalar' );
+is( $err, <<ERR,        '  right diagnostic');
+#   Failed test at $0 line 296.
+#     Structures begin differing at:
+#          \$got = $ref
+#     \$expected = '23'
+ERR
+
+#line 306
+ok !is_deeply( undef, [] );
+is( $out, "not ok 23\n", 'is_deeply and undef [RT 9441]' );
+like( $err, <<ERR,	 '  right diagnostic' );
+#   Failed test at $Filename line 306\\.
+#     Structures begin differing at:
+#          \\\$got = undef
+#     \\\$expected = ARRAY\\(0x[0-9a-f]+\\)
+ERR
+
+
+# rt.cpan.org 8865
+{
+    my $array = [];
+    my $hash  = {};
+
+#line 321
+    ok !is_deeply( $array, $hash );
+    is( $out, "not ok 24\n", 'is_deeply and different reference types' );
+    is( $err, <<ERR, 	     '  right diagnostic' );
+#   Failed test at $0 line 321.
+#     Structures begin differing at:
+#          \$got = $array
+#     \$expected = $hash
+ERR
+
+#line 332
+    ok !is_deeply( [$array], [$hash] );
+    is( $out, "not ok 25\n", 'nested different ref types' );
+    is( $err, <<ERR,	     '  right diagnostic' );
+#   Failed test at $0 line 332.
+#     Structures begin differing at:
+#          \$got->[0] = $array
+#     \$expected->[0] = $hash
+ERR
+
+
+    # Overloaded object tests
+    {
+	my $foo = bless [], "Foo";
+	my $bar = bless {}, "Bar";
+
+	{
+	    package Bar;
+	    "overload"->import(q[""] => sub { "wibble" });
+	}
+
+#line 353
+	ok !is_deeply( [$foo], [$bar] );
+	is( $out, "not ok 26\n", 'string overloaded refs respected in diag' );
+	is( $err, <<ERR,	     '  right diagnostic' );
+#   Failed test at $0 line 353.
+#     Structures begin differing at:
+#          \$got->[0] = $foo
+#     \$expected->[0] = 'wibble'
+ERR
+
+    }
+}
+
+
+# rt.cpan.org 14746
+{
+# line 349
+    ok !is_deeply( sub {"foo"}, sub {"bar"} ), 'function refs';
+    is( $out, "not ok 27\n" );
+    like( $err, <<ERR,	     '  right diagnostic' );
+#   Failed test at $Filename line 349.
+#     Structures begin differing at:
+#          \\\$got = CODE\\(0x[0-9a-f]+\\)
+#     \\\$expected = CODE\\(0x[0-9a-f]+\\)
+ERR
+
+
+    use Symbol;
+    my $glob1 = gensym;
+    my $glob2 = gensym;
+
+#line 357
+    ok !is_deeply( $glob1, $glob2 ), 'typeglobs';
+    is( $out, "not ok 28\n" );
+    like( $err, <<ERR,	     '  right diagnostic' );
+#   Failed test at $Filename line 357.
+#     Structures begin differing at:
+#          \\\$got = GLOB\\(0x[0-9a-f]+\\)
+#     \\\$expected = GLOB\\(0x[0-9a-f]+\\)
+ERR
+
+}
diff --git a/gnu/usr.bin/perl/lib/Test/t/is_deeply_with_threads.t b/gnu/usr.bin/perl/lib/Test/t/is_deeply_with_threads.t
new file mode 100644
index 00000000000..9908ef66083
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Test/t/is_deeply_with_threads.t
@@ -0,0 +1,65 @@
+#!/usr/bin/perl -w
+
+# Test to see if is_deeply() plays well with threads.
+
+BEGIN {
+    if( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = ('../lib', 'lib');
+    }
+    else {
+        unshift @INC, 't/lib';
+    }
+}
+
+use strict;
+use Config;
+
+BEGIN {
+    unless ( $] >= 5.008001 && $Config{'useithreads'} && 
+             eval { require threads; 'threads'->import; 1; }) 
+    {
+        print "1..0 # Skip no working threads\n";
+        exit 0;
+    }
+    
+    unless ( $ENV{AUTHOR_TESTING} ) {
+        print "1..0 # Skip many perls have broken threads.  Enable with AUTHOR_TESTING.\n";
+        exit 0;
+    }
+}
+use Test::More;
+
+my $Num_Threads = 5;
+
+plan tests => $Num_Threads * 100 + 6;
+
+
+sub do_one_thread {
+    my $kid = shift;
+    my @list = ( 'x', 'yy', 'zzz', 'a', 'bb', 'ccc', 'aaaaa', 'z',
+                 'hello', 's', 'thisisalongname', '1', '2', '3',
+                 'abc', 'xyz', '1234567890', 'm', 'n', 'p' );
+    my @list2 = @list;
+    print "# kid $kid before is_deeply\n";
+
+    for my $j (1..100) {
+        is_deeply(\@list, \@list2);
+    }
+    print "# kid $kid exit\n";
+    return 42;
+}
+
+my @kids = ();
+for my $i (1..$Num_Threads) {
+    my $t = threads->new(\&do_one_thread, $i);
+    print "# parent $$: continue\n";
+    push(@kids, $t);
+}
+for my $t (@kids) {
+    print "# parent $$: waiting for join\n";
+    my $rc = $t->join();
+    cmp_ok( $rc, '==', 42, "threads exit status is $rc" );
+}
+
+pass("End of test");
diff --git a/gnu/usr.bin/perl/lib/Test/t/missing.t b/gnu/usr.bin/perl/lib/Test/t/missing.t
new file mode 100644
index 00000000000..3996b6de4b4
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Test/t/missing.t
@@ -0,0 +1,56 @@
+BEGIN {
+    if( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = ('../lib', 'lib');
+    }
+    else {
+        unshift @INC, 't/lib';
+    }
+}
+
+# Can't use Test.pm, that's a 5.005 thing.
+package My::Test;
+
+# This has to be a require or else the END block below runs before
+# Test::Builder's own and the ending diagnostics don't come out right.
+require Test::Builder;
+my $TB = Test::Builder->create;
+$TB->plan(tests => 2);
+
+sub is { $TB->is_eq(@_) }
+
+
+package main;
+
+require Test::Simple;
+
+require Test::Simple::Catch;
+my($out, $err) = Test::Simple::Catch::caught();
+local $ENV{HARNESS_ACTIVE} = 0;
+
+Test::Simple->import(tests => 5);
+
+#line 30
+ok(1, 'Foo');
+ok(0, 'Bar');
+ok(1, '1 2 3');
+
+END {
+    My::Test::is($$out, <<OUT);
+1..5
+ok 1 - Foo
+not ok 2 - Bar
+ok 3 - 1 2 3
+OUT
+
+    My::Test::is($$err, <<ERR);
+#   Failed test 'Bar'
+#   at $0 line 31.
+#     You named your test '1 2 3'.  You shouldn't use numbers for your test names.
+#     Very confusing.
+# Looks like you planned 5 tests but ran 3.
+# Looks like you failed 1 test of 3 run.
+ERR
+
+    exit 0;
+}
diff --git a/gnu/usr.bin/perl/lib/Test/t/new_ok.t b/gnu/usr.bin/perl/lib/Test/t/new_ok.t
new file mode 100644
index 00000000000..d53f535d1c0
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Test/t/new_ok.t
@@ -0,0 +1,42 @@
+#!/usr/bin/perl -w
+
+use strict;
+
+use Test::More tests => 13;
+
+{
+    package Bar;
+
+    sub new {
+        my $class = shift;
+        return bless {@_}, $class;
+    }
+
+
+    package Foo;
+    our @ISA = qw(Bar);
+}
+
+{
+    my $obj = new_ok("Foo");
+    is_deeply $obj, {};
+    isa_ok $obj, "Foo";
+
+    $obj = new_ok("Bar");
+    is_deeply $obj, {};
+    isa_ok $obj, "Bar";
+
+    $obj = new_ok("Foo", [this => 42]);
+    is_deeply $obj, { this => 42 };
+    isa_ok $obj, "Foo";
+
+    $obj = new_ok("Foo", [], "Foo");
+    is_deeply $obj, {};
+    isa_ok $obj, "Foo";
+}
+
+# And what if we give it nothing?
+eval {
+    new_ok();
+};
+is $@, sprintf "new_ok() must be given at least a class at %s line %d.\n", $0, __LINE__ - 2;
diff --git a/gnu/usr.bin/perl/lib/Test/t/no_plan.t b/gnu/usr.bin/perl/lib/Test/t/no_plan.t
new file mode 100644
index 00000000000..2231c0f5535
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Test/t/no_plan.t
@@ -0,0 +1,38 @@
+#!/usr/bin/perl -w
+
+BEGIN {
+    if( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = ('../lib', 'lib');
+    }
+    else {
+        unshift @INC, 't/lib';
+    }
+}
+
+use Test::More tests => 9;
+
+my $tb = Test::Builder->create;
+$tb->level(0);
+
+#line 20
+ok !eval { $tb->plan(tests => undef) };
+is($@, "Got an undefined number of tests at $0 line 20.\n");
+
+#line 24
+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
+    ok $tb->plan(no_plan => 1);
+    is( $warning, "no_plan takes no arguments at $0 line 36.\n" );
+    is $tb->has_plan, 'no_plan';
+}
diff --git a/gnu/usr.bin/perl/lib/Test/t/no_tests.t b/gnu/usr.bin/perl/lib/Test/t/no_tests.t
new file mode 100644
index 00000000000..eafa38cacc7
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Test/t/no_tests.t
@@ -0,0 +1,44 @@
+#!perl -w
+
+BEGIN {
+    if( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = '../lib';
+    }
+}
+
+# Can't use Test.pm, that's a 5.005 thing.
+package My::Test;
+
+# This has to be a require or else the END block below runs before
+# Test::Builder's own and the ending diagnostics don't come out right.
+require Test::Builder;
+my $TB = Test::Builder->create;
+$TB->plan(tests => 3);
+
+
+package main;
+
+require Test::Simple;
+
+chdir 't';
+push @INC, '../t/lib/';
+require Test::Simple::Catch;
+my($out, $err) = Test::Simple::Catch::caught();
+local $ENV{HARNESS_ACTIVE} = 0;
+
+Test::Simple->import(tests => 1);
+
+END {
+    $TB->is_eq($out->read, <<OUT);
+1..1
+OUT
+
+    $TB->is_eq($err->read, <<ERR);
+# No tests run!
+ERR
+
+    $TB->is_eq($?, 255, "exit code");
+
+    exit grep { !$_ } $TB->summary;
+}
diff --git a/gnu/usr.bin/perl/lib/Test/t/note.t b/gnu/usr.bin/perl/lib/Test/t/note.t
new file mode 100644
index 00000000000..1142b426ed1
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Test/t/note.t
@@ -0,0 +1,35 @@
+#!/usr/bin/perl -w
+
+BEGIN {
+    if( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = ('../lib', 'lib');
+    }
+    else {
+        unshift @INC, 't/lib';
+    }
+}
+
+use strict;
+use warnings;
+
+use TieOut;
+
+use Test::More tests => 2;
+
+{
+    my $test = Test::More->builder;
+
+    my $output          = tie *FAKEOUT, "TieOut";
+    my $fail_output     = tie *FAKEERR, "TieOut";
+    $test->output        (*FAKEOUT);
+    $test->failure_output(*FAKEERR);
+
+    note("foo");
+
+    $test->reset_outputs;
+
+    is $output->read,      "# foo\n";
+    is $fail_output->read, '';
+}
+
diff --git a/gnu/usr.bin/perl/lib/Test/t/overload.t b/gnu/usr.bin/perl/lib/Test/t/overload.t
new file mode 100644
index 00000000000..c7d6f3717c7
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Test/t/overload.t
@@ -0,0 +1,75 @@
+#!/usr/bin/perl -w
+
+BEGIN {
+    if( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = ('../lib', 'lib');
+    }
+    else {
+        unshift @INC, 't/lib';
+    }
+}
+
+use strict;
+use Test::More tests => 15;
+
+
+package Overloaded;
+
+use overload
+  q{eq}    => sub { $_[0]->{string} },
+  q{==}    => sub { $_[0]->{num} },
+  q{""}    => sub { $_[0]->{stringfy}++; $_[0]->{string} },
+  q{0+}    => sub { $_[0]->{numify}++;   $_[0]->{num}    }
+;
+
+sub new {
+    my $class = shift;
+    bless {
+        string  => shift,
+        num     => shift,
+        stringify       => 0,
+        numify          => 0,
+    }, $class;
+}
+
+
+package main;
+
+local $SIG{__DIE__} = sub {
+    my($call_file, $call_line) = (caller)[1,2];
+    fail("SIGDIE accidentally called");
+    diag("From $call_file at $call_line");
+};
+
+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';
+
+is_deeply [$obj], ['foo'],                 'is_deeply with string overloading';
+ok eq_array([$obj], ['foo']),              'eq_array ...';
+ok eq_hash({foo => $obj}, {foo => 'foo'}), 'eq_hash ...';
+
+# rt.cpan.org 13506
+is_deeply $obj, 'foo',        'is_deeply with string overloading at the top';
+
+Test::More->builder->is_num($obj, 42);
+Test::More->builder->is_eq ($obj, "foo");
+
+
+{
+    # rt.cpan.org 14675
+    package TestPackage;
+    use overload q{""} => sub { ::fail("This should not be called") };
+
+    package Foo;
+    ::is_deeply(['TestPackage'], ['TestPackage']);
+    ::is_deeply({'TestPackage' => 'TestPackage'}, 
+                {'TestPackage' => 'TestPackage'});
+    ::is_deeply('TestPackage', 'TestPackage');
+}
diff --git a/gnu/usr.bin/perl/lib/Test/t/overload_threads.t b/gnu/usr.bin/perl/lib/Test/t/overload_threads.t
new file mode 100644
index 00000000000..379e347baeb
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Test/t/overload_threads.t
@@ -0,0 +1,60 @@
+#!perl -w
+
+BEGIN {
+    if( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = ('../lib', 'lib');
+    }
+    else {
+        unshift @INC, 't/lib';
+    }
+}
+chdir 't';
+
+BEGIN {
+    # There was a bug with overloaded objects and threads.
+    # See rt.cpan.org 4218
+    eval { require threads; 'threads'->import; 1; };
+}
+
+use Test::More tests => 5;
+
+
+package Overloaded;
+
+use overload
+  q{""} => sub { $_[0]->{string} };
+
+sub new {
+    my $class = shift;
+    bless { string => shift }, $class;
+}
+
+
+package main;
+
+my $warnings = '';
+local $SIG{__WARN__} = sub { $warnings = join '', @_ };
+
+# overloaded object as name
+my $obj = Overloaded->new('foo');
+ok( 1, $obj );
+
+# overloaded object which returns undef as name
+my $undef = Overloaded->new(undef);
+pass( $undef );
+
+is( $warnings, '' );
+
+
+TODO: {
+    my $obj = Overloaded->new('not really todo, testing overloaded reason');
+    local $TODO = $obj;
+    fail("Just checking todo as an overloaded value");
+}
+
+
+SKIP: {
+    my $obj = Overloaded->new('not really skipped, testing overloaded reason');
+    skip $obj, 1;
+}
diff --git a/gnu/usr.bin/perl/lib/Test/t/plan.t b/gnu/usr.bin/perl/lib/Test/t/plan.t
new file mode 100644
index 00000000000..0d3ce89edb1
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Test/t/plan.t
@@ -0,0 +1,21 @@
+#!/usr/bin/perl -w
+
+BEGIN {
+    if( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = '../lib';
+    }
+}
+
+use Test::More;
+
+plan tests => 4;
+eval { plan tests => 4 };
+is( $@, sprintf("You tried to plan twice at %s line %d.\n", $0, __LINE__ - 1),
+    'disallow double plan' );
+eval { plan 'no_plan'  };
+is( $@, sprintf("You tried to plan twice at %s line %d.\n", $0, __LINE__ -1),
+    'disallow changing plan' );
+
+pass('Just testing plan()');
+pass('Testing it some more');
diff --git a/gnu/usr.bin/perl/lib/Test/t/plan_bad.t b/gnu/usr.bin/perl/lib/Test/t/plan_bad.t
new file mode 100644
index 00000000000..179356dbc1d
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Test/t/plan_bad.t
@@ -0,0 +1,37 @@
+#!/usr/bin/perl -w
+
+BEGIN {
+    if( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = '../lib';
+    }
+}
+
+
+use Test::More tests => 12;
+use Test::Builder;
+my $tb = Test::Builder->create;
+$tb->level(0);
+
+ok !eval { $tb->plan( tests => 'no_plan' ); };
+is $@, sprintf "Number of tests must be a positive integer.  You gave it 'no_plan' at %s line %d.\n", $0, __LINE__ - 1;
+
+my $foo = [];
+my @foo = ($foo, 2, 3);
+ok !eval { $tb->plan( tests => @foo ) };
+is $@, sprintf "Number of tests must be a positive integer.  You gave it '$foo' at %s line %d.\n", $0, __LINE__ - 1;
+
+ok !eval { $tb->plan( tests => 9.99 ) };
+is $@, sprintf "Number of tests must be a positive integer.  You gave it '9.99' at %s line %d.\n", $0, __LINE__ - 1;
+
+#line 25
+ok !eval { $tb->plan( tests => -1 ) };
+is $@, "Number of tests must be a positive integer.  You gave it '-1' at $0 line 25.\n";
+
+#line 29
+ok !eval { $tb->plan( tests => '' ) };
+is $@, "You said to run 0 tests at $0 line 29.\n";
+
+#line 33
+ok !eval { $tb->plan( 'wibble' ) };
+is $@, "plan() doesn't understand wibble at $0 line 33.\n";
diff --git a/gnu/usr.bin/perl/lib/Test/t/plan_is_noplan.t b/gnu/usr.bin/perl/lib/Test/t/plan_is_noplan.t
new file mode 100644
index 00000000000..e39cd4062b7
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Test/t/plan_is_noplan.t
@@ -0,0 +1,54 @@
+BEGIN {
+    if( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = ('../lib', 'lib');
+    }
+    else {
+        unshift @INC, 't/lib';
+    }
+}
+
+# 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;
+
+require Test::Simple::Catch;
+my($out, $err) = Test::Simple::Catch::caught();
+
+
+Test::Simple->import('no_plan');
+
+ok(1, 'foo');
+
+
+END {
+    My::Test::ok($$out eq <<OUT);
+ok 1 - foo
+1..1
+OUT
+
+    My::Test::ok($$err eq <<ERR);
+ERR
+
+    # Prevent Test::Simple from exiting with non zero
+    exit 0;
+}
diff --git a/gnu/usr.bin/perl/lib/Test/t/plan_no_plan.t b/gnu/usr.bin/perl/lib/Test/t/plan_no_plan.t
new file mode 100644
index 00000000000..3111592e97f
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Test/t/plan_no_plan.t
@@ -0,0 +1,40 @@
+BEGIN {
+    if( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = '../lib';
+    }
+}
+
+use Test::More;
+
+BEGIN {
+    if( !$ENV{HARNESS_ACTIVE} && $ENV{PERL_CORE} ) {
+        plan skip_all => "Won't work with t/TEST";
+    }
+}
+
+plan 'no_plan';
+
+pass('Just testing');
+ok(1, 'Testing again');
+
+{
+    my $warning = '';
+    local $SIG{__WARN__} = sub { $warning = join "", @_ };
+    SKIP: {
+        skip 'Just testing skip with no_plan';
+        fail("So very failed");
+    }
+    is( $warning, '', 'skip with no "how_many" ok with no_plan' );
+
+
+    $warning = '';
+    TODO: {
+        todo_skip "Just testing todo_skip";
+
+        fail("Just testing todo");
+        die "todo_skip should prevent this";
+        pass("Again");
+    }
+    is( $warning, '', 'skip with no "how_many" ok with no_plan' );
+}
diff --git a/gnu/usr.bin/perl/lib/Test/t/plan_shouldnt_import.t b/gnu/usr.bin/perl/lib/Test/t/plan_shouldnt_import.t
new file mode 100644
index 00000000000..b6eb0642446
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Test/t/plan_shouldnt_import.t
@@ -0,0 +1,16 @@
+#!/usr/bin/perl -w
+
+# plan() used to export functions by mistake [rt.cpan.org 8385]
+
+BEGIN {
+    if( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = '../lib';
+    }
+}
+
+
+use Test::More ();
+Test::More::plan(tests => 1);
+
+Test::More::ok( !__PACKAGE__->can('ok'), 'plan should not export' );
diff --git a/gnu/usr.bin/perl/lib/Test/t/plan_skip_all.t b/gnu/usr.bin/perl/lib/Test/t/plan_skip_all.t
new file mode 100644
index 00000000000..528df5f50d4
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Test/t/plan_skip_all.t
@@ -0,0 +1,12 @@
+BEGIN {
+    if( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = '../lib';
+    }
+}
+
+use Test::More;
+
+plan skip_all => 'Just testing plan & skip_all';
+
+fail('We should never get here');
diff --git a/gnu/usr.bin/perl/lib/Test/t/pod-coverage.t b/gnu/usr.bin/perl/lib/Test/t/pod-coverage.t
new file mode 100644
index 00000000000..87942726e76
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Test/t/pod-coverage.t
@@ -0,0 +1,27 @@
+#!/usr/bin/perl -w
+
+use Test::More;
+
+# 1.08 added the coverage_class option.
+eval "use Test::Pod::Coverage 1.08";
+plan skip_all => "Test::Pod::Coverage 1.08 required for testing POD coverage" if $@;
+eval "use Pod::Coverage::CountParents";
+plan skip_all => "Pod::Coverage::CountParents required for testing POD coverage" if $@;
+
+my @modules = Test::Pod::Coverage::all_modules();
+plan tests => scalar @modules;
+
+my %coverage_params = (
+    "Test::Builder" => {
+        also_private => [ '^(share|lock|BAILOUT)$' ]
+    },
+    "Test::More" => {
+        trustme => [ '^(skip|todo)$' ]
+    },
+);
+
+for my $module (@modules) {
+    pod_coverage_ok( $module, { coverage_class => 'Pod::Coverage::CountParents',
+                                %{$coverage_params{$module} || {}} }
+                   );
+}
diff --git a/gnu/usr.bin/perl/lib/Test/t/pod.t b/gnu/usr.bin/perl/lib/Test/t/pod.t
new file mode 100644
index 00000000000..3c931f94f91
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Test/t/pod.t
@@ -0,0 +1,6 @@
+#!/usr/bin/perl -w
+
+use Test::More;
+eval "use Test::Pod 1.00";
+plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
+all_pod_files_ok();
diff --git a/gnu/usr.bin/perl/lib/Test/t/require_ok.t b/gnu/usr.bin/perl/lib/Test/t/require_ok.t
new file mode 100644
index 00000000000..463a007599c
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Test/t/require_ok.t
@@ -0,0 +1,29 @@
+#!/usr/bin/perl -w
+
+BEGIN {
+    if( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = ('../lib', 'lib');
+    }
+    else {
+        unshift @INC, 't/lib';
+    }
+}
+
+use strict;
+use Test::More tests => 8;
+
+# Symbol and Class::Struct are both non-XS core modules back to 5.004.
+# So they'll always be there.
+require_ok("Symbol");
+ok( $INC{'Symbol.pm'},          "require_ok MODULE" );
+
+require_ok("Class/Struct.pm");
+ok( $INC{'Class/Struct.pm'},    "require_ok FILE" );
+
+# Its more trouble than its worth to try to create these filepaths to test
+# through require_ok() so we cheat and use the internal logic.
+ok !Test::More::_is_module_name('foo:bar');
+ok !Test::More::_is_module_name('foo/bar.thing');
+ok !Test::More::_is_module_name('Foo::Bar::');
+ok Test::More::_is_module_name('V');
diff --git a/gnu/usr.bin/perl/lib/Test/t/simple.t b/gnu/usr.bin/perl/lib/Test/t/simple.t
new file mode 100644
index 00000000000..7297e9d6dd1
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Test/t/simple.t
@@ -0,0 +1,17 @@
+BEGIN {
+    if( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = '../lib';
+    }
+}
+
+use strict;
+
+BEGIN { $| = 1; $^W = 1; }
+
+use Test::Simple tests => 3;
+
+ok(1, 'compile');
+
+ok(1);
+ok(1, 'foo');
diff --git a/gnu/usr.bin/perl/lib/Test/t/skip.t b/gnu/usr.bin/perl/lib/Test/t/skip.t
index a6d1cf4c3cf..b7ec32adbea 100644
--- a/gnu/usr.bin/perl/lib/Test/t/skip.t
+++ b/gnu/usr.bin/perl/lib/Test/t/skip.t
@@ -1,43 +1,98 @@
-# -*-perl-*-
-use strict;
-use Test qw($TESTOUT $TESTERR $ntest plan ok skip); 
-plan tests => 6;
+#!perl -w
 
-open F, ">skips" or die "open skips: $!";
-$TESTOUT = *F{IO};
-$TESTERR = *F{IO};
+BEGIN {
+    if( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = '../lib';
+    }
+}
+
+use Test::More tests => 17;
+
+# If we skip with the same name, Test::Harness will report it back and
+# we won't get lots of false bug reports.
+my $Why = "Just testing the skip interface.";
 
-skip(1, 0);  #should skip
+SKIP: {
+    skip $Why, 2 
+      unless Pigs->can('fly');
 
-my $skipped=1;
-skip('hop', sub { $skipped = 0 });
-skip(sub {'jump'}, sub { $skipped = 0 });
-skip('skipping stones is more fun', sub { $skipped = 0 });
+    my $pig = Pigs->new;
+    $pig->takeoff;
 
-close F;
+    ok( $pig->altitude > 0,         'Pig is airborne' );
+    ok( $pig->airspeed > 0,         '  and moving'    );
+}
 
-$TESTOUT = *STDOUT{IO};
-$TESTERR = *STDERR{IO};
-$ntest = 1;
-open F, "skips" or die "open skips: $!";
 
-ok $skipped, 1, 'not skipped?';
+SKIP: {
+    skip "We're not skipping", 2 if 0;
 
-my @T = <F>;
-chop @T;
-my @expect = split /\n+/, join('',<DATA>);
-ok @T, 4;
-for (my $x=0; $x < @T; $x++) {
-    ok $T[$x], $expect[$x];
+    pass("Inside skip block");
+    pass("Another inside");
 }
 
-END { close F; unlink "skips" }
 
-__DATA__
-ok 1 # skip
+SKIP: {
+    skip "Again, not skipping", 2 if 0;
+
+    my($pack, $file, $line) = caller;
+    is( $pack || '', '',      'calling package not interfered with' );
+    is( $file || '', '',      '  or file' );
+    is( $line || '', '',      '  or line' );
+}
 
-ok 2 # skip hop
 
-ok 3 # skip jump
+SKIP: {
+    skip $Why, 2 if 1;
+
+    die "A horrible death";
+    fail("Deliberate failure");
+    fail("And again");
+}
+
+
+{
+    my $warning;
+    local $SIG{__WARN__} = sub { $warning = join "", @_ };
+    SKIP: {
+        # perl gets the line number a little wrong on the first
+        # statement inside a block.
+        1 == 1;
+#line 56
+        skip $Why;
+        fail("So very failed");
+    }
+    is( $warning, "skip() needs to know \$how_many tests are in the ".
+                  "block at $0 line 56\n",
+        'skip without $how_many warning' );
+}
 
-ok 4 # skip skipping stones is more fun
+
+SKIP: {
+    skip "Not skipping here.", 4 if 0;
+
+    pass("This is supposed to run");
+
+    # Testing out nested skips.
+    SKIP: {
+        skip $Why, 2;
+        fail("AHHH!");
+        fail("You're a failure");
+    }
+
+    pass("This is supposed to run, too");
+}
+
+{
+    my $warning = '';
+    local $SIG{__WARN__} = sub { $warning .= join "", @_ };
+
+    SKIP: {
+        skip 1, "This is backwards" if 1;
+
+        pass "This does not run";
+    }
+
+    like $warning, '/^skip\(\) was passed a non-numeric number of tests/';
+}
diff --git a/gnu/usr.bin/perl/lib/Test/t/skipall.t b/gnu/usr.bin/perl/lib/Test/t/skipall.t
new file mode 100644
index 00000000000..6f255e21ce5
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Test/t/skipall.t
@@ -0,0 +1,44 @@
+BEGIN {
+    if( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = ('../lib', 'lib');
+    }
+    else {
+        unshift @INC, 't/lib';
+    }
+}   
+
+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++;
+}
+
+
+package main;
+require Test::More;
+
+require Test::Simple::Catch;
+my($out, $err) = Test::Simple::Catch::caught();
+
+Test::More->import('skip_all');
+
+
+END {
+    My::Test::ok($$out eq "1..0\n");
+    My::Test::ok($$err eq "");
+}
diff --git a/gnu/usr.bin/perl/lib/Test/t/tbm_doesnt_set_exported_to.t b/gnu/usr.bin/perl/lib/Test/t/tbm_doesnt_set_exported_to.t
new file mode 100644
index 00000000000..8bdd17753b1
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Test/t/tbm_doesnt_set_exported_to.t
@@ -0,0 +1,24 @@
+#!/usr/bin/perl -w
+
+BEGIN {
+    if( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = '../lib';
+    }
+}
+
+use strict;
+use warnings;
+
+# Can't use Test::More, that would set exported_to()
+use Test::Builder;
+use Test::Builder::Module;
+
+my $TB = Test::Builder->create;
+$TB->plan( tests => 1 );
+$TB->level(0);
+
+$TB->is_eq( Test::Builder::Module->builder->exported_to,
+            undef,
+            'using Test::Builder::Module does not set exported_to()'
+);
diff --git a/gnu/usr.bin/perl/lib/Test/t/thread_taint.t b/gnu/usr.bin/perl/lib/Test/t/thread_taint.t
new file mode 100644
index 00000000000..ef7b89daeff
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Test/t/thread_taint.t
@@ -0,0 +1,5 @@
+#!/usr/bin/perl -w
+
+use Test::More tests => 1;
+
+ok( !$INC{'threads.pm'}, 'Loading Test::More does not load threads.pm' );
diff --git a/gnu/usr.bin/perl/lib/Test/t/threads.t b/gnu/usr.bin/perl/lib/Test/t/threads.t
new file mode 100644
index 00000000000..42ba8c269c7
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Test/t/threads.t
@@ -0,0 +1,33 @@
+#!/usr/bin/perl -w
+
+BEGIN {
+    if( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = '../lib';
+    }
+}
+
+use Config;
+BEGIN {
+    unless ( $] >= 5.008001 && $Config{'useithreads'} && 
+             eval { require threads; 'threads'->import; 1; }) 
+    {
+        print "1..0 # Skip: no working threads\n";
+        exit 0;
+    }
+}
+
+use strict;
+use Test::Builder;
+
+my $Test = Test::Builder->new;
+$Test->exported_to('main');
+$Test->plan(tests => 6);
+
+for(1..5) {
+	'threads'->create(sub { 
+          $Test->ok(1,"Each of these should app the test number") 
+    })->join;
+}
+
+$Test->is_num($Test->current_test(), 5,"Should be five");
diff --git a/gnu/usr.bin/perl/lib/Test/t/todo.t b/gnu/usr.bin/perl/lib/Test/t/todo.t
index 2f179e4547d..626b63d5221 100644
--- a/gnu/usr.bin/perl/lib/Test/t/todo.t
+++ b/gnu/usr.bin/perl/lib/Test/t/todo.t
@@ -1,48 +1,157 @@
-# -*-perl-*-
-use strict;
-use Test qw(:DEFAULT $TESTOUT $TESTERR $ntest);
-
-### This test is crafted in such a way as to prevent Test::Harness from
-### seeing the todo tests, otherwise you get people sending in bug reports
-### about Test.pm having "UNEXPECTEDLY SUCCEEDED" tests.
-
-open F, ">todo";
-$TESTOUT = *F{IO};
-$TESTERR = *F{IO};
-
-my $tests = 5; 
-plan tests => $tests, todo => [2..$tests]; 
-
-# line 11
-ok(1);
-ok(1);
-ok(0,1);
-ok(0,1,"need more tuits");
-ok(1,1);
-
-close F;
-$TESTOUT = *STDOUT{IO};
-$TESTERR = *STDERR{IO};
-$ntest = 1;
-
-open F, "todo";
-my $out = join '', <F>;
-close F;
-unlink "todo";
-
-my $expect = <<"EXPECT";
-1..5 todo 2 3 4 5;
-ok 1
-ok 2 # ($0 at line 12 TODO?!)
-not ok 3
-# Test 3 got: '0' ($0 at line 13 *TODO*)
-#   Expected: '1'
-not ok 4
-# Test 4 got: '0' ($0 at line 14 *TODO*)
-#   Expected: '1' (need more tuits)
-ok 5 # ($0 at line 15 TODO?!)
-EXPECT
-
-
-print "1..1\n";
-ok( $out, $expect );
+#!perl -w
+
+BEGIN {
+    if( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = '../lib';
+    }
+}
+
+use Test::More;
+
+plan tests => 36;
+
+
+$Why = 'Just testing the todo interface.';
+
+my $is_todo;
+TODO: {
+    local $TODO = $Why;
+
+    fail("Expected failure");
+    fail("Another expected failure");
+
+    $is_todo = Test::More->builder->todo;
+}
+
+pass("This is not todo");
+ok( $is_todo, 'TB->todo' );
+
+
+TODO: {
+    local $TODO = $Why;
+
+    fail("Yet another failure");
+}
+
+pass("This is still not todo");
+
+
+TODO: {
+    local $TODO = "testing that error messages don't leak out of todo";
+
+    ok( 'this' eq 'that',   'ok' );
+
+    like( 'this', '/that/', 'like' );
+    is(   'this', 'that',   'is' );
+    isnt( 'this', 'this',   'isnt' );
+
+    can_ok('Fooble', 'yarble');
+    isa_ok('Fooble', 'yarble');
+    use_ok('Fooble');
+    require_ok('Fooble');
+}
+
+
+TODO: {
+    todo_skip "Just testing todo_skip", 2;
+
+    fail("Just testing todo");
+    die "todo_skip should prevent this";
+    pass("Again");
+}
+
+
+{
+    my $warning;
+    local $SIG{__WARN__} = sub { $warning = join "", @_ };
+    TODO: {
+        # perl gets the line number a little wrong on the first
+        # statement inside a block.
+        1 == 1;
+#line 74
+        todo_skip "Just testing todo_skip";
+        fail("So very failed");
+    }
+    is( $warning, "todo_skip() needs to know \$how_many tests are in the ".
+                  "block at $0 line 74\n",
+        'todo_skip without $how_many warning' );
+}
+
+my $builder = Test::More->builder;
+my $exported_to = $builder->exported_to;
+TODO: {
+    $builder->exported_to("Wibble");
+    
+    local $TODO = "testing \$TODO with an incorrect exported_to()";
+    
+    fail("Just testing todo");
+}
+
+$builder->exported_to($exported_to);
+
+$builder->todo_start('Expected failures');
+fail('Testing todo_start()');
+ok 0, 'Testing todo_start() with more than one failure';
+$is_todo = $builder->todo;
+$builder->todo_end;
+is $is_todo, 'Expected failures',
+  'todo_start should have the correct TODO message';
+ok 1, 'todo_end() should not leak TODO behavior';
+
+my @nested_todo;
+my ( $level1, $level2 ) = ( 'failure level 1', 'failure_level 2' );
+TODO: {
+    local $TODO = 'Nesting TODO';
+    fail('fail 1');
+
+    $builder->todo_start($level1);
+    fail('fail 2');
+
+    push @nested_todo => $builder->todo;
+    $builder->todo_start($level2);
+    fail('fail 3');
+
+    push @nested_todo => $builder->todo;
+    $builder->todo_end;
+    fail('fail 4');
+
+    push @nested_todo => $builder->todo;
+    $builder->todo_end;
+    $is_todo = $builder->todo;
+    fail('fail 4');
+}
+is_deeply \@nested_todo, [ $level1, $level2, $level1 ],
+  'Nested TODO message should be correct';
+is $is_todo, 'Nesting TODO',
+  '... and original TODO message should be correct';
+
+{
+    $builder->todo_start;
+    fail("testing todo_start() with no message");
+    my $reason  = $builder->todo;
+    my $in_todo = $builder->in_todo;
+    $builder->todo_end;
+
+    is $reason, '', "  todo() reports no reason";
+    ok $in_todo,    "  but we're in_todo()";
+}
+
+eval {
+    $builder->todo_end;
+};
+is $@, sprintf "todo_end() called without todo_start() at %s line %d.\n", $0, __LINE__ - 2;
+
+
+{
+    my($reason, $in_todo);
+
+    TODO: {
+        local $TODO = '';
+        $reason  = $builder->todo;
+        $in_todo = $builder->in_todo;
+    }
+
+    is $reason, '';
+    ok !$in_todo, '$TODO = "" is not considered TODO';
+}
diff --git a/gnu/usr.bin/perl/lib/Test/t/undef.t b/gnu/usr.bin/perl/lib/Test/t/undef.t
new file mode 100644
index 00000000000..0e72419b0de
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Test/t/undef.t
@@ -0,0 +1,95 @@
+#!/usr/bin/perl -w
+
+BEGIN {
+    if( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = ('../lib', 'lib');
+    }
+    else {
+        unshift @INC, 't/lib';
+    }
+}
+
+use strict;
+use Test::More tests => 20;
+use TieOut;
+
+BEGIN { $^W = 1; }
+
+my $warnings = '';
+local $SIG{__WARN__} = sub { $warnings .= join '', @_ };
+
+my $TB = Test::Builder->new;
+sub no_warnings {
+    $TB->is_eq($warnings, '', '  no warnings');
+    $warnings = '';
+}
+
+sub warnings_is {
+    $TB->is_eq($warnings, $_[0]);
+    $warnings = '';
+}
+
+sub warnings_like {
+    $TB->like($warnings, $_[0]);
+    $warnings = '';
+}
+
+
+my $Filename = quotemeta $0;
+   
+
+is( undef, undef,           'undef is undef');
+no_warnings;
+
+isnt( undef, 'foo',         'undef isnt foo');
+no_warnings;
+
+isnt( undef, '',            'undef isnt an empty string' );
+isnt( undef, 0,             'undef isnt zero' );
+
+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' );
+warnings_like(qr/Use of uninitialized value.* at $Filename line 45\.\n/);
+
+eq_array( [undef, undef], [undef, 23] );
+no_warnings;
+
+eq_hash ( { foo => undef, bar => undef },
+          { foo => undef, bar => 23 } );
+no_warnings;
+
+eq_set  ( [undef, undef, 12], [29, undef, undef] );
+no_warnings;
+
+
+eq_hash ( { foo => undef, bar => { baz => undef, moo => 23 } },
+          { foo => undef, bar => { baz => undef, moo => 23 } } );
+no_warnings;
+
+
+#line 64
+cmp_ok( undef, '<=', 2, '  undef <= 2' );
+warnings_like(qr/Use of uninitialized value.* at cmp_ok \[from $Filename line 64\] line 1\.\n/);
+
+
+
+my $tb = Test::More->builder;
+
+use TieOut;
+my $caught = tie *CATCH, 'TieOut';
+my $old_fail = $tb->failure_output;
+$tb->failure_output(\*CATCH);
+diag(undef);
+$tb->failure_output($old_fail);
+
+is( $caught->read, "# undef\n" );
+no_warnings;
+
+
+$tb->maybe_regex(undef);
+is( $caught->read, '' );
+no_warnings;
diff --git a/gnu/usr.bin/perl/lib/Test/t/use_ok.t b/gnu/usr.bin/perl/lib/Test/t/use_ok.t
new file mode 100644
index 00000000000..4a62f3557e8
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Test/t/use_ok.t
@@ -0,0 +1,67 @@
+#!/usr/bin/perl -w
+
+BEGIN {
+    if( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = qw(../lib ../lib/Test/Simple/t/lib);
+    }
+    else {
+        unshift @INC, 't/lib';
+    }
+}
+
+use Test::More tests => 15;
+
+# Using Symbol because it's core and exports lots of stuff.
+{
+    package Foo::one;
+    ::use_ok("Symbol");
+    ::ok( defined &gensym,        'use_ok() no args exports defaults' );
+}
+
+{
+    package Foo::two;
+    ::use_ok("Symbol", qw(qualify));
+    ::ok( !defined &gensym,       '  one arg, defaults overriden' );
+    ::ok( defined &qualify,       '  right function exported' );
+}
+
+{
+    package Foo::three;
+    ::use_ok("Symbol", qw(gensym ungensym));
+    ::ok( defined &gensym && defined &ungensym,   '  multiple args' );
+}
+
+{
+    package Foo::four;
+    my $warn; local $SIG{__WARN__} = sub { $warn .= shift; };
+    ::use_ok("constant", qw(foo bar));
+    ::ok( defined &foo, 'constant' );
+    ::is( $warn, undef, 'no warning');
+}
+
+{
+    package Foo::five;
+    ::use_ok("Symbol", 1.02);
+}
+
+{
+    package Foo::six;
+    ::use_ok("NoExporter", 1.02);
+}
+
+{
+    package Foo::seven;
+    local $SIG{__WARN__} = sub {
+        # Old perls will warn on X.YY_ZZ style versions.  Not our problem
+        warn @_ unless $_[0] =~ /^Argument "\d+\.\d+_\d+" isn't numeric/;
+    };
+    ::use_ok("Test::More", 0.47);
+}
+
+{
+    package Foo::eight;
+    local $SIG{__DIE__};
+    ::use_ok("SigDie");
+    ::ok(defined $SIG{__DIE__}, '  SIG{__DIE__} preserved');
+}
diff --git a/gnu/usr.bin/perl/lib/Test/t/useing.t b/gnu/usr.bin/perl/lib/Test/t/useing.t
new file mode 100644
index 00000000000..c4ce5071270
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Test/t/useing.t
@@ -0,0 +1,19 @@
+BEGIN {
+    if( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = '../lib';
+    }
+}
+
+use Test::More tests => 5;
+
+require_ok('Test::Builder');
+require_ok("Test::More");
+require_ok("Test::Simple");
+
+{
+    package Foo;
+    use Test::More import => [qw(ok is can_ok)];
+    can_ok('Foo', qw(ok is can_ok));
+    ok( !Foo->can('like'),  'import working properly' );
+}
diff --git a/gnu/usr.bin/perl/lib/Test/t/utf8.t b/gnu/usr.bin/perl/lib/Test/t/utf8.t
new file mode 100644
index 00000000000..c7e93c3ac2d
--- /dev/null
+++ b/gnu/usr.bin/perl/lib/Test/t/utf8.t
@@ -0,0 +1,69 @@
+#!/usr/bin/perl -w
+
+BEGIN {
+    if( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = '../lib';
+    }
+}
+
+use strict;
+use warnings;
+
+use Test::More skip_all => 'Not yet implemented';
+
+my $have_perlio;
+BEGIN {
+    # All together so Test::More sees the open discipline
+    $have_perlio = eval q[
+        use PerlIO;
+        use open ':std', ':locale';
+        use Test::More;
+        1;
+    ];
+}
+
+use Test::More;
+
+if( !$have_perlio ) {
+    plan skip_all => "Don't have PerlIO";
+}
+else {
+    plan tests => 5;
+}
+
+SKIP: {
+    skip( "Need PerlIO for this feature", 3 )
+        unless $have_perlio;
+
+    my %handles = (
+        output          => \*STDOUT,
+        failure_output  => \*STDERR,
+        todo_output     => \*STDOUT
+    );
+
+    for my $method (keys %handles) {
+        my $src = $handles{$method};
+        
+        my $dest = Test::More->builder->$method;
+        
+        is_deeply { map { $_ => 1 } PerlIO::get_layers($dest) },
+                  { map { $_ => 1 } PerlIO::get_layers($src)  },
+                  "layers copied to $method";
+    }
+}
+
+SKIP: {
+    skip( "Can't test in general because their locale is unknown", 2 )
+        unless $ENV{AUTHOR_TESTING};
+
+    my $uni = "\x{11e}";
+    
+    my @warnings;
+    local $SIG{__WARN__} = sub {
+        push @warnings, @_;
+    };
+
+    is( $uni, $uni, "Testing $uni" );
+    is_deeply( \@warnings, [] );
+}