Upgrade to Test-Harness-2.64

p4raw-id: //depot/perl@28953

11 files changed, 393 insertions, 178 deletions

diff --git a/lib/Test/Harness.pm b/lib/Test/Harness.pm
index 6e8236d420..1991a60f67 100644
--- a/lib/Test/Harness.pm
+++ b/lib/Test/Harness.pm
@@ -24,7 +24,7 @@ use vars qw(
 );
 
 BEGIN {
-    eval "use Time::HiRes 'time'";
+    eval q{use Time::HiRes 'time'};
     $has_time_hires = !$@;
 }
 
@@ -34,11 +34,11 @@ Test::Harness - Run Perl standard test scripts with statistics
 
 =head1 VERSION
 
-Version 2.62
+Version 2.64
 
 =cut
 
-$VERSION = '2.62';
+$VERSION = '2.64';
 
 # Backwards compatibility for exportable variable names.
 *verbose  = *Verbose;
@@ -56,7 +56,37 @@ END {
 
 my $Files_In_Dir = $ENV{HARNESS_FILELEAK_IN_DIR};
 
-$Strap = Test::Harness::Straps->new;
+# Stolen from Params::Util
+sub _CLASS {
+    (defined $_[0] and ! ref $_[0] and $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*$/s) ? $_[0] : undef;
+}
+
+# Strap Overloading
+if ( $ENV{HARNESS_STRAPS_CLASS} ) {
+    die 'Set HARNESS_STRAP_CLASS, singular, not HARNESS_STRAPS_CLASS';
+}
+my $HARNESS_STRAP_CLASS  = $ENV{HARNESS_STRAP_CLASS} || 'Test::Harness::Straps';
+if ( $HARNESS_STRAP_CLASS =~ /\.pm$/ ) {
+    # "Class" is actually a filename, that should return the
+    # class name as its true return value.
+    $HARNESS_STRAP_CLASS = require $HARNESS_STRAP_CLASS;
+    if ( !_CLASS($HARNESS_STRAP_CLASS) ) {
+        die "HARNESS_STRAP_CLASS '$HARNESS_STRAP_CLASS' is not a valid class name";
+    }
+}
+else {
+    # It is a class name within the current @INC
+    if ( !_CLASS($HARNESS_STRAP_CLASS) ) {
+        die "HARNESS_STRAP_CLASS '$HARNESS_STRAP_CLASS' is not a valid class name";
+    }
+    eval "require $HARNESS_STRAP_CLASS";
+    die $@ if $@;
+}
+if ( !$HARNESS_STRAP_CLASS->isa('Test::Harness::Straps') ) {
+    die "HARNESS_STRAP_CLASS '$HARNESS_STRAP_CLASS' must be a Test::Harness::Straps subclass";
+}
+
+$Strap = $HARNESS_STRAP_CLASS->new;
 
 sub strap { return $Strap };
 
@@ -66,7 +96,7 @@ sub strap { return $Strap };
 
 $Verbose  = $ENV{HARNESS_VERBOSE} || 0;
 $Debug    = $ENV{HARNESS_DEBUG} || 0;
-$Switches = "-w";
+$Switches = '-w';
 $Columns  = $ENV{HARNESS_COLUMNS} || $ENV{COLUMNS} || 80;
 $Columns--;             # Some shells have trouble with a full line of text.
 $Timer    = $ENV{HARNESS_TIMER} || 0;
@@ -333,7 +363,7 @@ sub execute_tests {
             print $out "# Running: ", $Strap->_command_line($tfile), "\n";
         }
         my $test_start_time = $Timer ? time : 0;
-        my %results = $Strap->analyze_file($tfile) or
+        my $results = $Strap->analyze_file($tfile) or
           do { warn $Strap->{error}, "\n";  next };
         my $elapsed;
         if ( $Timer ) {
@@ -350,35 +380,36 @@ sub execute_tests {
         }
 
         # state of the current test.
-        my @failed = grep { !$results{details}[$_-1]{ok} }
-                     1..@{$results{details}};
-        my @todo_pass = grep { $results{details}[$_-1]{actual_ok} &&
-                               $results{details}[$_-1]{type} eq 'todo' }
-                        1..@{$results{details}};
+        my @failed = grep { !$results->details->[$_-1]{ok} }
+                     1..@{$results->details};
+        my @todo_pass = grep { $results->details->[$_-1]{actual_ok} &&
+                               $results->details->[$_-1]{type} eq 'todo' }
+                        1..@{$results->details};
 
         my %test = (
-                    ok          => $results{ok},
-                    'next'      => $Strap->{'next'},
-                    max         => $results{max},
-                    failed      => \@failed,
-                    todo_pass   => \@todo_pass,
-                    todo        => $results{todo},
-                    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}) {
+            ok          => $results->ok,
+            'next'      => $Strap->{'next'},
+            max         => $results->max,
+            failed      => \@failed,
+            todo_pass   => \@todo_pass,
+            todo        => $results->todo,
+            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 = $results->exit;
+        my $wstatus = $results->wait;
+
+        if ( $results->passing ) {
             # XXX Combine these first two
             if ($test{max} and $test{skipped} + $test{bonus}) {
                 my @msg;
@@ -420,7 +451,7 @@ sub execute_tests {
             }
             # List overruns as failures.
             else {
-                my $details = $results{details};
+                my $details = $results->details;
                 foreach my $overrun ($test{max}+1..@$details) {
                     next unless ref $details->[$overrun-1];
                     push @{$test{failed}}, $overrun
@@ -432,7 +463,7 @@ sub execute_tests {
                                                        $estatus, $wstatus);
                 $failedtests{$tfile}{name} = $tfile;
             }
-            elsif($results{seen}) {
+            elsif ( $results->seen ) {
                 if (@{$test{failed}} and $test{max}) {
                     my ($txt, $canon) = _canondetail($test{max},$test{skipped},'Failed',
                                                     @{$test{failed}});
@@ -617,12 +648,12 @@ sub swrite {
 
 
 my %Handlers = (
-    header => \&header_handler,
-    test => \&test_handler,
+    header  => \&header_handler,
+    test    => \&test_handler,
     bailout => \&bailout_handler,
 );
 
-$Strap->{callback} = \&strap_callback;
+$Strap->set_callback(\&strap_callback);
 sub strap_callback {
     my($self, $line, $type, $totals) = @_;
     print $line if $Verbose;
@@ -640,30 +671,29 @@ sub header_handler {
     $self->{_seen_header}++;
 
     warn "1..M can only appear at the beginning or end of tests\n"
-      if $totals->{seen} && 
-         $totals->{max}  < $totals->{seen};
+      if $totals->seen && ($totals->max < $totals->seen);
 };
 
 sub test_handler {
     my($self, $line, $type, $totals) = @_;
 
-    my $curr = $totals->{seen};
+    my $curr = $totals->seen;
     my $next = $self->{'next'};
-    my $max  = $totals->{max};
-    my $detail = $totals->{details}[-1];
+    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};
+            $totals->set_skip_reason( $detail->{reason} )
+              unless defined $totals->skip_reason;
+            $totals->set_skip_reason( 'various reasons' )
+              if $totals->skip_reason ne $detail->{reason};
         }
     }
     else {
-        _print_ml("NOK $curr");
+        _print_ml("NOK $curr/$max");
     }
 
     if( $curr > $next ) {
@@ -989,6 +1019,21 @@ If true, Test::Harness will output the verbose results of running
 its tests.  Setting C<$Test::Harness::verbose> will override this,
 or you can use the C<-v> switch in the F<prove> utility.
 
+If true, Test::Harness will output the verbose results of running
+its tests.  Setting C<$Test::Harness::verbose> will override this,
+or you can use the C<-v> switch in the F<prove> utility.
+
+=item C<HARNESS_STRAP_CLASS>
+
+Defines the Test::Harness::Straps subclass to use.  The value may either
+be a filename or a class name.
+
+If HARNESS_STRAP_CLASS is a class name, the class must be in C<@INC>
+like any other class.
+
+If HARNESS_STRAP_CLASS is a filename, the .pm file must return the name
+of the class, instead of the canonical "1".
+
 =back
 
 =head1 EXAMPLE
@@ -1039,8 +1084,6 @@ 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.
diff --git a/lib/Test/Harness/Changes b/lib/Test/Harness/Changes
index 479b82cf2a..9be4fcdedb 100644
--- a/lib/Test/Harness/Changes
+++ b/lib/Test/Harness/Changes
@@ -1,5 +1,26 @@
 Revision history for Perl extension Test::Harness
 
+NEXT
+    [FIXES]
+    * prove's --perl=/path/to/file wasn't taking a value.
+    * prove's version number was not getting incremented.  From now on,
+      prove's $VERSION will match Test::Harness's $VERSION, and I added
+      a test to make sure this is the case.
+
+    [ENHANCEMENTS]
+    * Added test straps overload via HARNESS_STRAP_OVERLOAD environment
+      variable.  prove now takes a --strap=class parameter.  Thanks,
+      Adam Kennedy.
+
+2.63_01 Fri Jun 30 16:59:50 CDT 2006
+    [ENHANCEMENTS]
+    * Failed tests used to say "NOK x", and now say "NOK x/y".
+      Thanks to Will Coleda.
+
+    * Added the Test::Harness::Results object, so we have a well-defined
+      object, and not just a hash that we pass around.  Thanks to YAPC::NA
+      2006 Hackathon!
+
 2.62 Thu Jun  8 14:11:57 CDT 2006
     [FIXES]
     * Restored the behavior of dying if any subtests failed.  This is a
diff --git a/lib/Test/Harness/Results.pm b/lib/Test/Harness/Results.pm
new file mode 100644
index 0000000000..f972fdd816
--- /dev/null
+++ b/lib/Test/Harness/Results.pm
@@ -0,0 +1,171 @@
+# -*- Mode: cperl; cperl-indent-level: 4 -*-
+package Test::Harness::Results;
+
+use strict;
+use vars qw($VERSION);
+$VERSION = '0.01';
+
+=head1 NAME
+
+Test::Harness::Results - object for tracking results from a single test file
+
+=head1 SYNOPSIS
+
+One Test::Harness::Results object represents the results from one
+test file getting analyzed.
+
+=head1 CONSTRUCTION
+
+=head2 new()
+
+    my $results = new Test::Harness::Results;
+
+Create a test point object.  Typically, however, you'll not create
+one yourself, but access a Results object returned to you by
+Test::Harness::Results.
+
+=cut
+
+sub new {
+    my $class = shift;
+    my $self  = bless {}, $class;
+
+    return $self;
+}
+
+=head1 ACCESSORS
+
+The following data points are defined:
+
+  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)
+              diagnostics => test diagnostics (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.
+
+
+Each of the following fields has a getter and setter method.
+
+=over 4
+
+=item * wait
+
+=item * exit
+
+=cut
+
+sub set_wait { my $self = shift; $self->{wait} = shift }
+sub wait {
+    my $self = shift;
+    return $self->{wait} || 0;
+}
+
+sub set_skip_all { my $self = shift; $self->{skip_all} = shift }
+sub skip_all {
+    my $self = shift;
+    return $self->{skip_all};
+}
+
+sub inc_max { my $self = shift; $self->{max} += (@_ ? shift : 1) }
+sub max {
+    my $self = shift;
+    return $self->{max} || 0;
+}
+
+sub set_passing { my $self = shift; $self->{passing} = shift }
+sub passing {
+    my $self = shift;
+    return $self->{passing} || 0;
+}
+
+sub inc_ok { my $self = shift; $self->{ok} += (@_ ? shift : 1) }
+sub ok {
+    my $self = shift;
+    return $self->{ok} || 0;
+}
+
+sub set_exit { my $self = shift; $self->{exit} = shift }
+sub exit {
+    my $self = shift;
+    return $self->{exit} || 0;
+}
+
+sub inc_bonus { my $self = shift; $self->{bonus}++ }
+sub bonus {
+    my $self = shift;
+    return $self->{bonus} || 0;
+}
+
+sub set_skip_reason { my $self = shift; $self->{skip_reason} = shift }
+sub skip_reason {
+    my $self = shift;
+    return $self->{skip_reason} || 0;
+}
+
+sub inc_skip { my $self = shift; $self->{skip}++ }
+sub skip {
+    my $self = shift;
+    return $self->{skip} || 0;
+}
+
+sub inc_todo { my $self = shift; $self->{todo}++ }
+sub todo {
+    my $self = shift;
+    return $self->{todo} || 0;
+}
+
+sub inc_seen { my $self = shift; $self->{seen}++ }
+sub seen {
+    my $self = shift;
+    return $self->{seen} || 0;
+}
+
+sub set_details {
+    my $self = shift;
+    my $index = shift;
+    my $details = shift;
+
+    my $array = ($self->{details} ||= []);
+    $array->[$index-1] = $details;
+}
+
+sub details {
+    my $self = shift;
+    return $self->{details} || [];
+}
+
+1;
diff --git a/lib/Test/Harness/Straps.pm b/lib/Test/Harness/Straps.pm
index 5804296724..5a88e142bd 100644
--- a/lib/Test/Harness/Straps.pm
+++ b/lib/Test/Harness/Straps.pm
@@ -9,6 +9,7 @@ use Config;
 use Test::Harness::Assert;
 use Test::Harness::Iterator;
 use Test::Harness::Point;
+use Test::Harness::Results;
 
 # Flags used as return values from our methods.  Just for internal 
 # clarification.
@@ -26,9 +27,9 @@ Test::Harness::Straps - detailed analysis of test results
   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);
+  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;
@@ -93,10 +94,10 @@ sub _init {
 
 =head2 $strap->analyze( $name, \@output_lines )
 
-    my %results = $strap->analyze($name, \@test_output);
+    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.
+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
@@ -117,41 +118,35 @@ sub _analyze_iterator {
 
     $self->_reset_file_state;
     $self->{file} = $name;
-    my %totals  = (
-                   max      => 0,
-                   seen     => 0,
 
-                   ok       => 0,
-                   todo     => 0,
-                   skip     => 0,
-                   bonus    => 0,
-
-                   details  => []
-                  );
+    my $results = Test::Harness::Results->new;
 
     # Set them up here so callbacks can have them.
-    $self->{totals}{$name}         = \%totals;
+    $self->{totals}{$name} = $results;
     while( defined(my $line = $it->next) ) {
-        $self->_analyze_line($line, \%totals);
+        $self->_analyze_line($line, $results);
         last if $self->{saw_bailout};
     }
 
-    $totals{skip_all} = $self->{skip_all} if defined $self->{skip_all};
+    $results->set_skip_all( $self->{skip_all} ) if defined $self->{skip_all};
+
+    my $passed =
+        (($results->max == 0) && defined $results->skip_all) ||
+        ($results->max &&
+         $results->seen &&
+         $results->max == $results->seen &&
+         $results->max == $results->ok);
 
-    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;
+    $results->set_passing( $passed ? 1 : 0 );
 
-    return %totals;
+    return $results;
 }
 
 
 sub _analyze_line {
     my $self = shift;
     my $line = shift;
-    my $totals = shift;
+    my $results = shift;
 
     $self->{line}++;
 
@@ -160,7 +155,7 @@ sub _analyze_line {
     if ( $point ) {
         $linetype = 'test';
 
-        $totals->{seen}++;
+        $results->inc_seen;
         $point->set_number( $self->{'next'} ) unless $point->number;
 
         # sometimes the 'not ' and the 'ok' are on different lines,
@@ -176,14 +171,14 @@ sub _analyze_line {
         }
 
         if ( $point->is_todo ) {
-            $totals->{todo}++;
-            $totals->{bonus}++ if $point->ok;
+            $results->inc_todo;
+            $results->inc_bonus if $point->ok;
         }
         elsif ( $point->is_skip ) {
-            $totals->{skip}++;
+            $results->inc_skip;
         }
 
-        $totals->{ok}++ if $point->pass;
+        $results->inc_ok if $point->pass;
 
         if ( ($point->number > 100_000) && ($point->number > ($self->{max}||100_000)) ) {
             if ( !$self->{too_many_tests}++ ) {
@@ -201,7 +196,7 @@ sub _analyze_line {
             };
 
             assert( defined( $details->{ok} ) && defined( $details->{actual_ok} ) );
-            $totals->{details}[$point->number - 1] = $details;
+            $results->set_details( $point->number, $details );
         }
     } # test point
     elsif ( $line =~ /^not\s+$/ ) {
@@ -215,7 +210,7 @@ sub _analyze_line {
 
         $self->{saw_header}++;
 
-        $totals->{max} += $self->{max};
+        $results->inc_max( $self->{max} );
     }
     elsif ( $self->_is_bail_out($line, \$self->{bailout_reason}) ) {
         $linetype = 'bailout';
@@ -223,7 +218,8 @@ sub _analyze_line {
     }
     elsif (my $diagnostics = $self->_is_diagnostic_line( $line )) {
         $linetype = 'other';
-        my $test = $totals->{details}[-1];
+        # XXX We can throw this away, really.
+        my $test = $results->details->[-1];
         $test->{diagnostics} ||=  '';
         $test->{diagnostics}  .= $diagnostics;
     }
@@ -231,7 +227,7 @@ sub _analyze_line {
         $linetype = 'other';
     }
 
-    $self->{callback}->($self, $line, $linetype, $totals) if $self->{callback};
+    $self->callback->($self, $line, $linetype, $results) if $self->callback;
 
     $self->{'next'} = $point->number + 1 if $point;
 } # _analyze_line
@@ -246,7 +242,7 @@ sub _is_diagnostic_line {
 
 =for private $strap->analyze_fh( $name, $test_filehandle )
 
-    my %results = $strap->analyze_fh($name, $test_filehandle);
+    my $results = $strap->analyze_fh($name, $test_filehandle);
 
 Like C<analyze>, but it reads from the given filehandle.
 
@@ -261,7 +257,7 @@ sub analyze_fh {
 
 =head2 $strap->analyze_file( $test_file )
 
-    my %results = $strap->analyze_file($test_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.
@@ -295,20 +291,21 @@ sub analyze_file {
         return;
     }
 
-    my %results = $self->analyze_fh($file, \*FILE);
+    my $results = $self->analyze_fh($file, \*FILE);
     my $exit    = close FILE;
-    $results{'wait'} = $?;
-    if( $? && $self->{_is_vms} ) {
-        eval q{use vmsish "status"; $results{'exit'} = $?};
+
+    $results->set_wait($?);
+    if ( $? && $self->{_is_vms} ) {
+        eval q{use vmsish "status"; $results->set_exit($?); };
     }
     else {
-        $results{'exit'} = _wait2exit($?);
+        $results->set_exit( _wait2exit($?) );
     }
-    $results{passing} = 0 unless $? == 0;
+    $results->set_passing(0) unless $? == 0;
 
     $self->_restore_PERL5LIB();
 
-    return %results;
+    return $results;
 }
 
 
@@ -617,51 +614,6 @@ sub _reset_file_state {
     $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)
-              diagnostics => test diagnostics (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.
-
 =head1 EXAMPLES
 
 See F<examples/mini_harness.plx> for an example of use.
@@ -682,4 +634,14 @@ sub _def_or_blank {
     return "";
 }
 
+sub set_callback {
+    my $self = shift;
+    $self->{callback} = shift;
+}
+
+sub callback {
+    my $self = shift;
+    return $self->{callback};
+}
+
 1;
diff --git a/lib/Test/Harness/Util.pm b/lib/Test/Harness/Util.pm
index 9218d30382..0cda2fee6f 100644
--- a/lib/Test/Harness/Util.pm
+++ b/lib/Test/Harness/Util.pm
@@ -4,6 +4,7 @@ use strict;
 use vars qw($VERSION);
 $VERSION = '0.01';
 
+use File::Spec;
 use Exporter;
 use vars qw( @ISA @EXPORT @EXPORT_OK );
 
diff --git a/lib/Test/Harness/bin/prove b/lib/Test/Harness/bin/prove
index a3a3065aa9..fb5bf0f0dc 100644
--- a/lib/Test/Harness/bin/prove
+++ b/lib/Test/Harness/bin/prove
@@ -10,7 +10,7 @@ use Pod::Usage 1.12;
 use File::Spec;
 
 use vars qw( $VERSION );
-$VERSION = "1.04";
+$VERSION = '2.64';
 
 my $shuffle = 0;
 my $dry = 0;
@@ -25,10 +25,10 @@ my @switches = ();
 
 # Stick any default switches at the beginning, so they can be overridden
 # by the command line switches.
-unshift @ARGV, split( " ", $ENV{PROVE_SWITCHES} ) if defined $ENV{PROVE_SWITCHES};
+unshift @ARGV, split( ' ', $ENV{PROVE_SWITCHES} ) if defined $ENV{PROVE_SWITCHES};
 
-Getopt::Long::Configure( "no_ignore_case" );
-Getopt::Long::Configure( "bundling" );
+Getopt::Long::Configure( 'no_ignore_case' );
+Getopt::Long::Configure( 'bundling' );
 GetOptions(
     'b|blib'        => \$blib,
     'd|debug'       => \$Test::Harness::debug,
@@ -37,13 +37,14 @@ GetOptions(
     'H|man'         => sub {pod2usage({-verbose => 2}); exit},
     'I=s@'          => \@includes,
     'l|lib'         => \$lib,
-    'perl'          => \$ENV{HARNESS_PERL},
+    'perl=s'        => \$ENV{HARNESS_PERL},
     'r|recurse'     => \$recurse,
     's|shuffle'     => \$shuffle,
-    't'             => sub { unshift @switches, "-t" }, # Always want -t up front
-    'T'             => sub { unshift @switches, "-T" }, # Always want -T up front
+    't'             => sub { unshift @switches, '-t' }, # Always want -t up front
+    'T'             => sub { unshift @switches, '-T' }, # Always want -T up front
     'w'             => sub { push @switches, '-w' },
     'W'             => sub { push @switches, '-W' },
+    'strap=s'       => \$ENV{HARNESS_STRAP_CLASS},
     'timer'         => \$Test::Harness::Timer,
     'v|verbose'     => \$Test::Harness::verbose,
     'V|version'     => sub { print_version(); exit; },
@@ -64,12 +65,12 @@ if ( $blib ) {
 
 # Handle lib includes
 if ( $lib ) {
-    unshift @includes, "lib";
+    unshift @includes, 'lib';
 }
 
 # Build up TH switches
 push( @switches, map { /\s/ && !/^".*"$/ ? qq["-I$_"] : "-I$_" } @includes );
-$Test::Harness::Switches = join( " ", @switches );
+$Test::Harness::Switches = join( ' ', @switches );
 print "# \$Test::Harness::Switches: $Test::Harness::Switches\n" if $Test::Harness::debug;
 
 @ARGV = File::Spec->curdir unless @ARGV;
@@ -90,7 +91,7 @@ for ( @argv_globbed ) {
 if ( @tests ) {
     shuffle(@tests) if $shuffle;
     if ( $dry ) {
-        print join( "\n", @tests, "" );
+        print join( "\n", @tests, '' );
     }
     else {
         print "# ", scalar @tests, " tests to run\n" if $Test::Harness::debug;
@@ -125,6 +126,7 @@ prove [options] [files/directories]
         --perl      Sets the name of the Perl executable to use
     -r, --recurse   Recursively descend into directories
     -s, --shuffle   Run the tests in a random order
+        --strap     Define strap class to use
     -T              Enable tainting checks
     -t              Enable tainting warnings
         --timer     Print elapsed time after each test file
@@ -232,6 +234,11 @@ order are likely to be revealed.  The author hopes the run the
 algorithm on the preceding sentence to see if he can produce something
 slightly less awkward.
 
+=head2 --strap
+
+Sets the HARNESS_STRAP_CLASS variable to set which Test::Harness::Straps
+variable to use in running the tests.
+
 =head2 -t
 
 Runs test programs under perl's -t taint warning mode.
@@ -275,7 +282,7 @@ Andy Lester C<< <andy at petdance.com> >>
 
 =head1 COPYRIGHT
 
-Copyright 2005 by Andy Lester C<< <andy at petdance.com> >>.
+Copyright 2004-2006 by Andy Lester C<< <andy at petdance.com> >>.
 
 This program is free software; you can redistribute it and/or 
 modify it under the same terms as Perl itself.
diff --git a/lib/Test/Harness/t/00compile.t b/lib/Test/Harness/t/00compile.t
index ad4ddde508..0b8ad828d1 100644
--- a/lib/Test/Harness/t/00compile.t
+++ b/lib/Test/Harness/t/00compile.t
@@ -10,7 +10,7 @@ BEGIN {
     }
 }
 
-use Test::More tests => 6;
+use Test::More tests => 8;
 
 BEGIN { use_ok 'Test::Harness' }
 BEGIN { diag( "Testing Test::Harness $Test::Harness::VERSION under Perl $] and Test::More $Test::More::VERSION" ) unless $ENV{PERL_CORE}}
@@ -23,6 +23,10 @@ BEGIN { use_ok 'Test::Harness::Assert' }
 
 BEGIN { use_ok 'Test::Harness::Point' }
 
+BEGIN { use_ok 'Test::Harness::Results' }
+
+BEGIN { use_ok 'Test::Harness::Util' }
+
 # If the $VERSION is set improperly, this will spew big warnings.
 BEGIN { use_ok 'Test::Harness', 1.1601 }
 
diff --git a/lib/Test/Harness/t/callback.t b/lib/Test/Harness/t/callback.t
index 4164da4abe..9681aa7f0d 100644
--- a/lib/Test/Harness/t/callback.t
+++ b/lib/Test/Harness/t/callback.t
@@ -52,10 +52,12 @@ my $SAMPLE_TESTS = $ENV{PERL_CORE}
 
 my $strap = Test::Harness::Straps->new;
 isa_ok( $strap, 'Test::Harness::Straps' );
-$strap->{callback} = sub {
-    my($self, $line, $type, $totals) = @_;
-    push @out, $type;
-};
+$strap->set_callback(
+    sub {
+        my($self, $line, $type, $totals) = @_;
+        push @out, $type;
+    }
+);
 
 for my $test ( sort keys %samples ) {
     my $expect = $samples{$test};
diff --git a/lib/Test/Harness/t/prove-switches.t b/lib/Test/Harness/t/prove-switches.t
index cf753acb4a..79c0641bb5 100644
--- a/lib/Test/Harness/t/prove-switches.t
+++ b/lib/Test/Harness/t/prove-switches.t
@@ -18,7 +18,7 @@ plan skip_all => "Not installing prove" if -e "t/SKIP-PROVE";
 # http://rt.perl.org/rt3/Ticket/Display.html?id=30952.
 plan skip_all => "Skipping because of a Cygwin bug" if ( $^O =~ /cygwin/i );
 
-plan tests => 5;
+plan tests => 8;
 
 my $blib = File::Spec->catfile( File::Spec->curdir, "blib" );
 my $blib_lib = File::Spec->catfile( $blib, "lib" );
@@ -28,7 +28,6 @@ $prove = "$^X $prove";
 
 CAPITAL_TAINT: {
     local $ENV{PROVE_SWITCHES};
-    local $/ = undef;
 
     my @actual = qx/$prove -Ifirst -D -I second -Ithird -Tvdb/;
     my @expected = ( "# \$Test::Harness::Switches: -T -I$blib_arch -I$blib_lib -Ifirst -Isecond -Ithird\n" );
@@ -37,7 +36,6 @@ CAPITAL_TAINT: {
 
 LOWERCASE_TAINT: {
     local $ENV{PROVE_SWITCHES};
-    local $/ = undef;
 
     my @actual = qx/$prove -dD -Ifirst -I second -t -Ithird -vb/;
     my @expected = ( "# \$Test::Harness::Switches: -t -I$blib_arch -I$blib_lib -Ifirst -Isecond -Ithird\n" );
@@ -46,7 +44,6 @@ LOWERCASE_TAINT: {
 
 PROVE_SWITCHES: {
     local $ENV{PROVE_SWITCHES} = "-dvb -I fark";
-    local $/ = undef;
 
     my @actual = qx/$prove -Ibork -Dd/;
     my @expected = ( "# \$Test::Harness::Switches: -I$blib_arch -I$blib_lib -Ifark -Ibork\n" );
@@ -54,17 +51,25 @@ PROVE_SWITCHES: {
 }
 
 PROVE_SWITCHES_L: {
-    local $/ = undef;
-
     my @actual = qx/$prove -l -Ibongo -Dd/;
     my @expected = ( "# \$Test::Harness::Switches: -Ilib -Ibongo\n" );
     is_deeply( \@actual, \@expected, "PROVE_SWITCHES OK" );
 }
 
 PROVE_SWITCHES_LB: {
-    local $/ = undef;
-
     my @actual = qx/$prove -lb -Dd/;
     my @expected = ( "# \$Test::Harness::Switches: -Ilib -I$blib_arch -I$blib_lib\n" );
     is_deeply( \@actual, \@expected, "PROVE_SWITCHES OK" );
 }
+
+PROVE_VERSION: {
+    # This also checks that the prove $VERSION is in sync with Test::Harness's $VERSION
+    local $/ = undef;
+
+    use_ok( 'Test::Harness' );
+
+    my $thv = $Test::Harness::VERSION;
+    my @actual = qx/$prove --version/;
+    is( scalar @actual, 1, 'Only 1 line returned' );
+    like( $actual[0], qq{/^\Qprove v$thv, using Test::Harness v$thv and Perl v5\E/} );
+}
diff --git a/lib/Test/Harness/t/strap-analyze.t b/lib/Test/Harness/t/strap-analyze.t
index 5732b158a8..4e38ee338f 100644
--- a/lib/Test/Harness/t/strap-analyze.t
+++ b/lib/Test/Harness/t/strap-analyze.t
@@ -11,7 +11,7 @@ BEGIN {
 }
 
 use strict;
-use Test::More;
+use Test::More tests => 247;
 use File::Spec;
 
 my $Curdir = File::Spec->curdir;
@@ -544,7 +544,6 @@ my %samples = (
         'wait' => 0
     },
 );
-plan tests => (keys(%samples) * 5) + 3;
 
 use Test::Harness::Straps;
 my @_INC = map { qq{"-I$_"} } @INC;
@@ -568,34 +567,33 @@ for my $test ( sort keys %samples ) {
     my $test_path = File::Spec->catfile($SAMPLE_TESTS, $test);
     my $strap = Test::Harness::Straps->new;
     isa_ok( $strap, 'Test::Harness::Straps' );
-    my %results = $strap->analyze_file($test_path);
+    my $results = $strap->analyze_file($test_path);
 
-    is_deeply($results{details}, $expect->{details}, qq{details of "$test"} );
+    is_deeply($results->details, $expect->{details}, qq{details of "$test"} );
 
     delete $expect->{details};
-    delete $results{details};
 
     SKIP: {
         skip '$? unreliable in MacPerl', 2 if $IsMacPerl;
 
         # We can only check if it's zero or non-zero.
-        is( !!$results{'wait'}, !!$expect->{'wait'}, 'wait status' );
-        delete $results{'wait'};
+        is( !$results->wait, !$expect->{'wait'}, 'wait status' );
         delete $expect->{'wait'};
 
         # Have to check the exit status seperately so we can skip it
         # in MacPerl.
-        is( $results{'exit'}, $expect->{'exit'} );
-        delete $results{'exit'};
+        is( $results->exit, $expect->{'exit'}, 'exit matches' );
         delete $expect->{'exit'};
     }
 
-    is_deeply(\%results, $expect, qq{ the rest of "$test"} );
+    for my $field ( sort keys %$expect ) {
+        is( $results->$field(), $expect->{$field}, "Field $field" );
+    }
 } # for %samples
 
 NON_EXISTENT_FILE: {
     my $strap = Test::Harness::Straps->new;
     isa_ok( $strap, 'Test::Harness::Straps' );
-    ok( !$strap->analyze_file('I_dont_exist') );
-    is( $strap->{error}, "I_dont_exist does not exist" );
+    ok( !$strap->analyze_file('I_dont_exist'), "Can't analyze a non-existant file" );
+    is( $strap->{error}, "I_dont_exist does not exist", "And there should be one error" );
 }
diff --git a/lib/Test/Harness/t/test-harness.t b/lib/Test/Harness/t/test-harness.t
index dbdc6f9169..88d28a99f2 100644
--- a/lib/Test/Harness/t/test-harness.t
+++ b/lib/Test/Harness/t/test-harness.t
@@ -504,11 +504,12 @@ SKIP: {
     my $expect = $samples{$test};
 
     # execute_tests() runs the tests but skips the formatting.
-    my($totals, $failed);
-    my $warning = '';
     my $test_path = File::Spec->catfile($SAMPLE_TESTS, $test);
 
     print STDERR "# $test\n" if $ENV{TEST_VERBOSE};
+    my $totals;
+    my $failed;
+    my $warning = '';
     eval {
         local $SIG{__WARN__} = sub { $warning .= join '', @_; };
         ($totals, $failed) = Test::Harness::execute_tests(tests => [$test_path], out => \*NULL);
@@ -524,7 +525,7 @@ SKIP: {
 
     SKIP: {
         skip "don't apply to a bailout", 6 if $test eq 'bailout';
-        is( $@, '' );
+        is( $@, '', '$@ is empty' );
         is( Test::Harness::_all_ok($totals), $expect->{all_ok},
                                                   "$test - all ok" );
         ok( defined $expect->{total},             "$test - has total" );
@@ -539,7 +540,7 @@ SKIP: {
         skip "No tests were run", 1 unless $totals->{max};
 
         my $output = Test::Harness::get_results($totals, $failed);
-        like( $output, '/All tests successful|List of Failed/' );
+        like( $output, '/All tests successful|List of Failed/', 'Got what looks like a valid summary' );
     }
 
     my $expected_warnings = "";