these files are used for building complexe test files

6 files changed, 4620 insertions, 0 deletions

diff --git a/Perl/t/Test/Builder.pm b/Perl/t/Test/Builder.pm
new file mode 100644
index 0000000..6f3edd8
--- /dev/null
+++ b/Perl/t/Test/Builder.pm
@@ -0,0 +1,1408 @@
+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 strict;
+use vars qw($VERSION $CLASS);
+$VERSION = '0.17';
+$CLASS = __PACKAGE__;
+
+my $IsVMS = $^O eq 'VMS';
+
+# Make Test::Builder thread-safe for ithreads.
+BEGIN {
+    use Config;
+    if( $] >= 5.008 && $Config{useithreads} ) {
+        require threads;
+        require threads::shared;
+        threads::shared->import;
+    }
+    else {
+        *share = sub { 0 };
+        *lock  = sub { 0 };
+    }
+}
+
+use vars qw($Level);
+my($Test_Died) = 0;
+my($Have_Plan) = 0;
+my $Original_Pid = $$;
+my $Curr_Test = 0;      share($Curr_Test);
+my @Test_Results = ();  share(@Test_Results);
+my @Test_Details = ();  share(@Test_Details);
+
+
+=head1 NAME
+
+Test::Builder - Backend for building test libraries
+
+=head1 SYNOPSIS
+
+  package My::Test::Module;
+  use Test::Builder;
+  require Exporter;
+  @ISA = qw(Exporter);
+  @EXPORT = qw(ok);
+
+  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');
+  }
+
+  sub ok {
+      my($test, $name) = @_;
+
+      $Test->ok($test, $name);
+  }
+
+
+=head1 DESCRIPTION
+
+Test::Simple and Test::More have proven to be popular testing modules,
+but they're not always flexible enough.  Test::Builder provides the a
+building block upon which to write your own test libraries I<which can
+work together>.
+
+=head2 Construction
+
+=over 4
+
+=item B<new>
+
+  my $Test = Test::Builder->new;
+
+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>
+Test::Builder object.  No matter how many times you call new(), you're
+getting the same object.  (This is called a singleton).
+
+=cut
+
+my $Test;
+sub new {
+    my($class) = shift;
+    $Test ||= bless ['Move along, nothing to see here'], $class;
+    return $Test;
+}
+
+=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<exported_to>
+
+  my $pack = $Test->exported_to;
+  $Test->exported_to($pack);
+
+Tells Test::Builder what package you exported your functions to.
+This is important for getting TODO tests right.
+
+=cut
+
+my $Exported_To;
+sub exported_to {
+    my($self, $pack) = @_;
+
+    if( defined $pack ) {
+        $Exported_To = $pack;
+    }
+    return $Exported_To;
+}
+
+=item B<plan>
+
+  $Test->plan('no_plan');
+  $Test->plan( skip_all => $reason );
+  $Test->plan( tests => $num_tests );
+
+A convenient way to set up your tests.  Call this and Test::Builder
+will print the appropriate headers and take the appropriate actions.
+
+If you call plan(), don't call any of the other methods below.
+
+=cut
+
+sub plan {
+    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];
+    }
+
+    if( $cmd eq 'no_plan' ) {
+        $self->no_plan;
+    }
+    elsif( $cmd eq 'skip_all' ) {
+        return $self->skip_all($arg);
+    }
+    elsif( $cmd eq 'tests' ) {
+        if( $arg ) {
+            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";
+        }
+        elsif( !$arg ) {
+            die "You said to run 0 tests!  You've got to run something.\n";
+        }
+    }
+    else {
+        require Carp;
+        my @args = grep { defined } ($cmd, $arg);
+        Carp::croak("plan() doesn't understand @args");
+    }
+
+    return 1;
+}
+
+=item B<expected_tests>
+
+    my $max = $Test->expected_tests;
+    $Test->expected_tests($max);
+
+Gets/sets the # of tests we expect this test to run and prints out
+the appropriate headers.
+
+=cut
+
+my $Expected_Tests = 0;
+sub expected_tests {
+    my($self, $max) = @_;
+
+    if( defined $max ) {
+        $Expected_Tests = $max;
+        $Have_Plan      = 1;
+
+        $self->_print("1..$max\n") unless $self->no_header;
+    }
+    return $Expected_Tests;
+}
+
+
+=item B<no_plan>
+
+  $Test->no_plan;
+
+Declares that this test will run an indeterminate # of tests.
+
+=cut
+
+my($No_Plan) = 0;
+sub no_plan {
+    $No_Plan    = 1;
+    $Have_Plan  = 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 {
+	return($Expected_Tests) if $Expected_Tests;
+	return('no_plan') if $No_Plan;
+	return(undef);
+};
+
+
+=item B<skip_all>
+
+  $Test->skip_all;
+  $Test->skip_all($reason);
+
+Skips all the tests, using the given $reason.  Exits immediately with 0.
+
+=cut
+
+my $Skip_All = 0;
+sub skip_all {
+    my($self, $reason) = @_;
+
+    my $out = "1..0";
+    $out .= " # Skip $reason" if $reason;
+    $out .= "\n";
+
+    $Skip_All = 1;
+
+    $self->_print($out) unless $self->no_header;
+    exit(0);
+}
+
+=back
+
+=head2 Running tests
+
+These actually run the tests, analogous to the functions in
+Test::More.
+
+$name is always optional.
+
+=over 4
+
+=item B<ok>
+
+  $Test->ok($test, $name);
+
+Your basic test.  Pass if $test is true, fail if $test is false.  Just
+like Test::Simple's ok().
+
+=cut
+
+sub ok {
+    my($self, $test, $name) = @_;
+
+    # $test might contain an object which we don't want to accidentally
+    # store, so we turn it into a boolean.
+    $test = $test ? 1 : 0;
+
+    unless( $Have_Plan ) {
+        require Carp;
+        Carp::croak("You tried to run a test without a plan!  Gotta have a plan.");
+    }
+
+    lock $Curr_Test;
+    $Curr_Test++;
+
+    $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;
+
+    my $todo = $self->todo($pack);
+
+    my $out;
+    my $result = {};
+    share($result);
+
+    unless( $test ) {
+        $out .= "not ";
+        @$result{ 'ok', 'actual_ok' } = ( ( $todo ? 1 : 0 ), 0 );
+    }
+    else {
+        @$result{ 'ok', 'actual_ok' } = ( 1, $test );
+    }
+
+    $out .= "ok";
+    $out .= " $Curr_Test" if $self->use_numbers;
+
+    if( defined $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";
+        $result->{reason} = $what_todo;
+        $result->{type}   = 'todo';
+    }
+    else {
+        $result->{reason} = '';
+        $result->{type}   = '';
+    }
+
+    $Test_Results[$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");
+    } 
+
+    return $test ? 1 : 0;
+}
+
+=item B<is_eq>
+
+  $Test->is_eq($got, $expected, $name);
+
+Like Test::More's is().  Checks if $got eq $expected.  This is the
+string version.
+
+=item B<is_num>
+
+  $Test->is_num($got, $expected, $name);
+
+Like Test::More's is().  Checks if $got == $expected.  This is the
+numeric version.
+
+=cut
+
+sub is_eq {
+    my($self, $got, $expect, $name) = @_;
+    local $Level = $Level + 1;
+
+    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;
+        return $test;
+    }
+
+    return $self->cmp_ok($got, 'eq', $expect, $name);
+}
+
+sub is_num {
+    my($self, $got, $expect, $name) = @_;
+    local $Level = $Level + 1;
+
+    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;
+        return $test;
+    }
+
+    return $self->cmp_ok($got, '==', $expect, $name);
+}
+
+sub _is_diag {
+    my($self, $got, $type, $expect) = @_;
+
+    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;
+            }
+        }
+        else {
+            $$val = 'undef';
+        }
+    }
+
+    return $self->diag(sprintf <<DIAGNOSTIC, $got, $expect);
+         got: %s
+    expected: %s
+DIAGNOSTIC
+
+}    
+
+=item B<isnt_eq>
+
+  $Test->isnt_eq($got, $dont_expect, $name);
+
+Like Test::More's isnt().  Checks if $got ne $dont_expect.  This is
+the string version.
+
+=item B<isnt_num>
+
+  $Test->is_num($got, $dont_expect, $name);
+
+Like Test::More's isnt().  Checks if $got ne $dont_expect.  This is
+the numeric version.
+
+=cut
+
+sub isnt_eq {
+    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;
+        return $test;
+    }
+
+    return $self->cmp_ok($got, 'ne', $dont_expect, $name);
+}
+
+sub isnt_num {
+    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;
+        return $test;
+    }
+
+    return $self->cmp_ok($got, '!=', $dont_expect, $name);
+}
+
+
+=item B<like>
+
+  $Test->like($this, qr/$regex/, $name);
+  $Test->like($this, '/$regex/', $name);
+
+Like Test::More's like().  Checks if $this matches the given $regex.
+
+You'll want to avoid qr// if you want your tests to work before 5.005.
+
+=item B<unlike>
+
+  $Test->unlike($this, qr/$regex/, $name);
+  $Test->unlike($this, '/$regex/', $name);
+
+Like Test::More's unlike().  Checks if $this B<does not match> the
+given $regex.
+
+=cut
+
+sub like {
+    my($self, $this, $regex, $name) = @_;
+
+    local $Level = $Level + 1;
+    $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) = @_;
+
+    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;
+}
+
+=item B<cmp_ok>
+
+  $Test->cmp_ok($this, $type, $that, $name);
+
+Works just like Test::More's cmp_ok().
+
+    $Test->cmp_ok($big_num, '!=', $other_big_num);
+
+=cut
+
+sub cmp_ok {
+    my($self, $got, $type, $expect, $name) = @_;
+
+    my $test;
+    {
+        local $^W = 0;
+        local($@,$!);   # don't interfere with $@
+                        # eval() sometimes resets $!
+        $test = eval "\$got $type \$expect";
+    }
+    local $Level = $Level + 1;
+    my $ok = $self->ok($test, $name);
+
+    unless( $ok ) {
+        if( $type =~ /^(eq|==)$/ ) {
+            $self->_is_diag($got, $type, $expect);
+        }
+        else {
+            $self->_cmp_diag($got, $type, $expect);
+        }
+    }
+    return $ok;
+}
+
+sub _cmp_diag {
+    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
+DIAGNOSTIC
+}
+
+=item B<BAILOUT>
+
+    $Test->BAILOUT($reason);
+
+Indicates to the Test::Harness that things are going so badly all
+testing should terminate.  This includes running any additional test
+scripts.
+
+It will exit with 255.
+
+=cut
+
+sub BAILOUT {
+    my($self, $reason) = @_;
+
+    $self->_print("Bail out!  $reason");
+    exit 255;
+}
+
+=item B<skip>
+
+    $Test->skip;
+    $Test->skip($why);
+
+Skips the current test, reporting $why.
+
+=cut
+
+sub skip {
+    my($self, $why) = @_;
+    $why ||= '';
+
+    unless( $Have_Plan ) {
+        require Carp;
+        Carp::croak("You tried to run tests without a plan!  Gotta have a plan.");
+    }
+
+    lock($Curr_Test);
+    $Curr_Test++;
+
+    my %result;
+    share(%result);
+    %result = (
+        'ok'      => 1,
+        actual_ok => 1,
+        name      => '',
+        type      => 'skip',
+        reason    => $why,
+    );
+    $Test_Results[$Curr_Test-1] = \%result;
+
+    my $out = "ok";
+    $out   .= " $Curr_Test" if $self->use_numbers;
+    $out   .= " # skip $why\n";
+
+    $Test->_print($out);
+
+    return 1;
+}
+
+
+=item B<todo_skip>
+
+  $Test->todo_skip;
+  $Test->todo_skip($why);
+
+Like skip(), only it will declare the test as failing and TODO.  Similar
+to
+
+    print "not ok $tnum # TODO $why\n";
+
+=cut
+
+sub todo_skip {
+    my($self, $why) = @_;
+    $why ||= '';
+
+    unless( $Have_Plan ) {
+        require Carp;
+        Carp::croak("You tried to run tests without a plan!  Gotta have a plan.");
+    }
+
+    lock($Curr_Test);
+    $Curr_Test++;
+
+    my %result;
+    share(%result);
+    %result = (
+        'ok'      => 1,
+        actual_ok => 0,
+        name      => '',
+        type      => 'todo_skip',
+        reason    => $why,
+    );
+
+    $Test_Results[$Curr_Test-1] = \%result;
+
+    my $out = "not ok";
+    $out   .= " $Curr_Test" if $self->use_numbers;
+    $out   .= " # TODO & SKIP $why\n";
+
+    $Test->_print($out);
+
+    return 1;
+}
+
+
+=begin _unimplemented
+
+=item B<skip_rest>
+
+  $Test->skip_rest;
+  $Test->skip_rest($reason);
+
+Like skip(), only it skips all the rest of the tests you plan to run
+and terminates the test.
+
+If you're running under no_plan, it skips once and terminates the
+test.
+
+=end _unimplemented
+
+=back
+
+
+=head2 Test style
+
+=over 4
+
+=item B<level>
+
+    $Test->level($how_high);
+
+How far up the call stack should $Test look when reporting where the
+test failed.
+
+Defaults to 1.
+
+Setting $Test::Builder::Level overrides.  This is typically useful
+localized:
+
+    {
+        local $Test::Builder::Level = 2;
+        $Test->ok($test);
+    }
+
+=cut
+
+sub level {
+    my($self, $level) = @_;
+
+    if( defined $level ) {
+        $Level = $level;
+    }
+    return $Level;
+}
+
+$CLASS->level(1);
+
+
+=item B<use_numbers>
+
+    $Test->use_numbers($on_or_off);
+
+Whether or not the test should output numbers.  That is, this if true:
+
+  ok 1
+  ok 2
+  ok 3
+
+or this if false
+
+  ok
+  ok
+  ok
+
+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) = @_;
+
+    if( defined $use_nums ) {
+        $Use_Nums = $use_nums;
+    }
+    return $Use_Nums;
+}
+
+=item B<no_header>
+
+    $Test->no_header($no_header);
+
+If set to true, no "1..N" header will be printed.
+
+=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.
+
+If this is true, none of that will be done.
+
+=cut
+
+my($No_Header, $No_Ending) = (0,0);
+sub no_header {
+    my($self, $no_header) = @_;
+
+    if( defined $no_header ) {
+        $No_Header = $no_header;
+    }
+    return $No_Header;
+}
+
+sub no_ending {
+    my($self, $no_ending) = @_;
+
+    if( defined $no_ending ) {
+        $No_Ending = $no_ending;
+    }
+    return $No_Ending;
+}
+
+
+=back
+
+=head2 Output
+
+Controlling where the test output goes.
+
+It's ok for your test to change where STDOUT and STDERR point to,
+Test::Builder's default output settings will not be affected.
+
+=over 4
+
+=item B<diag>
+
+    $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.
+
+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
+already.
+
+We encourage using this rather than calling print directly.
+
+Returns false.  Why?  Because diag() is often used in conjunction with
+a failing test (C<ok() || diag()>) it "passes through" the failure.
+
+    return ok(...) || diag(...);
+
+=for blame transfer
+Mark Fowler <mark@twoshortplanks.com>
+
+=cut
+
+sub diag {
+    my($self, @msgs) = @_;
+    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;
+    }
+
+    push @msgs, "\n" unless $msgs[-1] =~ /\n\Z/;
+
+    local $Level = $Level + 1;
+    my $fh = $self->todo ? $self->todo_output : $self->failure_output;
+    local($\, $", $,) = (undef, ' ', '');
+    print $fh @msgs;
+
+    return 0;
+}
+
+=begin _private
+
+=item B<_print>
+
+    $Test->_print(@msgs);
+
+Prints to the output() filehandle.
+
+=end _private
+
+=cut
+
+sub _print {
+    my($self, @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;
+
+    # Escape each line after the first with a # so we don't
+    # confuse Test::Harness.
+    foreach (@msgs) {
+        s/\n(.)/\n# $1/sg;
+    }
+
+    push @msgs, "\n" unless $msgs[-1] =~ /\n\Z/;
+
+    print $fh @msgs;
+}
+
+
+=item B<output>
+
+    $Test->output($fh);
+    $Test->output($file);
+
+Where normal "ok/not ok" test output should go.
+
+Defaults to STDOUT.
+
+=item B<failure_output>
+
+    $Test->failure_output($fh);
+    $Test->failure_output($file);
+
+Where diagnostic output on test failures and diag() should go.
+
+Defaults to STDERR.
+
+=item B<todo_output>
+
+    $Test->todo_output($fh);
+    $Test->todo_output($file);
+
+Where diagnostics about todo test failures and diag() should go.
+
+Defaults to STDOUT.
+
+=cut
+
+my($Out_FH, $Fail_FH, $Todo_FH);
+sub output {
+    my($self, $fh) = @_;
+
+    if( defined $fh ) {
+        $Out_FH = _new_fh($fh);
+    }
+    return $Out_FH;
+}
+
+sub failure_output {
+    my($self, $fh) = @_;
+
+    if( defined $fh ) {
+        $Fail_FH = _new_fh($fh);
+    }
+    return $Fail_FH;
+}
+
+sub todo_output {
+    my($self, $fh) = @_;
+
+    if( defined $fh ) {
+        $Todo_FH = _new_fh($fh);
+    }
+    return $Todo_FH;
+}
+
+sub _new_fh {
+    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: $!";
+    }
+    else {
+        $fh = $file_or_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:  $!";
+
+    # 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);
+
+    $CLASS->output(\*TESTOUT);
+    $CLASS->failure_output(\*TESTERR);
+    $CLASS->todo_output(\*TESTOUT);
+}
+
+sub _autoflush {
+    my($fh) = shift;
+    my $old_fh = select $fh;
+    $| = 1;
+    select $old_fh;
+}
+
+
+=back
+
+
+=head2 Test Status and Info
+
+=over 4
+
+=item B<current_test>
+
+    my $curr_test = $Test->current_test;
+    $Test->current_test($num);
+
+Gets/sets the current test # we're on.
+
+You usually shouldn't have to set this.
+
+=cut
+
+sub current_test {
+    my($self, $num) = @_;
+
+    lock($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 + 1 : 0;
+            for ($start..$num-1) {
+                my %result;
+                share(%result);
+                %result = ( ok        => 1, 
+                            actual_ok => undef, 
+                            reason    => 'incrementing test number', 
+                            type      => 'unknown', 
+                            name      => undef 
+                          );
+                $Test_Results[$_] = \%result;
+            }
+        }
+    }
+    return $Curr_Test;
+}
+
+
+=item B<summary>
+
+    my @tests = $Test->summary;
+
+A simple summary of the tests so far.  True for pass, false for fail.
+This is a logical pass/fail, so todos are passes.
+
+Of course, test #1 is $tests[0], etc...
+
+=cut
+
+sub summary {
+    my($self) = shift;
+
+    return map { $_->{'ok'} } @Test_Results;
+}
+
+=item B<details>
+
+    my @tests = $Test->details;
+
+Like summary(), but with a lot more detail.
+
+    $tests[$test_num - 1] = 
+            { 'ok'       => is the test considered a pass?
+              actual_ok  => did it literally say 'ok'?
+              name       => name of the test (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
+it's type is 'unkown'.  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 {
+    return @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.
+
+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.
+
+Sometimes there is some confusion about where todo() should be looking
+for the $TODO variable.  If you want to be sure, tell it explicitly
+what $pack to use.
+
+=cut
+
+sub todo {
+    my($self, $pack) = @_;
+
+    $pack = $pack || $self->exported_to || $self->caller(1);
+
+    no strict 'refs';
+    return defined ${$pack.'::TODO'} ? ${$pack.'::TODO'}
+                                     : 0;
+}
+
+=item B<caller>
+
+    my $package = $Test->caller;
+    my($pack, $file, $line) = $Test->caller;
+    my($pack, $file, $line) = $Test->caller($height);
+
+Like the normal caller(), except it reports according to your level().
+
+=cut
+
+sub caller {
+    my($self, $height) = @_;
+    $height ||= 0;
+
+    my @caller = CORE::caller($self->level + $height + 1);
+    return wantarray ? @caller : $caller[0];
+}
+
+=back
+
+=cut
+
+=begin _private
+
+=over 4
+
+=item B<_sanity_check>
+
+  _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
+error message.
+
+=cut
+
+#'#
+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!');
+}
+
+=item B<_whoa>
+
+  _whoa($check, $description);
+
+A sanity check, similar to assert().  If the $check is true, something
+has gone horribly wrong.  It will die with the given $description and
+a note to contact the author.
+
+=cut
+
+sub _whoa {
+    my($check, $desc) = @_;
+    if( $check ) {
+        die <<WHOA;
+WHOA!  $desc
+This should never happen!  Please contact the author immediately!
+WHOA
+    }
+}
+
+=item B<_my_exit>
+
+  _my_exit($exit_num);
+
+Perl seems to have some trouble with exiting inside an END block.  5.005_03
+and 5.6.1 both seem to do odd things.  Instead, this function edits $?
+directly.  It should ONLY be called from inside an END block.  It
+doesn't actually exit, that's your job.
+
+=cut
+
+sub _my_exit {
+    $? = $_[0];
+
+    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();
+
+    # Don't bother with an ending if this is a forked copy.  Only the parent
+    # should do the ending.
+    do{ _my_exit($?) && return } if $Original_Pid != $$;
+
+    # Bailout if plan() was never called.  This is so
+    # "require Test::Simple" doesn't puke.
+    do{ _my_exit(0) && return } if !$Have_Plan && !$Test_Died;
+
+    # Figure out if we passed or failed and print helpful messages.
+    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;
+        }
+
+        # 5.8.0 threads bug.  Shared arrays will not be auto-extended 
+        # by a slice.  Worse, we have to fill in every entry else
+        # we'll get an "Invalid value for shared scalar" error
+        for my $idx ($#Test_Results..$Expected_Tests-1) {
+            my %empty_result = ();
+            share(%empty_result);
+            $Test_Results[$idx] = \%empty_result
+              unless defined $Test_Results[$idx];
+        }
+
+        my $num_failed = grep !$_->{'ok'}, @Test_Results[0..$Expected_Tests-1];
+        $num_failed += abs($Expected_Tests - @Test_Results);
+
+        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;
+            $self->diag(<<"FAIL");
+Looks like you planned $Expected_Tests tests but ran $num_extra extra.
+FAIL
+        }
+        elsif ( $num_failed ) {
+            $self->diag(<<"FAIL");
+Looks like you failed $num_failed tests of $Expected_Tests.
+FAIL
+        }
+
+        if( $Test_Died ) {
+            $self->diag(<<"FAIL");
+Looks like your test died just after $Curr_Test.
+FAIL
+
+            _my_exit( 255 ) && return;
+        }
+
+        _my_exit( $num_failed <= 254 ? $num_failed : 254  ) && return;
+    }
+    elsif ( $Skip_All ) {
+        _my_exit( 0 ) && return;
+    }
+    elsif ( $Test_Died ) {
+        $self->diag(<<'FAIL');
+Looks like your test died before it could output anything.
+FAIL
+    }
+    else {
+        $self->diag("No tests run!\n");
+        _my_exit( 255 ) && return;
+    }
+}
+
+END {
+    $Test->_ending if defined $Test and !$Test->no_ending;
+}
+
+=head1 THREADS
+
+In perl 5.8.0 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.
+
+=head1 EXAMPLES
+
+CPAN can provide the best examples.  Test::Simple, Test::More,
+Test::Exception and Test::Differences all use Test::Builder.
+
+=head1 SEE ALSO
+
+Test::Simple, Test::More, Test::Harness
+
+=head1 AUTHORS
+
+Original code by chromatic, maintained by Michael G Schwern
+E<lt>schwern@pobox.comE<gt>
+
+=head1 COPYRIGHT
+
+Copyright 2002 by chromatic E<lt>chromatic@wgz.orgE<gt>,
+                  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.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=cut
+
+1;
diff --git a/Perl/t/Test/Harness.pm b/Perl/t/Test/Harness.pm
new file mode 100644
index 0000000..0897455
--- /dev/null
+++ b/Perl/t/Test/Harness.pm
@@ -0,0 +1,1168 @@
+# -*- Mode: cperl; cperl-indent-level: 4 -*-
+# $Id$
+
+package Test::Harness;
+
+require 5.004;
+use Test::Harness::Straps;
+use Test::Harness::Assert;
+use Exporter;
+use Benchmark;
+use Config;
+use strict;
+
+use vars qw($VERSION $Verbose $Switches $Have_Devel_Corestack $Curtest
+            $Columns $verbose $switches $ML $Strap
+            @ISA @EXPORT @EXPORT_OK $Last_ML_Print
+           );
+
+# Backwards compatibility for exportable variable names.
+*verbose  = *Verbose;
+*switches = *Switches;
+
+$Have_Devel_Corestack = 0;
+
+$VERSION = '2.30';
+
+$ENV{HARNESS_ACTIVE} = 1;
+
+END {
+    # For VMS.
+    delete $ENV{HARNESS_ACTIVE};
+}
+
+# Some experimental versions of OS/2 build have broken $?
+my $Ignore_Exitcode = $ENV{HARNESS_IGNORE_EXITCODE};
+
+my $Files_In_Dir = $ENV{HARNESS_FILELEAK_IN_DIR};
+
+my $Ok_Slow = $ENV{HARNESS_OK_SLOW};
+
+$Strap = Test::Harness::Straps->new;
+
+@ISA = ('Exporter');
+@EXPORT    = qw(&runtests);
+@EXPORT_OK = qw($verbose $switches);
+
+$Verbose  = $ENV{HARNESS_VERBOSE} || 0;
+$Switches = "-w";
+$Columns  = $ENV{HARNESS_COLUMNS} || $ENV{COLUMNS} || 80;
+$Columns--;             # Some shells have trouble with a full line of text.
+
+
+=head1 NAME
+
+Test::Harness - run perl standard test scripts with statistics
+
+=head1 SYNOPSIS
+
+  use Test::Harness;
+
+  runtests(@test_files);
+
+=head1 DESCRIPTION
+
+B<STOP!> If all you want to do is write a test script, consider using
+Test::Simple.  Otherwise, read on.
+
+(By using the Test module, you can write test scripts without
+knowing the exact output this module expects.  However, if you need to
+know the specifics, read on!)
+
+Perl test scripts print to standard output C<"ok N"> for each single
+test, where C<N> is an increasing sequence of integers. The first line
+output by a standard test script is C<"1..M"> with C<M> being the
+number of tests that should be run within the test
+script. Test::Harness::runtests(@tests) runs all the testscripts
+named as arguments and checks standard output for the expected
+C<"ok N"> strings.
+
+After all tests have been performed, runtests() prints some
+performance statistics that are computed by the Benchmark module.
+
+=head2 The test script output
+
+The following explains how Test::Harness interprets the output of your
+test program.
+
+=over 4
+
+=item B<'1..M'>
+
+This header tells how many tests there will be.  For example, C<1..10>
+means you plan on running 10 tests.  This is a safeguard in case your
+test dies quietly in the middle of its run.
+
+It should be the first non-comment line output by your test program.
+
+In certain instances, you may not know how many tests you will
+ultimately be running.  In this case, it is permitted for the 1..M
+header to appear as the B<last> line output by your test (again, it
+can be followed by further comments).
+
+Under B<no> circumstances should 1..M appear in the middle of your
+output or more than once.
+
+
+=item B<'ok', 'not ok'.  Ok?>
+
+Any output from the testscript to standard error is ignored and
+bypassed, thus will be seen by the user. Lines written to standard
+output containing C</^(not\s+)?ok\b/> are interpreted as feedback for
+runtests().  All other lines are discarded.
+
+C</^not ok/> indicates a failed test.  C</^ok/> is a successful test.
+
+
+=item B<test numbers>
+
+Perl normally expects the 'ok' or 'not ok' to be followed by a test
+number.  It is tolerated if the test numbers after 'ok' are
+omitted. In this case Test::Harness maintains temporarily its own
+counter until the script supplies test numbers again. So the following
+test script
+
+    print <<END;
+    1..6
+    not ok
+    ok
+    not ok
+    ok
+    ok
+    END
+
+will generate
+
+    FAILED tests 1, 3, 6
+    Failed 3/6 tests, 50.00% okay
+
+=item B<test names>
+
+Anything after the test number but before the # is considered to be
+the name of the test.
+
+  ok 42 this is the name of the test
+
+Currently, Test::Harness does nothing with this information.
+
+=item B<Skipping tests>
+
+If the standard output line contains the substring C< # Skip> (with
+variations in spacing and case) after C<ok> or C<ok NUMBER>, it is
+counted as a skipped test.  If the whole testscript succeeds, the
+count of skipped tests is included in the generated output.
+C<Test::Harness> reports the text after C< # Skip\S*\s+> as a reason
+for skipping.
+
+  ok 23 # skip Insufficient flogiston pressure.
+
+Similarly, one can include a similar explanation in a C<1..0> line
+emitted if the test script is skipped completely:
+
+  1..0 # Skipped: no leverage found
+
+=item B<Todo tests>
+
+If the standard output line contains the substring C< # TODO> after
+C<not ok> or C<not ok NUMBER>, it is counted as a todo test.  The text
+afterwards is the thing that has to be done before this test will
+succeed.
+
+  not ok 13 # TODO harness the power of the atom
+
+=begin _deprecated
+
+Alternatively, you can specify a list of what tests are todo as part
+of the test header.
+
+  1..23 todo 5 12 23
+
+This only works if the header appears at the beginning of the test.
+
+This style is B<deprecated>.
+
+=end _deprecated
+
+These tests represent a feature to be implemented or a bug to be fixed
+and act as something of an executable "thing to do" list.  They are
+B<not> expected to succeed.  Should a todo test begin succeeding,
+Test::Harness will report it as a bonus.  This indicates that whatever
+you were supposed to do has been done and you should promote this to a
+normal test.
+
+=item B<Bail out!>
+
+As an emergency measure, a test script can decide that further tests
+are useless (e.g. missing dependencies) and testing should stop
+immediately. In that case the test script prints the magic words
+
+  Bail out!
+
+to standard output. Any message after these words will be displayed by
+C<Test::Harness> as the reason why testing is stopped.
+
+=item B<Comments>
+
+Additional comments may be put into the testing output on their own
+lines.  Comment lines should begin with a '#', Test::Harness will
+ignore them.
+
+  ok 1
+  # Life is good, the sun is shining, RAM is cheap.
+  not ok 2
+  # got 'Bush' expected 'Gore'
+
+=item B<Anything else>
+
+Any other output Test::Harness sees it will silently ignore B<BUT WE
+PLAN TO CHANGE THIS!> If you wish to place additional output in your
+test script, please use a comment.
+
+=back
+
+
+=head2 Taint mode
+
+Test::Harness will honor the C<-T> in the #! line on your test files.  So
+if you begin a test with:
+
+    #!perl -T
+
+the test will be run with taint mode on.
+
+
+=head2 Configuration variables.
+
+These variables can be used to configure the behavior of
+Test::Harness.  They are exported on request.
+
+=over 4
+
+=item B<$Test::Harness::verbose>
+
+The global variable $Test::Harness::verbose is exportable and can be
+used to let runtests() display the standard output of the script
+without altering the behavior otherwise.
+
+=item B<$Test::Harness::switches>
+
+The global variable $Test::Harness::switches is exportable and can be
+used to set perl command line options used for running the test
+script(s). The default value is C<-w>.
+
+=back
+
+
+=head2 Failure
+
+It will happen, your tests will fail.  After you mop up your ego, you
+can begin examining the summary report:
+
+  t/base..............ok
+  t/nonumbers.........ok
+  t/ok................ok
+  t/test-harness......ok
+  t/waterloo..........dubious
+          Test returned status 3 (wstat 768, 0x300)
+  DIED. FAILED tests 1, 3, 5, 7, 9, 11, 13, 15, 17, 19
+          Failed 10/20 tests, 50.00% okay
+  Failed Test  Stat Wstat Total Fail  Failed  List of Failed
+  -----------------------------------------------------------------------
+  t/waterloo.t    3   768    20   10  50.00%  1 3 5 7 9 11 13 15 17 19
+  Failed 1/5 test scripts, 80.00% okay. 10/44 subtests failed, 77.27% okay.
+
+Everything passed but t/waterloo.t.  It failed 10 of 20 tests and
+exited with non-zero status indicating something dubious happened.
+
+The columns in the summary report mean:
+
+=over 4
+
+=item B<Failed Test>
+
+The test file which failed.
+
+=item B<Stat>
+
+If the test exited with non-zero, this is its exit status.
+
+=item B<Wstat>
+
+The wait status of the test I<umm, I need a better explanation here>.
+
+=item B<Total>
+
+Total number of tests expected to run.
+
+=item B<Fail>
+
+Number which failed, either from "not ok" or because they never ran.
+
+=item B<Failed>
+
+Percentage of the total tests which failed.
+
+=item B<List of Failed>
+
+A list of the tests which failed.  Successive failures may be
+abbreviated (ie. 15-20 to indicate that tests 15, 16, 17, 18, 19 and
+20 failed).
+
+=back
+
+
+=head2 Functions
+
+Test::Harness currently only has one function, here it is.
+
+=over 4
+
+=item B<runtests>
+
+  my $allok = runtests(@test_files);
+
+This runs all the given @test_files and divines whether they passed
+or failed based on their output to STDOUT (details above).  It prints
+out each individual test which failed along with a summary report and
+a how long it all took.
+
+It returns true if everything was ok.  Otherwise it will die() with
+one of the messages in the DIAGNOSTICS section.
+
+=for _private
+
+This is just _run_all_tests() plus _show_results()
+
+=cut
+
+sub runtests {
+    my(@tests) = @_;
+
+    local ($\, $,);
+
+    my($tot, $failedtests) = _run_all_tests(@tests);
+    _show_results($tot, $failedtests);
+
+    my $ok = _all_ok($tot);
+
+    assert(($ok xor keys %$failedtests), 
+           q{ok status jives with $failedtests});
+
+    return $ok;
+}
+
+=begin _private
+
+=item B<_all_ok>
+
+  my $ok = _all_ok(\%tot);
+
+Tells you if this test run is overall successful or not.
+
+=cut
+
+sub _all_ok {
+    my($tot) = shift;
+
+    return $tot->{bad} == 0 && ($tot->{max} || $tot->{skipped}) ? 1 : 0;
+}
+
+=item B<_globdir>
+
+  my @files = _globdir $dir;
+
+Returns all the files in a directory.  This is shorthand for backwards
+compatibility on systems where glob() doesn't work right.
+
+=cut
+
+sub _globdir { 
+    opendir DIRH, shift; 
+    my @f = readdir DIRH; 
+    closedir DIRH; 
+
+    return @f;
+}
+
+=item B<_run_all_tests>
+
+  my($total, $failed) = _run_all_tests(@test_files);
+
+Runs all the given @test_files (as runtests()) but does it quietly (no
+report).  $total is a hash ref summary of all the tests run.  Its keys
+and values are this:
+
+    bonus           Number of individual todo tests unexpectedly passed
+    max             Number of individual tests ran
+    ok              Number of individual tests passed
+    sub_skipped     Number of individual tests skipped
+    todo            Number of individual todo tests
+
+    files           Number of test files ran
+    good            Number of test files passed
+    bad             Number of test files failed
+    tests           Number of test files originally given
+    skipped         Number of test files skipped
+
+If $total->{bad} == 0 and $total->{max} > 0, you've got a successful
+test.
+
+$failed is a hash ref of all the test scripts which failed.  Each key
+is the name of a test script, each value is another hash representing
+how that script failed.  Its keys are these:
+
+    name        Name of the test which failed
+    estat       Script's exit value
+    wstat       Script's wait status
+    max         Number of individual tests
+    failed      Number which failed
+    percent     Percentage of tests which failed
+    canon       List of tests which failed (as string).
+
+Needless to say, $failed should be empty if everything passed.
+
+B<NOTE> Currently this function is still noisy.  I'm working on it.
+
+=cut
+
+#'#
+sub _run_all_tests {
+    my(@tests) = @_;
+    local($|) = 1;
+    my(%failedtests);
+
+    # Test-wide totals.
+    my(%tot) = (
+                bonus    => 0,
+                max      => 0,
+                ok       => 0,
+                files    => 0,
+                bad      => 0,
+                good     => 0,
+                tests    => scalar @tests,
+                sub_skipped  => 0,
+                todo     => 0,
+                skipped  => 0,
+                bench    => 0,
+               );
+
+    my @dir_files = _globdir $Files_In_Dir if defined $Files_In_Dir;
+    my $t_start = new Benchmark;
+
+    my $width = _leader_width(@tests);
+    foreach my $tfile (@tests) {
+        $Last_ML_Print = 0;  # so each test prints at least once
+        my($leader, $ml) = _mk_leader($tfile, $width);
+        local $ML = $ml;
+        print $leader;
+
+        $tot{files}++;
+
+        $Strap->{_seen_header} = 0;
+        my %results = $Strap->analyze_file($tfile) or
+          do { warn "$Strap->{error}\n";  next };
+
+        # state of the current test.
+        my @failed = grep { !$results{details}[$_-1]{ok} }
+                     1..@{$results{details}};
+        my %test = (
+                    ok          => $results{ok},
+                    'next'      => $Strap->{'next'},
+                    max         => $results{max},
+                    failed      => \@failed,
+                    bonus       => $results{bonus},
+                    skipped     => $results{skip},
+                    skip_reason => $results{skip_reason},
+                    skip_all    => $Strap->{skip_all},
+                    ml          => $ml,
+                   );
+
+        $tot{bonus}       += $results{bonus};
+        $tot{max}         += $results{max};
+        $tot{ok}          += $results{ok};
+        $tot{todo}        += $results{todo};
+        $tot{sub_skipped} += $results{skip};
+
+        my($estatus, $wstatus) = @results{qw(exit wait)};
+
+        if ($results{passing}) {
+            if ($test{max} and $test{skipped} + $test{bonus}) {
+                my @msg;
+                push(@msg, "$test{skipped}/$test{max} skipped: $test{skip_reason}")
+                    if $test{skipped};
+                push(@msg, "$test{bonus}/$test{max} unexpectedly succeeded")
+                    if $test{bonus};
+                print "$test{ml}ok\n        ".join(', ', @msg)."\n";
+            } elsif ($test{max}) {
+                print "$test{ml}ok\n";
+            } elsif (defined $test{skip_all} and length $test{skip_all}) {
+                print "skipped\n        all skipped: $test{skip_all}\n";
+                $tot{skipped}++;
+            } else {
+                print "skipped\n        all skipped: no reason given\n";
+                $tot{skipped}++;
+            }
+            $tot{good}++;
+        }
+        else {
+            # List unrun tests as failures.
+            if ($test{'next'} <= $test{max}) {
+                push @{$test{failed}}, $test{'next'}..$test{max};
+            }
+            # List overruns as failures.
+            else {
+                my $details = $results{details};
+                foreach my $overrun ($test{max}+1..@$details)
+                {
+                    next unless ref $details->[$overrun-1];
+                    push @{$test{failed}}, $overrun
+                }
+            }
+
+            if ($wstatus) {
+                $failedtests{$tfile} = _dubious_return(\%test, \%tot, 
+                                                       $estatus, $wstatus);
+                $failedtests{$tfile}{name} = $tfile;
+            }
+            elsif($results{seen}) {
+                if (@{$test{failed}} and $test{max}) {
+                    my ($txt, $canon) = canonfailed($test{max},$test{skipped},
+                                                    @{$test{failed}});
+                    print "$test{ml}$txt";
+                    $failedtests{$tfile} = { canon   => $canon,
+                                             max     => $test{max},
+                                             failed  => scalar @{$test{failed}},
+                                             name    => $tfile, 
+                                             percent => 100*(scalar @{$test{failed}})/$test{max},
+                                             estat   => '',
+                                             wstat   => '',
+                                           };
+                } else {
+                    print "Don't know which tests failed: got $test{ok} ok, ".
+                          "expected $test{max}\n";
+                    $failedtests{$tfile} = { canon   => '??',
+                                             max     => $test{max},
+                                             failed  => '??',
+                                             name    => $tfile, 
+                                             percent => undef,
+                                             estat   => '', 
+                                             wstat   => '',
+                                           };
+                }
+                $tot{bad}++;
+            } else {
+                print "FAILED before any test output arrived\n";
+                $tot{bad}++;
+                $failedtests{$tfile} = { canon       => '??',
+                                         max         => '??',
+                                         failed      => '??',
+                                         name        => $tfile,
+                                         percent     => undef,
+                                         estat       => '', 
+                                         wstat       => '',
+                                       };
+            }
+        }
+
+        if (defined $Files_In_Dir) {
+            my @new_dir_files = _globdir $Files_In_Dir;
+            if (@new_dir_files != @dir_files) {
+                my %f;
+                @f{@new_dir_files} = (1) x @new_dir_files;
+                delete @f{@dir_files};
+                my @f = sort keys %f;
+                print "LEAKED FILES: @f\n";
+                @dir_files = @new_dir_files;
+            }
+        }
+    }
+    $tot{bench} = timediff(new Benchmark, $t_start);
+
+    $Strap->_restore_PERL5LIB;
+
+    return(\%tot, \%failedtests);
+}
+
+=item B<_mk_leader>
+
+  my($leader, $ml) = _mk_leader($test_file, $width);
+
+Generates the 't/foo........' $leader for the given $test_file as well
+as a similar version which will overwrite the current line (by use of
+\r and such).  $ml may be empty if Test::Harness doesn't think you're
+on TTY.
+
+The $width is the width of the "yada/blah.." string.
+
+=cut
+
+sub _mk_leader {
+    my($te, $width) = @_;
+    chomp($te);
+    $te =~ s/\.\w+$/./;
+
+    if ($^O eq 'VMS') { $te =~ s/^.*\.t\./\[.t./s; }
+    my $blank = (' ' x 77);
+    my $leader = "$te" . '.' x ($width - length($te));
+    my $ml = "";
+
+    $ml = "\r$blank\r$leader"
+      if -t STDOUT and not $ENV{HARNESS_NOTTY} and not $Verbose;
+
+    return($leader, $ml);
+}
+
+=item B<_leader_width>
+
+  my($width) = _leader_width(@test_files);
+
+Calculates how wide the leader should be based on the length of the
+longest test name.
+
+=cut
+
+sub _leader_width {
+    my $maxlen = 0;
+    my $maxsuflen = 0;
+    foreach (@_) {
+        my $suf    = /\.(\w+)$/ ? $1 : '';
+        my $len    = length;
+        my $suflen = length $suf;
+        $maxlen    = $len    if $len    > $maxlen;
+        $maxsuflen = $suflen if $suflen > $maxsuflen;
+    }
+    # + 3 : we want three dots between the test name and the "ok"
+    return $maxlen + 3 - $maxsuflen;
+}
+
+
+sub _show_results {
+    my($tot, $failedtests) = @_;
+
+    my $pct;
+    my $bonusmsg = _bonusmsg($tot);
+
+    if (_all_ok($tot)) {
+        print "All tests successful$bonusmsg.\n";
+    } elsif (!$tot->{tests}){
+        die "FAILED--no tests were run for some reason.\n";
+    } elsif (!$tot->{max}) {
+        my $blurb = $tot->{tests}==1 ? "script" : "scripts";
+        die "FAILED--$tot->{tests} test $blurb could be run, ".
+            "alas--no output ever seen\n";
+    } else {
+        $pct = sprintf("%.2f", $tot->{good} / $tot->{tests} * 100);
+        my $percent_ok = 100*$tot->{ok}/$tot->{max};
+        my $subpct = sprintf " %d/%d subtests failed, %.2f%% okay.",
+                              $tot->{max} - $tot->{ok}, $tot->{max}, 
+                              $percent_ok;
+
+        my($fmt_top, $fmt) = _create_fmts($failedtests);
+
+        # Now write to formats
+        for my $script (sort keys %$failedtests) {
+          $Curtest = $failedtests->{$script};
+          write;
+        }
+        if ($tot->{bad}) {
+            $bonusmsg =~ s/^,\s*//;
+            print "$bonusmsg.\n" if $bonusmsg;
+            die "Failed $tot->{bad}/$tot->{tests} test scripts, $pct% okay.".
+                "$subpct\n";
+        }
+    }
+
+    printf("Files=%d, Tests=%d, %s\n",
+           $tot->{files}, $tot->{max}, timestr($tot->{bench}, 'nop'));
+}
+
+
+my %Handlers = ();
+$Strap->{callback} = sub {
+    my($self, $line, $type, $totals) = @_;
+    print $line if $Verbose;
+
+    my $meth = $Handlers{$type};
+    $meth->($self, $line, $type, $totals) if $meth;
+};
+
+
+$Handlers{header} = sub {
+    my($self, $line, $type, $totals) = @_;
+
+    warn "Test header seen more than once!\n" if $self->{_seen_header};
+
+    $self->{_seen_header}++;
+
+    warn "1..M can only appear at the beginning or end of tests\n"
+      if $totals->{seen} && 
+         $totals->{max}  < $totals->{seen};
+};
+
+$Handlers{test} = sub {
+    my($self, $line, $type, $totals) = @_;
+
+    my $curr = $totals->{seen};
+    my $next = $self->{'next'};
+    my $max  = $totals->{max};
+    my $detail = $totals->{details}[-1];
+
+    if( $detail->{ok} ) {
+        _print_ml_less("ok $curr/$max");
+
+        if( $detail->{type} eq 'skip' ) {
+            $totals->{skip_reason} = $detail->{reason}
+              unless defined $totals->{skip_reason};
+            $totals->{skip_reason} = 'various reasons'
+              if $totals->{skip_reason} ne $detail->{reason};
+        }
+    }
+    else {
+        _print_ml("NOK $curr");
+    }
+
+    if( $curr > $next ) {
+        print "Test output counter mismatch [test $curr]\n";
+    }
+    elsif( $curr < $next ) {
+        print "Confused test output: test $curr answered after ".
+              "test ", $next - 1, "\n";
+    }
+
+};
+
+$Handlers{bailout} = sub {
+    my($self, $line, $type, $totals) = @_;
+
+    die "FAILED--Further testing stopped" .
+      ($self->{bailout_reason} ? ": $self->{bailout_reason}\n" : ".\n");
+};
+
+
+sub _print_ml {
+    print join '', $ML, @_ if $ML;
+}
+
+
+# For slow connections, we save lots of bandwidth by printing only once
+# per second.
+sub _print_ml_less {
+    if( !$Ok_Slow || $Last_ML_Print != time ) {
+        _print_ml(@_);
+        $Last_ML_Print = time;
+    }
+}
+
+sub _bonusmsg {
+    my($tot) = @_;
+
+    my $bonusmsg = '';
+    $bonusmsg = (" ($tot->{bonus} subtest".($tot->{bonus} > 1 ? 's' : '').
+               " UNEXPECTEDLY SUCCEEDED)")
+        if $tot->{bonus};
+
+    if ($tot->{skipped}) {
+        $bonusmsg .= ", $tot->{skipped} test"
+                     . ($tot->{skipped} != 1 ? 's' : '');
+        if ($tot->{sub_skipped}) {
+            $bonusmsg .= " and $tot->{sub_skipped} subtest"
+                         . ($tot->{sub_skipped} != 1 ? 's' : '');
+        }
+        $bonusmsg .= ' skipped';
+    }
+    elsif ($tot->{sub_skipped}) {
+        $bonusmsg .= ", $tot->{sub_skipped} subtest"
+                     . ($tot->{sub_skipped} != 1 ? 's' : '')
+                     . " skipped";
+    }
+
+    return $bonusmsg;
+}
+
+# Test program go boom.
+sub _dubious_return {
+    my($test, $tot, $estatus, $wstatus) = @_;
+    my ($failed, $canon, $percent) = ('??', '??');
+
+    printf "$test->{ml}dubious\n\tTest returned status $estatus ".
+           "(wstat %d, 0x%x)\n",
+           $wstatus,$wstatus;
+    print "\t\t(VMS status is $estatus)\n" if $^O eq 'VMS';
+
+    if (corestatus($wstatus)) { # until we have a wait module
+        if ($Have_Devel_Corestack) {
+            Devel::CoreStack::stack($^X);
+        } else {
+            print "\ttest program seems to have generated a core\n";
+        }
+    }
+
+    $tot->{bad}++;
+
+    if ($test->{max}) {
+        if ($test->{'next'} == $test->{max} + 1 and not @{$test->{failed}}) {
+            print "\tafter all the subtests completed successfully\n";
+            $percent = 0;
+            $failed = 0;        # But we do not set $canon!
+        }
+        else {
+            push @{$test->{failed}}, $test->{'next'}..$test->{max};
+            $failed = @{$test->{failed}};
+            (my $txt, $canon) = canonfailed($test->{max},$test->{skipped},@{$test->{failed}});
+            $percent = 100*(scalar @{$test->{failed}})/$test->{max};
+            print "DIED. ",$txt;
+        }
+    }
+
+    return { canon => $canon,  max => $test->{max} || '??',
+             failed => $failed, 
+             percent => $percent,
+             estat => $estatus, wstat => $wstatus,
+           };
+}
+
+
+sub _create_fmts {
+    my($failedtests) = @_;
+
+    my $failed_str = "Failed Test";
+    my $middle_str = " Stat Wstat Total Fail  Failed  ";
+    my $list_str = "List of Failed";
+
+    # Figure out our longest name string for formatting purposes.
+    my $max_namelen = length($failed_str);
+    foreach my $script (keys %$failedtests) {
+        my $namelen = length $failedtests->{$script}->{name};
+        $max_namelen = $namelen if $namelen > $max_namelen;
+    }
+
+    my $list_len = $Columns - length($middle_str) - $max_namelen;
+    if ($list_len < length($list_str)) {
+        $list_len = length($list_str);
+        $max_namelen = $Columns - length($middle_str) - $list_len;
+        if ($max_namelen < length($failed_str)) {
+            $max_namelen = length($failed_str);
+            $Columns = $max_namelen + length($middle_str) + $list_len;
+        }
+    }
+
+    my $fmt_top = "format STDOUT_TOP =\n"
+                  . sprintf("%-${max_namelen}s", $failed_str)
+                  . $middle_str
+                  . $list_str . "\n"
+                  . "-" x $Columns
+                  . "\n.\n";
+
+    my $fmt = "format STDOUT =\n"
+              . "@" . "<" x ($max_namelen - 1)
+              . "  @>> @>>>> @>>>> @>>> ^##.##%  "
+              . "^" . "<" x ($list_len - 1) . "\n"
+              . '{ $Curtest->{name}, $Curtest->{estat},'
+              . '  $Curtest->{wstat}, $Curtest->{max},'
+              . '  $Curtest->{failed}, $Curtest->{percent},'
+              . '  $Curtest->{canon}'
+              . "\n}\n"
+              . "~~" . " " x ($Columns - $list_len - 2) . "^"
+              . "<" x ($list_len - 1) . "\n"
+              . '$Curtest->{canon}'
+              . "\n.\n";
+
+    eval $fmt_top;
+    die $@ if $@;
+    eval $fmt;
+    die $@ if $@;
+
+    return($fmt_top, $fmt);
+}
+
+{
+    my $tried_devel_corestack;
+
+    sub corestatus {
+        my($st) = @_;
+
+        my $did_core;
+        eval { # we may not have a WCOREDUMP
+            local $^W = 0;  # *.ph files are often *very* noisy
+            require 'wait.ph';
+            $did_core = WCOREDUMP($st);
+        };
+        if( $@ ) {
+            $did_core = $st & 0200;
+        }
+
+        eval { require Devel::CoreStack; $Have_Devel_Corestack++ } 
+          unless $tried_devel_corestack++;
+
+        return $did_core;
+    }
+}
+
+sub canonfailed ($$@) {
+    my($max,$skipped,@failed) = @_;
+    my %seen;
+    @failed = sort {$a <=> $b} grep !$seen{$_}++, @failed;
+    my $failed = @failed;
+    my @result = ();
+    my @canon = ();
+    my $min;
+    my $last = $min = shift @failed;
+    my $canon;
+    if (@failed) {
+        for (@failed, $failed[-1]) { # don't forget the last one
+            if ($_ > $last+1 || $_ == $last) {
+                if ($min == $last) {
+                    push @canon, $last;
+                } else {
+                    push @canon, "$min-$last";
+                }
+                $min = $_;
+            }
+            $last = $_;
+        }
+        local $" = ", ";
+        push @result, "FAILED tests @canon\n";
+        $canon = join ' ', @canon;
+    } else {
+        push @result, "FAILED test $last\n";
+        $canon = $last;
+    }
+
+    push @result, "\tFailed $failed/$max tests, ";
+    if ($max) {
+	push @result, sprintf("%.2f",100*(1-$failed/$max)), "% okay";
+    } else {
+	push @result, "?% okay";
+    }
+    my $ender = 's' x ($skipped > 1);
+    my $good = $max - $failed - $skipped;
+    if ($skipped) {
+	my $skipmsg = " (less $skipped skipped test$ender: $good okay, ";
+	if ($max) {
+	    my $goodper = sprintf("%.2f",100*($good/$max));
+	    $skipmsg .= "$goodper%)";
+	} else {
+	    $skipmsg .= "?%)";
+	}
+	push @result, $skipmsg;
+    }
+    push @result, "\n";
+    my $txt = join "", @result;
+    ($txt, $canon);
+}
+
+=end _private
+
+=back
+
+=cut
+
+
+1;
+__END__
+
+
+=head1 EXPORT
+
+C<&runtests> is exported by Test::Harness by default.
+
+C<$verbose> and C<$switches> are exported upon request.
+
+
+=head1 DIAGNOSTICS
+
+=over 4
+
+=item C<All tests successful.\nFiles=%d,  Tests=%d, %s>
+
+If all tests are successful some statistics about the performance are
+printed.
+
+=item C<FAILED tests %s\n\tFailed %d/%d tests, %.2f%% okay.>
+
+For any single script that has failing subtests statistics like the
+above are printed.
+
+=item C<Test returned status %d (wstat %d)>
+
+Scripts that return a non-zero exit status, both C<$? E<gt>E<gt> 8>
+and C<$?> are printed in a message similar to the above.
+
+=item C<Failed 1 test, %.2f%% okay. %s>
+
+=item C<Failed %d/%d tests, %.2f%% okay. %s>
+
+If not all tests were successful, the script dies with one of the
+above messages.
+
+=item C<FAILED--Further testing stopped: %s>
+
+If a single subtest decides that further testing will not make sense,
+the script dies with this message.
+
+=back
+
+=head1 ENVIRONMENT
+
+=over 4
+
+=item C<HARNESS_ACTIVE>
+
+Harness sets this before executing the individual tests.  This allows
+the tests to determine if they are being executed through the harness
+or by any other means.
+
+=item C<HARNESS_COLUMNS>
+
+This value will be used for the width of the terminal. If it is not
+set then it will default to C<COLUMNS>. If this is not set, it will
+default to 80. Note that users of Bourne-sh based shells will need to
+C<export COLUMNS> for this module to use that variable.
+
+=item C<HARNESS_COMPILE_TEST>
+
+When true it will make harness attempt to compile the test using
+C<perlcc> before running it.
+
+B<NOTE> This currently only works when sitting in the perl source
+directory!
+
+=item C<HARNESS_FILELEAK_IN_DIR>
+
+When set to the name of a directory, harness will check after each
+test whether new files appeared in that directory, and report them as
+
+  LEAKED FILES: scr.tmp 0 my.db
+
+If relative, directory name is with respect to the current directory at
+the moment runtests() was called.  Putting absolute path into 
+C<HARNESS_FILELEAK_IN_DIR> may give more predictable results.
+
+=item C<HARNESS_IGNORE_EXITCODE>
+
+Makes harness ignore the exit status of child processes when defined.
+
+=item C<HARNESS_NOTTY>
+
+When set to a true value, forces it to behave as though STDOUT were
+not a console.  You may need to set this if you don't want harness to
+output more frequent progress messages using carriage returns.  Some
+consoles may not handle carriage returns properly (which results in a
+somewhat messy output).
+
+=item C<HARNESS_OK_SLOW>
+
+If true, the C<ok> messages are printed out only every second.
+This reduces output and therefore may for example help testing
+over slow connections.
+
+=item C<HARNESS_PERL_SWITCHES>
+
+Its value will be prepended to the switches used to invoke perl on
+each test.  For example, setting C<HARNESS_PERL_SWITCHES> to C<-W> will
+run all tests with all warnings enabled.
+
+=item C<HARNESS_VERBOSE>
+
+If true, Test::Harness will output the verbose results of running
+its tests.  Setting $Test::Harness::verbose will override this.
+
+=back
+
+=head1 EXAMPLE
+
+Here's how Test::Harness tests itself
+
+  $ cd ~/src/devel/Test-Harness
+  $ perl -Mblib -e 'use Test::Harness qw(&runtests $verbose);
+    $verbose=0; runtests @ARGV;' t/*.t
+  Using /home/schwern/src/devel/Test-Harness/blib
+  t/base..............ok
+  t/nonumbers.........ok
+  t/ok................ok
+  t/test-harness......ok
+  All tests successful.
+  Files=4, Tests=24, 2 wallclock secs ( 0.61 cusr + 0.41 csys = 1.02 CPU)
+
+=head1 SEE ALSO
+
+L<Test> and L<Test::Simple> for writing test scripts, L<Benchmark> for
+the underlying timing routines, L<Devel::CoreStack> to generate core
+dumps from failed tests and L<Devel::Cover> for test coverage
+analysis.
+
+=head1 AUTHORS
+
+Either Tim Bunce or Andreas Koenig, we don't know. What we know for
+sure is, that it was inspired by Larry Wall's TEST script that came
+with perl distributions for ages. Numerous anonymous contributors
+exist.  Andreas Koenig held the torch for many years, and then
+Michael G Schwern.
+
+Current maintainer is Andy Lester C<< <andy@petdance.com> >>.
+
+=head1 LICENSE
+
+This program is free software; you can redistribute it and/or 
+modify it under the same terms as Perl itself.
+
+See L<http://www.perl.com/perl/misc/Artistic.html>
+
+=head1 TODO
+
+Provide a way of running tests quietly (ie. no printing) for automated
+validation of tests.  This will probably take the form of a version
+of runtests() which rather than printing its output returns raw data
+on the state of the tests.  (Partially done in Test::Harness::Straps)
+
+Document the format.
+
+Fix HARNESS_COMPILE_TEST without breaking its core usage.
+
+Figure a way to report test names in the failure summary.
+
+Rework the test summary so long test names are not truncated as badly.
+(Partially done with new skip test styles)
+
+Deal with VMS's "not \nok 4\n" mistake.
+
+Add option for coverage analysis.
+
+Trap STDERR.
+
+Implement Straps total_results()
+
+Remember exit code
+
+Completely redo the print summary code.
+
+Implement Straps callbacks.  (experimentally implemented)
+
+Straps->analyze_file() not taint clean, don't know if it can be
+
+Fix that damned VMS nit.
+
+HARNESS_TODOFAIL to display TODO failures
+
+Add a test for verbose.
+
+Change internal list of test results to a hash.
+
+Fix stats display when there's an overrun.
+
+Fix so perls with spaces in the filename work.
+
+=for _private
+
+Keeping whittling away at _run_all_tests()
+
+=for _private
+
+Clean up how the summary is printed.  Get rid of those damned formats.
+
+=head1 BUGS
+
+HARNESS_COMPILE_TEST currently assumes it's run from the Perl source
+directory.
+
+=cut
diff --git a/Perl/t/Test/Harness/Assert.pm b/Perl/t/Test/Harness/Assert.pm
new file mode 100644
index 0000000..3ee23e3
--- /dev/null
+++ b/Perl/t/Test/Harness/Assert.pm
@@ -0,0 +1,68 @@
+# $Id$
+
+package Test::Harness::Assert;
+
+use strict;
+require Exporter;
+use vars qw($VERSION @EXPORT @ISA);
+
+$VERSION = '0.01';
+
+@ISA = qw(Exporter);
+@EXPORT = qw(assert);
+
+
+=head1 NAME
+
+Test::Harness::Assert - simple assert
+
+=head1 SYNOPSIS
+
+  ### FOR INTERNAL USE ONLY ###
+
+  use Test::Harness::Assert;
+
+  assert( EXPR, $name );
+
+=head1 DESCRIPTION
+
+A simple assert routine since we don't have Carp::Assert handy.
+
+B<For internal use by Test::Harness ONLY!>
+
+=head2 Functions
+
+=over 4
+
+=item B<assert>
+
+  assert( EXPR, $name );
+
+If the expression is false the program aborts.
+
+=cut
+
+sub assert ($;$) {
+    my($assert, $name) = @_;
+
+    unless( $assert ) {
+        require Carp;
+        my $msg = 'Assert failed';
+        $msg .= " - '$name'" if defined $name;
+        $msg .= '!';
+        Carp::croak($msg);
+    }
+
+}
+
+=head1 AUTHOR
+
+Michael G Schwern E<lt>schwern@pobox.comE<gt>
+
+=head1 SEE ALSO
+
+L<Carp::Assert>
+
+=cut
+
+1;
diff --git a/Perl/t/Test/Harness/Iterator.pm b/Perl/t/Test/Harness/Iterator.pm
new file mode 100644
index 0000000..5e22793
--- /dev/null
+++ b/Perl/t/Test/Harness/Iterator.pm
@@ -0,0 +1,61 @@
+package Test::Harness::Iterator;
+
+use strict;
+use vars qw($VERSION);
+$VERSION = 0.01;
+
+
+=head1 NAME
+
+Test::Harness::Iterator - Internal Test::Harness Iterator
+
+=head1 SYNOPSIS
+
+  use Test::Harness::Iterator;
+  use Test::Harness::Iterator;
+  my $it = Test::Harness::Iterator->new(\*TEST);
+  my $it = Test::Harness::Iterator->new(\@array);
+
+  my $line = $it->next;
+
+
+=head1 DESCRIPTION
+
+B<FOR INTERNAL USE ONLY!>
+
+This is a simple iterator wrapper for arrays and filehandles.
+
+=cut
+
+sub new {
+    my($proto, $thing) = @_;
+
+    my $self = {};
+    if( ref $thing eq 'GLOB' ) {
+        bless $self, 'Test::Harness::Iterator::FH';
+        $self->{fh} = $thing;
+    }
+    elsif( ref $thing eq 'ARRAY' ) {
+        bless $self, 'Test::Harness::Iterator::ARRAY';
+        $self->{idx}   = 0;
+        $self->{array} = $thing;
+    }
+    else {
+        warn "Can't iterate with a ", ref $thing;
+    }
+
+    return $self;
+}
+
+package Test::Harness::Iterator::FH;
+sub next {
+    my $fh = $_[0]->{fh};
+    return scalar <$fh>;
+}
+
+
+package Test::Harness::Iterator::ARRAY;
+sub next {
+    my $self = shift;
+    return $self->{array}->[$self->{idx}++];
+}
diff --git a/Perl/t/Test/Harness/Straps.pm b/Perl/t/Test/Harness/Straps.pm
new file mode 100644
index 0000000..4d971b7
--- /dev/null
+++ b/Perl/t/Test/Harness/Straps.pm
@@ -0,0 +1,667 @@
+# -*- Mode: cperl; cperl-indent-level: 4 -*-
+# $Id$
+
+package Test::Harness::Straps;
+
+use strict;
+use vars qw($VERSION);
+use Config;
+$VERSION = '0.15';
+
+use Test::Harness::Assert;
+use Test::Harness::Iterator;
+
+# Flags used as return values from our methods.  Just for internal 
+# clarification.
+my $TRUE  = (1==1);
+my $FALSE = !$TRUE;
+my $YES   = $TRUE;
+my $NO    = $FALSE;
+
+
+=head1 NAME
+
+Test::Harness::Straps - detailed analysis of test results
+
+=head1 SYNOPSIS
+
+  use Test::Harness::Straps;
+
+  my $strap = Test::Harness::Straps->new;
+
+  # Various ways to interpret a test
+  my %results = $strap->analyze($name, \@test_output);
+  my %results = $strap->analyze_fh($name, $test_filehandle);
+  my %results = $strap->analyze_file($test_file);
+
+  # UNIMPLEMENTED
+  my %total = $strap->total_results;
+
+  # Altering the behavior of the strap  UNIMPLEMENTED
+  my $verbose_output = $strap->dump_verbose();
+  $strap->dump_verbose_fh($output_filehandle);
+
+
+=head1 DESCRIPTION
+
+B<THIS IS ALPHA SOFTWARE> in that the interface is subject to change
+in incompatible ways.  It is otherwise stable.
+
+Test::Harness is limited to printing out its results.  This makes
+analysis of the test results difficult for anything but a human.  To
+make it easier for programs to work with test results, we provide
+Test::Harness::Straps.  Instead of printing the results, straps
+provide them as raw data.  You can also configure how the tests are to
+be run.
+
+The interface is currently incomplete.  I<Please> contact the author
+if you'd like a feature added or something change or just have
+comments.
+
+=head1 Construction
+
+=head2 C<new>
+
+  my $strap = Test::Harness::Straps->new;
+
+Initialize a new strap.
+
+=cut
+
+sub new {
+    my($proto) = shift;
+    my($class) = ref $proto || $proto;
+
+    my $self = bless {}, $class;
+    $self->_init;
+
+    return $self;
+}
+
+=head2 C<_init>
+
+  $strap->_init;
+
+Initialize the internal state of a strap to make it ready for parsing.
+
+=cut
+
+sub _init {
+    my($self) = shift;
+
+    $self->{_is_vms}   = $^O eq 'VMS';
+    $self->{_is_win32} = $^O eq 'Win32';
+}
+
+=head1 Analysis
+
+=head2 C<analyze>
+
+  my %results = $strap->analyze($name, \@test_output);
+
+Analyzes the output of a single test, assigning it the given C<$name>
+for use in the total report.  Returns the C<%results> of the test.
+See L<Results>.
+
+C<@test_output> should be the raw output from the test, including
+newlines.
+
+=cut
+
+sub analyze {
+    my($self, $name, $test_output) = @_;
+
+    my $it = Test::Harness::Iterator->new($test_output);
+    return $self->_analyze_iterator($name, $it);
+}
+
+
+sub _analyze_iterator {
+    my($self, $name, $it) = @_;
+
+    $self->_reset_file_state;
+    $self->{file} = $name;
+    my %totals  = (
+                   max      => 0,
+                   seen     => 0,
+
+                   ok       => 0,
+                   todo     => 0,
+                   skip     => 0,
+                   bonus    => 0,
+
+                   details  => []
+                  );
+
+    # Set them up here so callbacks can have them.
+    $self->{totals}{$name}         = \%totals;
+    while( defined(my $line = $it->next) ) {
+        $self->_analyze_line($line, \%totals);
+        last if $self->{saw_bailout};
+    }
+
+    $totals{skip_all} = $self->{skip_all} if defined $self->{skip_all};
+
+    my $passed = ($totals{max} == 0 && defined $totals{skip_all}) ||
+                 ($totals{max} && $totals{seen} &&
+                  $totals{max} == $totals{seen} && 
+                  $totals{max} == $totals{ok});
+    $totals{passing} = $passed ? 1 : 0;
+
+    return %totals;
+}
+
+
+sub _analyze_line {
+    my($self, $line, $totals) = @_;
+
+    my %result = ();
+
+    $self->{line}++;
+
+    my $type;
+    if( $self->_is_header($line) ) {
+        $type = 'header';
+
+        $self->{saw_header}++;
+
+        $totals->{max} += $self->{max};
+    }
+    elsif( $self->_is_test($line, \%result) ) {
+        $type = 'test';
+
+        $totals->{seen}++;
+        $result{number} = $self->{'next'} unless $result{number};
+
+        # sometimes the 'not ' and the 'ok' are on different lines,
+        # happens often on VMS if you do:
+        #   print "not " unless $test;
+        #   print "ok $num\n";
+        if( $self->{saw_lone_not} && 
+            ($self->{lone_not_line} == $self->{line} - 1) ) 
+        {
+            $result{ok} = 0;
+        }
+
+        my $pass = $result{ok};
+        $result{type} = 'todo' if $self->{todo}{$result{number}};
+
+        if( $result{type} eq 'todo' ) {
+            $totals->{todo}++;
+            $pass = 1;
+            $totals->{bonus}++ if $result{ok}
+        }
+        elsif( $result{type} eq 'skip' ) {
+            $totals->{skip}++;
+            $pass = 1;
+        }
+
+        $totals->{ok}++ if $pass;
+
+        if( $result{number} > 100000 && $result{number} > $self->{max} ) {
+            warn "Enormous test number seen [test $result{number}]\n";
+            warn "Can't detailize, too big.\n";
+        }
+        else {
+            $totals->{details}[$result{number} - 1] = 
+                               {$self->_detailize($pass, \%result)};
+        }
+
+        # XXX handle counter mismatch
+    }
+    elsif ( $self->_is_bail_out($line, \$self->{bailout_reason}) ) {
+        $type = 'bailout';
+        $self->{saw_bailout} = 1;
+    }
+    else {
+        $type = 'other';
+    }
+
+    $self->{callback}->($self, $line, $type, $totals) if $self->{callback};
+
+    $self->{'next'} = $result{number} + 1 if $type eq 'test';
+}
+
+=head2 C<analyze_fh>
+
+  my %results = $strap->analyze_fh($name, $test_filehandle);
+
+Like C<analyze>, but it reads from the given filehandle.
+
+=cut
+
+sub analyze_fh {
+    my($self, $name, $fh) = @_;
+
+    my $it = Test::Harness::Iterator->new($fh);
+    $self->_analyze_iterator($name, $it);
+}
+
+=head2 C<analyze_file>
+
+  my %results = $strap->analyze_file($test_file);
+
+Like C<analyze>, but it runs the given C<$test_file> and parses its
+results.  It will also use that name for the total report.
+
+=cut
+
+sub analyze_file {
+    my($self, $file) = @_;
+
+    unless( -e $file ) {
+        $self->{error} = "$file does not exist";
+        return;
+    }
+
+    unless( -r $file ) {
+        $self->{error} = "$file is not readable";
+        return;
+    }
+
+    local $ENV{PERL5LIB} = $self->_INC2PERL5LIB;
+
+    my $cmd = $self->{_is_vms}   ? "MCR $^X" :
+              $self->{_is_win32} ? Win32::GetShortPathName($^X)
+                                 : $^X;
+
+    my $switches = $self->_switches($file);
+
+    # *sigh* this breaks under taint, but open -| is unportable.
+    unless( open(FILE, "$cmd $switches $file|") ) {
+        print "can't run $file. $!\n";
+        return;
+    }
+
+    my %results = $self->analyze_fh($file, \*FILE);
+    my $exit = close FILE;
+    $results{'wait'} = $?;
+    if( $? && $self->{_is_vms} ) {
+        eval q{use vmsish "status"; $results{'exit'} = $?};
+    }
+    else {
+        $results{'exit'} = _wait2exit($?);
+    }
+    $results{passing} = 0 unless $? == 0;
+
+    $self->_restore_PERL5LIB();
+
+    return %results;
+}
+
+
+eval { require POSIX; &POSIX::WEXITSTATUS(0) };
+if( $@ ) {
+    *_wait2exit = sub { $_[0] >> 8 };
+}
+else {
+    *_wait2exit = sub { POSIX::WEXITSTATUS($_[0]) }
+}
+
+
+=head2 C<_switches>
+
+  my $switches = $self->_switches($file);
+
+Formats and returns the switches necessary to run the test.
+
+=cut
+
+sub _switches {
+    my($self, $file) = @_;
+
+    local *TEST;
+    open(TEST, $file) or print "can't open $file. $!\n";
+    my $first = <TEST>;
+    my $s = $Test::Harness::Switches || '';
+    $s .= " $ENV{'HARNESS_PERL_SWITCHES'}"
+      if exists $ENV{'HARNESS_PERL_SWITCHES'};
+
+    if ($first =~ /^#!.*\bperl.*\s-\w*([Tt]+)/) {
+        # When taint mode is on, PERL5LIB is ignored.  So we need to put
+        # all that on the command line as -Is.
+        $s .= join " ", qq[ "-$1"], map {qq["-I$_"]} $self->_filtered_INC;
+    }
+    elsif ($^O eq 'MacOS') {
+        # MacPerl's putenv is broken, so it will not see PERL5LIB.
+        $s .= join " ", map {qq["-I$_"]} $self->_filtered_INC;
+    }
+
+    close(TEST) or print "can't close $file. $!\n";
+
+    return $s;
+}
+
+
+=head2 C<_INC2PERL5LIB>
+
+  local $ENV{PERL5LIB} = $self->_INC2PERL5LIB;
+
+Takes the current value of C<@INC> and turns it into something suitable
+for putting onto C<PERL5LIB>.
+
+=cut
+
+sub _INC2PERL5LIB {
+    my($self) = shift;
+
+    $self->{_old5lib} = $ENV{PERL5LIB};
+
+    return join $Config{path_sep}, $self->_filtered_INC;
+}
+
+=head2 C<_filtered_INC>
+
+  my @filtered_inc = $self->_filtered_INC;
+
+Shortens C<@INC> by removing redundant and unnecessary entries.
+Necessary for OSes with limited command line lengths, like VMS.
+
+=cut
+
+sub _filtered_INC {
+    my($self, @inc) = @_;
+    @inc = @INC unless @inc;
+
+    # VMS has a 255-byte limit on the length of %ENV entries, so
+    # toss the ones that involve perl_root, the install location
+    # for VMS
+    if( $self->{_is_vms} ) {
+        @inc = grep !/perl_root/i, @inc;
+    }
+
+    return @inc;
+}
+
+
+=head2 C<_restore_PERL5LIB>
+
+  $self->_restore_PERL5LIB;
+
+This restores the original value of the C<PERL5LIB> environment variable.
+Necessary on VMS, otherwise a no-op.
+
+=cut
+
+sub _restore_PERL5LIB {
+    my($self) = shift;
+
+    return unless $self->{_is_vms};
+
+    if (defined $self->{_old5lib}) {
+        $ENV{PERL5LIB} = $self->{_old5lib};
+    }
+}
+
+=head1 Parsing
+
+Methods for identifying what sort of line you're looking at.
+
+=head2 C<_is_comment>
+
+  my $is_comment = $strap->_is_comment($line, \$comment);
+
+Checks if the given line is a comment.  If so, it will place it into
+C<$comment> (sans #).
+
+=cut
+
+sub _is_comment {
+    my($self, $line, $comment) = @_;
+
+    if( $line =~ /^\s*\#(.*)/ ) {
+        $$comment = $1;
+        return $YES;
+    }
+    else {
+        return $NO;
+    }
+}
+
+=head2 C<_is_header>
+
+  my $is_header = $strap->_is_header($line);
+
+Checks if the given line is a header (1..M) line.  If so, it places how
+many tests there will be in C<< $strap->{max} >>, a list of which tests
+are todo in C<< $strap->{todo} >> and if the whole test was skipped
+C<< $strap->{skip_all} >> contains the reason.
+
+=cut
+
+# Regex for parsing a header.  Will be run with /x
+my $Extra_Header_Re = <<'REGEX';
+                       ^
+                        (?: \s+ todo \s+ ([\d \t]+) )?      # optional todo set
+                        (?: \s* \# \s* ([\w:]+\s?) (.*) )?     # optional skip with optional reason
+REGEX
+
+sub _is_header {
+    my($self, $line) = @_;
+
+    if( my($max, $extra) = $line =~ /^1\.\.(\d+)(.*)/ ) {
+        $self->{max}  = $max;
+        assert( $self->{max} >= 0,  'Max # of tests looks right' );
+
+        if( defined $extra ) {
+            my($todo, $skip, $reason) = $extra =~ /$Extra_Header_Re/xo;
+
+            $self->{todo} = { map { $_ => 1 } split /\s+/, $todo } if $todo;
+
+            if( $self->{max} == 0 ) {
+                $reason = '' unless defined $skip and $skip =~ /^Skip/i;
+            }
+
+            $self->{skip_all} = $reason;
+        }
+
+        return $YES;
+    }
+    else {
+        return $NO;
+    }
+}
+
+=head2 C<_is_test>
+
+  my $is_test = $strap->_is_test($line, \%test);
+
+Checks if the $line is a test report (ie. 'ok/not ok').  Reports the
+result back in C<%test> which will contain:
+
+  ok            did it succeed?  This is the literal 'ok' or 'not ok'.
+  name          name of the test (if any)
+  number        test number (if any)
+
+  type          'todo' or 'skip' (if any)
+  reason        why is it todo or skip? (if any)
+
+If will also catch lone 'not' lines, note it saw them 
+C<< $strap->{saw_lone_not} >> and the line in C<< $strap->{lone_not_line} >>.
+
+=cut
+
+my $Report_Re = <<'REGEX';
+                 ^
+                  (not\ )?               # failure?
+                  ok\b
+                  (?:\s+(\d+))?         # optional test number
+                  \s*
+                  (.*)                  # and the rest
+REGEX
+
+my $Extra_Re = <<'REGEX';
+                 ^
+                  (.*?) (?:(?:[^\\]|^)# (.*))?
+                 $
+REGEX
+
+sub _is_test {
+    my($self, $line, $test) = @_;
+
+    # We pulverize the line down into pieces in three parts.
+    if( my($not, $num, $extra)    = $line  =~ /$Report_Re/ox ) {
+        my($name, $control) = split /(?:[^\\]|^)#/, $extra if $extra;
+        my($type, $reason)  = $control =~ /^\s*(\S+)(?:\s+(.*))?$/ if $control;
+
+        $test->{number} = $num;
+        $test->{ok}     = $not ? 0 : 1;
+        $test->{name}   = $name;
+
+        if( defined $type ) {
+            $test->{type}   = $type =~ /^TODO$/i ? 'todo' :
+                              $type =~ /^Skip/i  ? 'skip' : 0;
+        }
+        else {
+            $test->{type} = '';
+        }
+        $test->{reason} = $reason;
+
+        return $YES;
+    }
+    else{
+        # Sometimes the "not " and "ok" will be on seperate lines on VMS.
+        # We catch this and remember we saw it.
+        if( $line =~ /^not\s+$/ ) {
+            $self->{saw_lone_not} = 1;
+            $self->{lone_not_line} = $self->{line};
+        }
+
+        return $NO;
+    }
+}
+
+=head2 C<_is_bail_out>
+
+  my $is_bail_out = $strap->_is_bail_out($line, \$reason);
+
+Checks if the line is a "Bail out!".  Places the reason for bailing
+(if any) in $reason.
+
+=cut
+
+sub _is_bail_out {
+    my($self, $line, $reason) = @_;
+
+    if( $line =~ /^Bail out!\s*(.*)/i ) {
+        $$reason = $1 if $1;
+        return $YES;
+    }
+    else {
+        return $NO;
+    }
+}
+
+=head2 C<_reset_file_state>
+
+  $strap->_reset_file_state;
+
+Resets things like C<< $strap->{max} >> , C<< $strap->{skip_all} >>,
+etc. so it's ready to parse the next file.
+
+=cut
+
+sub _reset_file_state {
+    my($self) = shift;
+
+    delete @{$self}{qw(max skip_all todo)};
+    $self->{line}       = 0;
+    $self->{saw_header} = 0;
+    $self->{saw_bailout}= 0;
+    $self->{saw_lone_not} = 0;
+    $self->{lone_not_line} = 0;
+    $self->{bailout_reason} = '';
+    $self->{'next'}       = 1;
+}
+
+=head1 Results
+
+The C<%results> returned from C<analyze()> contain the following
+information:
+
+  passing           true if the whole test is considered a pass 
+                    (or skipped), false if its a failure
+
+  exit              the exit code of the test run, if from a file
+  wait              the wait code of the test run, if from a file
+
+  max               total tests which should have been run
+  seen              total tests actually seen
+  skip_all          if the whole test was skipped, this will 
+                      contain the reason.
+
+  ok                number of tests which passed 
+                      (including todo and skips)
+
+  todo              number of todo tests seen
+  bonus             number of todo tests which 
+                      unexpectedly passed
+
+  skip              number of tests skipped
+
+So a successful test should have max == seen == ok.
+
+
+There is one final item, the details.
+
+  details           an array ref reporting the result of 
+                    each test looks like this:
+
+    $results{details}[$test_num - 1] = 
+            { ok        => is the test considered ok?
+              actual_ok => did it literally say 'ok'?
+              name      => name of the test (if any)
+              type      => 'skip' or 'todo' (if any)
+              reason    => reason for the above (if any)
+            };
+
+Element 0 of the details is test #1.  I tried it with element 1 being
+#1 and 0 being empty, this is less awkward.
+
+=head2 C<_detailize>
+
+  my %details = $strap->_detailize($pass, \%test);
+
+Generates the details based on the last test line seen.  C<$pass> is
+true if it was considered to be a passed test.  C<%test> is the results
+of the test you're summarizing.
+
+=cut
+
+sub _detailize {
+    my($self, $pass, $test) = @_;
+
+    my %details = ( ok         => $pass,
+                    actual_ok  => $test->{ok}
+                  );
+
+    assert( !(grep !defined $details{$_}, keys %details),
+            'test contains the ok and actual_ok info' );
+
+    # We don't want these to be undef because they are often
+    # checked and don't want the checker to have to deal with
+    # uninitialized vars.
+    foreach my $piece (qw(name type reason)) {
+        $details{$piece} = defined $test->{$piece} ? $test->{$piece} : '';
+    }
+
+    return %details;
+}
+
+=head1 EXAMPLES
+
+See F<examples/mini_harness.plx> for an example of use.
+
+=head1 AUTHOR
+
+Michael G Schwern C<< <schwern@pobox.com> >>, currently maintained by
+Andy Lester C<< <andy@petdance.com> >>.
+
+=head1 SEE ALSO
+
+L<Test::Harness>
+
+=cut
+
+
+1;
diff --git a/Perl/t/Test/More.pm b/Perl/t/Test/More.pm
new file mode 100644
index 0000000..03f7552
--- /dev/null
+++ b/Perl/t/Test/More.pm
@@ -0,0 +1,1248 @@
+package Test::More;
+
+use 5.004;
+
+use strict;
+use Test::Builder;
+
+
+# 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.47';
+@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, @_);
+}
+
+
+=head1 NAME
+
+Test::More - yet another framework for writing test scripts
+
+=head1 SYNOPSIS
+
+  use Test::More tests => $Num_Tests;
+  # or
+  use Test::More qw(no_plan);
+  # or
+  use Test::More skip_all => $reason;
+
+  BEGIN { use_ok( 'Some::Module' ); }
+  require_ok( 'Some::Module' );
+
+  # Various ways to say "ok"
+  ok($this eq $that, $test_name);
+
+  is  ($this, $that,    $test_name);
+  isnt($this, $that,    $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);
+
+  cmp_ok($this, '==', $that, $test_name);
+
+  is_deeply($complex_structure1, $complex_structure2, $test_name);
+
+  SKIP: {
+      skip $why, $how_many unless $have_some_feature;
+
+      ok( foo(),       $test_name );
+      is( foo(42), 23, $test_name );
+  };
+
+  TODO: {
+      local $TODO = $why;
+
+      ok( foo(),       $test_name );
+      is( foo(42), 23, $test_name );
+  };
+
+  can_ok($module, @methods);
+  isa_ok($object, $class);
+
+  pass($test_name);
+  fail($test_name);
+
+  # Utility comparison functions.
+  eq_array(\@this, \@that);
+  eq_hash(\%this, \%that);
+  eq_set(\@this, \@that);
+
+  # UNIMPLEMENTED!!!
+  my @status = Test::More::status;
+
+  # UNIMPLEMENTED!!!
+  BAIL_OUT($why);
+
+
+=head1 DESCRIPTION
+
+B<STOP!> If you're just getting started writing tests, have a look at
+Test::Simple first.  This is a drop in replacement for Test::Simple
+which you can switch to once you get the hang of basic testing.
+
+The purpose of this module is to provide a wide range of testing
+utilities.  Various ways to say "ok" with better diagnostics,
+facilities to skip tests, test future features and compare complicated
+data structures.  While you can do almost anything with a simple
+C<ok()> function, it doesn't provide good diagnostic output.
+
+
+=head2 I love it when a plan comes together
+
+Before anything else, you need a testing plan.  This basically declares
+how many tests your script is going to run to protect against premature
+failure.
+
+The preferred way to do this is to declare a plan when you C<use Test::More>.
+
+  use Test::More tests => $Num_Tests;
+
+There are rare cases when you will not know beforehand how many tests
+your script is going to run.  In this case, you can declare that you
+have no plan.  (Try to avoid using this as it weakens your test.)
+
+  use Test::More qw(no_plan);
+
+In some cases, you'll want to completely skip an entire testing script.
+
+  use Test::More skip_all => $skip_reason;
+
+Your script will declare a skip with the reason why you skipped and
+exit immediately with a zero (success).  See L<Test::Harness> for
+details.
+
+If you want to control what functions Test::More will export, you
+have to use the 'import' option.  For example, to import everything
+but 'fail', you'd do:
+
+  use Test::More tests => 23, import => ['!fail'];
+
+Alternatively, you can use the plan() function.  Useful for when you
+have to calculate the number of tests.
+
+  use Test::More;
+  plan tests => keys %Stuff * 3;
+
+or for deciding between running the tests at all:
+
+  use Test::More;
+  if( $^O eq 'MacOS' ) {
+      plan skip_all => 'Test irrelevant on MacOS';
+  }
+  else {
+      plan tests => 42;
+  }
+
+=cut
+
+sub plan {
+    my(@plan) = @_;
+
+    my $caller = caller;
+
+    $Test->exported_to($caller);
+
+    my @imports = ();
+    foreach my $idx (0..$#plan) {
+        if( $plan[$idx] eq 'import' ) {
+            my($tag, $imports) = splice @plan, $idx, 2;
+            @imports = @$imports;
+            last;
+        }
+    }
+
+    $Test->plan(@plan);
+
+    __PACKAGE__->_export_to_level(1, __PACKAGE__, @imports);
+}
+
+sub import {
+    my($class) = shift;
+    goto &plan;
+}
+
+
+=head2 Test names
+
+By convention, each test is assigned a number in order.  This is
+largely done automatically for you.  However, it's often very useful to
+assign a name to each test.  Which would you rather see:
+
+  ok 4
+  not ok 5
+  ok 6
+
+or
+
+  ok 4 - basic multi-variable
+  not ok 5 - simple exponential
+  ok 6 - force == mass * acceleration
+
+The later gives you some idea of what failed.  It also makes it easier
+to find the test in your script, simply search for "simple
+exponential".
+
+All test functions take a name argument.  It's optional, but highly
+suggested that you use it.
+
+
+=head2 I'm ok, you're not ok.
+
+The basic purpose of this module is to print out either "ok #" or "not
+ok #" depending on if a given test succeeded or failed.  Everything
+else is just gravy.
+
+All of the following print "ok" or "not ok" depending on if the test
+succeeded or failed.  They all also return true or false,
+respectively.
+
+=over 4
+
+=item B<ok>
+
+  ok($this eq $that, $test_name);
+
+This simply evaluates any expression (C<$this eq $that> 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.
+
+For example:
+
+    ok( $exp{9} == 81,                   'simple exponential' );
+    ok( Film->can('db_Main'),            'set_db()' );
+    ok( $p->tests == 4,                  'saw tests' );
+    ok( !grep !defined $_, @items,       'items populated' );
+
+(Mnemonic:  "This is ok.")
+
+$test_name is a very short description of the test that will be printed
+out.  It makes it very easy to find a test in your script when it fails
+and gives others an idea of your intentions.  $test_name is optional,
+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)
+
+This is actually Test::Simple's ok() routine.
+
+=cut
+
+sub ok ($;$) {
+    my($test, $name) = @_;
+    $Test->ok($test, $name);
+}
+
+=item B<is>
+
+=item B<isnt>
+
+  is  ( $this, $that, $test_name );
+  isnt( $this, $that, $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
+determine if the test succeeded or failed.  So these:
+
+    # Is the ultimate answer 42?
+    is( ultimate_answer(), 42,          "Meaning of Life" );
+
+    # $foo isn't empty
+    isnt( $foo, '',     "Got some foo" );
+
+are similar to these:
+
+    ok( ultimate_answer() eq 42,        "Meaning of Life" );
+    ok( $foo ne '',     "Got some foo" );
+
+(Mnemonic:  "This is that."  "This isn't that.")
+
+So why use these?  They produce better diagnostics on failure.  ok()
+cannot know what you are testing for (beyond the name), but is() and
+isnt() know what the test was and why it failed.  For example this
+test:
+
+    my $foo = 'waffle';  my $bar = 'yarblokos';
+    is( $foo, $bar,   'Is foo the same as bar?' );
+
+Will produce something like this:
+
+    not ok 17 - Is foo the same as bar?
+    #     Failed test (foo.t at line 139)
+    #          got: 'waffle'
+    #     expected: 'yarblokos'
+
+So you can figure out what went wrong without rerunning the test.
+
+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?' );
+
+This does not check if C<$pope->isa('Catholic')> 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?' );
+
+For those grammatical pedants out there, there's an C<isn't()>
+function which is an alias of isnt().
+
+=cut
+
+sub is ($$;$) {
+    $Test->is_eq(@_);
+}
+
+sub isnt ($$;$) {
+    $Test->isnt_eq(@_);
+}
+
+*isn't = \&isnt;
+
+
+=item B<like>
+
+  like( $this, qr/that/, $test_name );
+
+Similar to ok(), like() matches $this against the regex C<qr/that/>.
+
+So this:
+
+    like($this, qr/that/, 'this is like that');
+
+is similar to:
+
+    ok( $this =~ /that/, 'this is like that');
+
+(Mnemonic "This is like that".)
+
+The second argument is a regular expression.  It may be given as a
+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' );
+
+Regex options may be placed on the end (C<'/that/i'>).
+
+Its advantages over ok() are similar to that of is() and isnt().  Better
+diagnostics on failure.
+
+=cut
+
+sub like ($$;$) {
+    $Test->like(@_);
+}
+
+
+=item B<unlike>
+
+  unlike( $this, qr/that/, $test_name );
+
+Works exactly as like(), only it checks if $this B<does not> match the
+given pattern.
+
+=cut
+
+sub unlike {
+    $Test->unlike(@_);
+}
+
+
+=item B<cmp_ok>
+
+  cmp_ok( $this, $op, $that, $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( $this == $that );
+    cmp_ok( $this, '==', $that, 'this == that' );
+
+    # ok( $this && $that );
+    cmp_ok( $this, '&&', $that, 'this || that' );
+    ...etc...
+
+Its advantage over ok() is when the test fails you'll know what $this
+and $that were:
+
+    not ok 1
+    #     Failed test (foo.t at line 12)
+    #     '23'
+    #         &&
+    #     undef
+
+It's also useful in those cases where you are comparing numbers and
+is()'s use of C<eq> will interfere:
+
+    cmp_ok( $big_hairy_number, '==', $another_big_hairy_number );
+
+=cut
+
+sub cmp_ok($$$;$) {
+    $Test->cmp_ok(@_);
+}
+
+
+=item B<can_ok>
+
+  can_ok($module, @methods);
+  can_ok($object, @methods);
+
+Checks to make sure the $module or $object can do these @methods
+(works with functions, too).
+
+    can_ok('Foo', qw(this that whatever));
+
+is almost exactly like saying:
+
+    ok( Foo->can('this') && 
+        Foo->can('that') && 
+        Foo->can('whatever') 
+      );
+
+only without all the typing and with a better interface.  Handy for
+quickly testing an interface.
+
+No matter how many @methods you check, a single can_ok() call counts
+as one test.  If you desire otherwise, use:
+
+    foreach my $meth (@methods) {
+        can_ok('Foo', $meth);
+    }
+
+=cut
+
+sub can_ok ($@) {
+    my($proto, @methods) = @_;
+    my $class = ref $proto || $proto;
+
+    unless( @methods ) {
+        my $ok = $Test->ok( 0, "$class->can(...)" );
+        $Test->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;
+    }
+
+    my $name;
+    $name = @methods == 1 ? "$class->can('$methods[0]')" 
+                          : "$class->can(...)";
+    
+    my $ok = $Test->ok( !@nok, $name );
+
+    $Test->diag(map "    $class->can('$_') failed\n", @nok);
+
+    return $ok;
+}
+
+=item B<isa_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
+sure the object was defined in the first place.  Handy for this sort
+of thing:
+
+    my $obj = Some::Module->new;
+    isa_ok( $obj, 'Some::Module' );
+
+where you'd otherwise have to write
+
+    my $obj = Some::Module->new;
+    ok( defined $obj && $obj->isa('Some::Module') );
+
+to safeguard against your test script blowing up.
+
+It works on references, too:
+
+    isa_ok( $array_ref, 'ARRAY' );
+
+The diagnostics of this test normally just refer to 'the object'.  If
+you'd like them to be more specific, you can supply an $object_name
+(for example 'Test customer').
+
+=cut
+
+sub isa_ok ($$;$) {
+    my($object, $class, $obj_name) = @_;
+
+    my $diag;
+    $obj_name = 'The object' unless defined $obj_name;
+    my $name = "$obj_name isa $class";
+    if( !defined $object ) {
+        $diag = "$obj_name isn't defined";
+    }
+    elsif( !ref $object ) {
+        $diag = "$obj_name isn't a reference";
+    }
+    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 $ref = ref $object;
+                    $diag = "$obj_name isn't a '$class' it's a '$ref'";
+                }
+            } 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.
+$@
+WHOA
+            }
+        }
+        elsif( !$rslt ) {
+            my $ref = ref $object;
+            $diag = "$obj_name isn't a '$class' it's a '$ref'";
+        }
+    }
+            
+      
+
+    my $ok;
+    if( $diag ) {
+        $ok = $Test->ok( 0, $name );
+        $Test->diag("    $diag\n");
+    }
+    else {
+        $ok = $Test->ok( 1, $name );
+    }
+
+    return $ok;
+}
+
+
+=item B<pass>
+
+=item B<fail>
+
+  pass($test_name);
+  fail($test_name);
+
+Sometimes you just want to say that the tests have passed.  Usually
+the case is you've got some complicated condition that is difficult to
+wedge into an ok().  In this case, you can simply use pass() (to
+declare the test ok) or fail (for not ok).  They are synonyms for
+ok(1) and ok(0).
+
+Use these very, very, very sparingly.
+
+=cut
+
+sub pass (;$) {
+    $Test->ok(1, @_);
+}
+
+sub fail (;$) {
+    $Test->ok(0, @_);
+}
+
+=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 diag {
+    $Test->diag(@_);
+}
+
+
+=back
+
+=head2 Module tests
+
+You usually want to test if the module you're testing loads ok, rather
+than just vomiting if its load fails.  For such purposes we have
+C<use_ok> and C<require_ok>.
+
+=over 4
+
+=item B<use_ok>
+
+   BEGIN { use_ok($module); }
+   BEGIN { use_ok($module, @imports); }
+
+These simply use the given $module and test to make sure the load
+happened ok.  It's recommended that you run use_ok() inside a BEGIN
+block so its functions are exported at compile-time and prototypes are
+properly honored.
+
+If @imports are given, they are passed through to the use.  So this:
+
+   BEGIN { use_ok('Some::Module', qw(foo bar)) }
+
+is like doing this:
+
+   use Some::Module qw(foo bar);
+
+don't try to do this:
+
+   BEGIN {
+       use_ok('Some::Module');
+
+       ...some code that depends on the use...
+       ...happening at compile time...
+   }
+
+instead, you want:
+
+  BEGIN { use_ok('Some::Module') }
+  BEGIN { ...some code that depends on the use... }
+
+
+=cut
+
+sub use_ok ($;@) {
+    my($module, @imports) = @_;
+    @imports = () unless @imports;
+
+    my $pack = caller;
+
+    local($@,$!);   # eval sometimes interferes with $!
+    eval <<USE;
+package $pack;
+require $module;
+'$module'->import(\@imports);
+USE
+
+    my $ok = $Test->ok( !$@, "use $module;" );
+
+    unless( $ok ) {
+        chomp $@;
+        $Test->diag(<<DIAGNOSTIC);
+    Tried to use '$module'.
+    Error:  $@
+DIAGNOSTIC
+
+    }
+
+    return $ok;
+}
+
+=item B<require_ok>
+
+   require_ok($module);
+
+Like use_ok(), except it requires the $module.
+
+=cut
+
+sub require_ok ($) {
+    my($module) = shift;
+
+    my $pack = caller;
+
+    local($!, $@); # eval sometimes interferes with $!
+    eval <<REQUIRE;
+package $pack;
+require $module;
+REQUIRE
+
+    my $ok = $Test->ok( !$@, "require $module;" );
+
+    unless( $ok ) {
+        chomp $@;
+        $Test->diag(<<DIAGNOSTIC);
+    Tried to require '$module'.
+    Error:  $@
+DIAGNOSTIC
+
+    }
+
+    return $ok;
+}
+
+=back
+
+=head2 Conditional tests
+
+Sometimes running a test under certain conditions will cause the
+test script to die.  A certain function or method isn't implemented
+(such as fork() on MacOS), some resource isn't available (like a 
+net connection) or a module isn't available.  In these cases it's
+necessary to skip tests, or declare that they are supposed to fail
+but will work in the future (a todo test).
+
+For more details on the mechanics of skip and todo tests see
+L<Test::Harness>.
+
+The way Test::More handles this is with a named block.  Basically, a
+block of tests which can be skipped over or made todo.  It's best if I
+just show you...
+
+=over 4
+
+=item B<SKIP: BLOCK>
+
+  SKIP: {
+      skip $why, $how_many if $condition;
+
+      ...normal testing code goes here...
+  }
+
+This declares a block of tests that might be skipped, $how_many tests
+there are, $why and under what $condition to skip them.  An example is
+the easiest way to illustrate:
+
+    SKIP: {
+        eval { require HTML::Lint };
+
+        skip "HTML::Lint not installed", 2 if $@;
+
+        my $lint = new HTML::Lint;
+        isa_ok( $lint, "HTML::Lint" );
+
+        $lint->parse( $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.
+
+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.
+
+You don't skip tests which are failing because there's a bug in your
+program, or for which you don't yet have code written.  For that you
+use TODO.  Read on.
+
+=cut
+
+#'#
+sub skip {
+    my($why, $how_many) = @_;
+
+    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;
+        $how_many = 1;
+    }
+
+    for( 1..$how_many ) {
+        $Test->skip($why);
+    }
+
+    local $^W = 0;
+    last SKIP;
+}
+
+
+=item B<TODO: BLOCK>
+
+    TODO: {
+        local $TODO = $why if $condition;
+
+        ...normal testing code goes here...
+    }
+
+Declares a block of tests you expect to fail and $why.  Perhaps it's
+because you haven't fixed a bug or haven't finished a new feature:
+
+    TODO: {
+        local $TODO = "URI::Geller not finished";
+
+        my $card = "Eight of clubs";
+        is( URI::Geller->your_card, $card, 'Is THIS your card?' );
+
+        my $spoon;
+        URI::Geller->bend_spoon;
+        is( $spoon, 'bent',    "Spoon bending, that's original" );
+    }
+
+With a todo block, the tests inside are expected to fail.  Test::More
+will run the tests normally, but print out special flags indicating
+they are "todo".  Test::Harness will interpret failures as being ok.
+Should anything succeed, it will report it as an unexpected success.
+You then know the thing you had todo is done and can remove the
+TODO flag.
+
+The nice part about todo tests, as opposed to simply commenting out a
+block of tests, is it's like having a programmatic todo list.  You know
+how much work is left to be done, you're aware of what bugs there are,
+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.
+
+
+=item B<todo_skip>
+
+    TODO: {
+        todo_skip $why, $how_many if $condition;
+
+        ...normal testing code...
+    }
+
+With todo tests, it's best to have the tests actually run.  That way
+you'll know when they start passing.  Sometimes this isn't possible.
+Often a failing test will cause the whole program to die or hang, even
+inside an C<eval BLOCK> with and using C<alarm>.  In these extreme
+cases you have no choice but to skip over the broken tests entirely.
+
+The syntax and behavior is similar to a C<SKIP: BLOCK> except the
+tests will be marked as failing but todo.  Test::Harness will
+interpret them as passing.
+
+=cut
+
+sub todo_skip {
+    my($why, $how_many) = @_;
+
+    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;
+        $how_many = 1;
+    }
+
+    for( 1..$how_many ) {
+        $Test->todo_skip($why);
+    }
+
+    local $^W = 0;
+    last TODO;
+}
+
+=item When do I use SKIP vs. TODO?
+
+B<If it's something the user might not be able to do>, use SKIP.
+This includes optional modules that aren't installed, running under
+an OS that doesn't have some feature (like fork() or symlinks), or maybe
+you need an Internet connection and one isn't available.
+
+B<If it's something the programmer hasn't done yet>, use TODO.  This
+is for any code you haven't written yet, or bugs you have yet to fix,
+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.
+
+=over 4
+
+=item B<is_deeply>
+
+  is_deeply( $this, $that, $test_name );
+
+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.
+
+Barrie Slaymaker's Test::Differences module provides more in-depth
+functionality along these lines, and it plays well with Test::More.
+
+B<NOTE> Display of scalar refs is not quite 100%
+
+=cut
+
+use vars qw(@Data_Stack);
+my $DNE = bless [], 'Does::Not::Exist';
+sub is_deeply {
+    my($this, $that, $name) = @_;
+
+    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;
+}
+
+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' : 
+                      $val eq $DNE  ? "Does not exist"
+                                    : "'$val'";
+    }
+
+    $out .= "$vars[0] = $vals[0]\n";
+    $out .= "$vars[1] = $vals[1]\n";
+
+    $out =~ s/^/    /msg;
+    return $out;
+}
+
+
+=item B<eq_array>
+
+  eq_array(\@this, \@that);
+
+Checks if two arrays are equivalent.  This is a deep check, so
+multi-level structures are handled correctly.
+
+=cut
+
+#'#
+sub eq_array  {
+    my($a1, $a2) = @_;
+    return 1 if $a1 eq $a2;
+
+    my $ok = 1;
+    my $max = $#$a1 > $#$a2 ? $#$a1 : $#$a2;
+    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);
+        pop @Data_Stack if $ok;
+
+        last unless $ok;
+    }
+    return $ok;
+}
+
+sub _deep_check {
+    my($e1, $e2) = @_;
+    my $ok = 0;
+
+#    my $eq;
+    {
+        # Quiet uninitialized value warnings when comparing undefs.
+        local $^W = 0; 
+
+        if( $e1 eq $e2 ) {
+            $ok = 1;
+        }
+        else {
+            if( UNIVERSAL::isa($e1, 'ARRAY') and
+                UNIVERSAL::isa($e2, 'ARRAY') )
+            {
+                $ok = eq_array($e1, $e2);
+            }
+            elsif( UNIVERSAL::isa($e1, 'HASH') and
+                   UNIVERSAL::isa($e2, 'HASH') )
+            {
+                $ok = eq_hash($e1, $e2);
+            }
+            elsif( UNIVERSAL::isa($e1, 'REF') and
+                   UNIVERSAL::isa($e2, 'REF') )
+            {
+                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);
+            }
+            else {
+                push @Data_Stack, { vals => [$e1, $e2] };
+                $ok = 0;
+            }
+        }
+    }
+
+    return $ok;
+}
+
+
+=item B<eq_hash>
+
+  eq_hash(\%this, \%that);
+
+Determines if the two hashes contain the same keys and values.  This
+is a deep check.
+
+=cut
+
+sub eq_hash {
+    my($a1, $a2) = @_;
+    return 1 if $a1 eq $a2;
+
+    my $ok = 1;
+    my $bigger = keys %$a1 > keys %$a2 ? $a1 : $a2;
+    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);
+        pop @Data_Stack if $ok;
+
+        last unless $ok;
+    }
+
+    return $ok;
+}
+
+=item B<eq_set>
+
+  eq_set(\@this, \@that);
+
+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.
+
+B<NOTE> By historical accident, this is not a true set comparision.
+While the order of elements does not matter, duplicate elements do.
+
+=cut
+
+# 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 }
+
+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] );
+}
+
+=back
+
+
+=head2 Extending and Embedding Test::More
+
+Sometimes the Test::More interface isn't quite enough.  Fortunately,
+Test::More is built on top of Test::Builder which provides a single,
+unified backend for any test library to use.  This means two test
+libraries which both use Test::Builder B<can be used together in the
+same program>.
+
+If you simply want to do a little tweaking of how the tests behave,
+you can access the underlying Test::Builder object like so:
+
+=over 4
+
+=item B<builder>
+
+    my $test_builder = Test::More->builder;
+
+Returns the Test::Builder object underlying Test::More for you to play
+with.
+
+=cut
+
+sub builder {
+    return Test::Builder->new;
+}
+
+=back
+
+
+=head1 NOTES
+
+Test::More is B<explicitly> tested all the way back to perl 5.004.
+
+Test::More is thread-safe for perl 5.8.0 and up.
+
+=head1 BUGS and CAVEATS
+
+=over 4
+
+=item Making your own ok()
+
+If you are trying to extend Test::More, don't.  Use Test::Builder
+instead.
+
+=item The eq_* family has some caveats.
+
+=item Test::Harness upgrades
+
+no_plan and todo depend on new Test::Harness features and fixes.  If
+you're going to distribute tests that use no_plan or todo your
+end-users will have to upgrade Test::Harness to the latest one on
+CPAN.  If you avoid no_plan and TODO tests, the stock Test::Harness
+will work fine.
+
+If you simply depend on Test::More, it's own dependencies will cause a
+Test::Harness upgrade.
+
+=back
+
+
+=head1 HISTORY
+
+This is a case of convergent evolution with Joshua Pritikin's Test
+module.  I was largely unaware of its existence when I'd first
+written my own ok() routines.  This module exists because I can't
+figure out how to easily wedge test names into Test's interface (along
+with a few other problems).
+
+The goal here is to have a testing utility that's simple to learn,
+quick to use and difficult to trip yourself up with while still
+providing more flexibility than the existing Test.pm.  As such, the
+names of the most common routines are kept tiny, special cases and
+magic side-effects are kept to a minimum.  WYSIWYG.
+
+
+=head1 SEE ALSO
+
+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::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::Unit> describes a very featureful unit testing interface.
+
+L<Test::Inline> shows the idea of embedded testing.
+
+L<SelfTest> is another approach to embedded testing.
+
+
+=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.
+
+
+=head1 COPYRIGHT
+
+Copyright 2001 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.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=cut
+
+1;