Change 30055 by [EMAIL PROTECTED] on 2007/01/28 23:54:52
Integrate:
[ 28297]
Subject: [PATCH] Stop harness from printing summary table header for
each row in table
From: demerphq <[EMAIL PROTECTED]>
Date: Tue, 23 May 2006 22:27:40 +0200
Message-ID: <[EMAIL PROTECTED]>
[ 28304]
Upgrade to Test-Harness-2.60
[ 28384]
Upgrade to Test::Harness 2.62
[ 28386]
Adapt the new Test::Harness test to the core
[ 28953]
Upgrade to Test-Harness-2.64
Affected files ...
... //depot/maint-5.8/perl/MANIFEST#297 integrate
... //depot/maint-5.8/perl/lib/Test/Harness.pm#19 integrate
... //depot/maint-5.8/perl/lib/Test/Harness/Changes#13 integrate
... //depot/maint-5.8/perl/lib/Test/Harness/Results.pm#1 branch
... //depot/maint-5.8/perl/lib/Test/Harness/Straps.pm#17 integrate
... //depot/maint-5.8/perl/lib/Test/Harness/Util.pm#2 integrate
... //depot/maint-5.8/perl/lib/Test/Harness/bin/prove#7 integrate
... //depot/maint-5.8/perl/lib/Test/Harness/t/00compile.t#6 integrate
... //depot/maint-5.8/perl/lib/Test/Harness/t/callback.t#5 integrate
... //depot/maint-5.8/perl/lib/Test/Harness/t/failure.t#1 branch
... //depot/maint-5.8/perl/lib/Test/Harness/t/prove-switches.t#6 integrate
... //depot/maint-5.8/perl/lib/Test/Harness/t/strap-analyze.t#8 integrate
... //depot/maint-5.8/perl/lib/Test/Harness/t/test-harness.t#10 integrate
Differences ...
==== //depot/maint-5.8/perl/MANIFEST#297 (text) ====
Index: perl/MANIFEST
--- perl/MANIFEST#296~30046~ 2007-01-27 15:25:32.000000000 -0800
+++ perl/MANIFEST 2007-01-28 15:54:52.000000000 -0800
@@ -1883,12 +1883,14 @@
lib/Test/Harness/Iterator.pm Test::Harness::Iterator (internal use only)
lib/Test/Harness.pm A test harness
lib/Test/Harness/Point.pm Test::Harness::Point (internal use only)
+lib/Test/Harness/Results.pm object for tracking results from a single test
file
lib/Test/Harness/Straps.pm Test::Harness::Straps
lib/Test/Harness/t/00compile.t Test::Harness test
lib/Test/Harness/TAP.pod Documentation for the Test Anything Protocol
lib/Test/Harness/t/assert.t Test::Harness::Assert test
lib/Test/Harness/t/base.t Test::Harness test
lib/Test/Harness/t/callback.t Test::Harness test
+lib/Test/Harness/t/failure.t Test::Harness test
lib/Test/Harness/t/from_line.t Test::Harness test
lib/Test/Harness/t/harness.t Test::Harness test
lib/Test/Harness/t/inc_taint.t Test::Harness test
==== //depot/maint-5.8/perl/lib/Test/Harness.pm#19 (text) ====
Index: perl/lib/Test/Harness.pm
--- perl/lib/Test/Harness.pm#18~28191~ 2006-05-14 04:01:39.000000000 -0700
+++ perl/lib/Test/Harness.pm 2007-01-28 15:54:52.000000000 -0800
@@ -24,7 +24,7 @@
);
BEGIN {
- eval "use Time::HiRes 'time'";
+ eval q{use Time::HiRes 'time'};
$has_time_hires = !$@;
}
@@ -34,11 +34,11 @@
=head1 VERSION
-Version 2.58
+Version 2.64
=cut
-$VERSION = '2.58';
+$VERSION = '2.64';
# Backwards compatibility for exportable variable names.
*verbose = *Verbose;
@@ -56,7 +56,37 @@
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 @@
$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;
@@ -214,6 +244,11 @@
assert(($ok xor keys %$failedtests),
q{ok status jives with $failedtests});
+ if (! $ok) {
+ die("Failed $tot->{bad}/$tot->{tests} test programs. " .
+ "@{[$tot->{max} - $tot->{ok}]}/$tot->{max} subtests failed.\n");
+ }
+
return $ok;
}
@@ -327,7 +362,7 @@
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 ) {
@@ -344,35 +379,36 @@
}
# state of the current test.
- my @failed = grep { !$results{details}[$_-1]{ok} }
- [EMAIL PROTECTED];
- my @todo_pass = grep { $results{details}[$_-1]{actual_ok} &&
- $results{details}[$_-1]{type} eq 'todo' }
- [EMAIL PROTECTED];
+ my @failed = grep { !$results->details->[$_-1]{ok} }
+ [EMAIL PROTECTED]>details};
+ my @todo_pass = grep { $results->details->[$_-1]{actual_ok} &&
+ $results->details->[$_-1]{type} eq 'todo' }
+ [EMAIL PROTECTED]>details};
my %test = (
- ok => $results{ok},
- 'next' => $Strap->{'next'},
- max => $results{max},
- failed => [EMAIL PROTECTED],
- todo_pass => [EMAIL PROTECTED],
- 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};
+ ok => $results->ok,
+ 'next' => $Strap->{'next'},
+ max => $results->max,
+ failed => [EMAIL PROTECTED],
+ todo_pass => [EMAIL PROTECTED],
+ 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)};
+ my $estatus = $results->exit;
+ my $wstatus = $results->wait;
- if ($results{passing}) {
+ if ( $results->passing ) {
# XXX Combine these first two
if ($test{max} and $test{skipped} + $test{bonus}) {
my @msg;
@@ -414,7 +450,7 @@
}
# List overruns as failures.
else {
- my $details = $results{details};
+ my $details = $results->details;
foreach my $overrun ([EMAIL PROTECTED]) {
next unless ref $details->[$overrun-1];
push @{$test{failed}}, $overrun
@@ -426,7 +462,7 @@
$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}});
@@ -560,10 +596,9 @@
if ($tot->{bonus}) {
my($fmt_top, $fmt) = _create_fmts("Passed TODO",$todo_passed);
# Now write to formats
+ $out .= swrite( $fmt_top );
for my $script (sort keys %{$todo_passed||{}}) {
my $Curtest = $todo_passed->{$script};
-
- $out .= swrite( $fmt_top );
$out .= swrite( $fmt, @{ $Curtest }{qw(name estat wstat max
failed canon)} );
}
}
@@ -583,9 +618,9 @@
my($fmt_top, $fmt1, $fmt2) = _create_fmts("Failed Test",$failedtests);
# Now write to formats
+ $out .= swrite( $fmt_top );
for my $script (sort keys %$failedtests) {
my $Curtest = $failedtests->{$script};
- $out .= swrite( $fmt_top );
$out .= swrite( $fmt1, @{ $Curtest }{qw(name estat wstat max
failed canon)} );
$out .= swrite( $fmt2, $Curtest->{canon} );
}
@@ -612,12 +647,12 @@
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;
@@ -635,30 +670,29 @@
$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 ) {
@@ -984,6 +1018,21 @@
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
@@ -1034,8 +1083,6 @@
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.
==== //depot/maint-5.8/perl/lib/Test/Harness/Changes#13 (text) ====
Index: perl/lib/Test/Harness/Changes
--- perl/lib/Test/Harness/Changes#12~28191~ 2006-05-14 04:01:39.000000000
-0700
+++ perl/lib/Test/Harness/Changes 2007-01-28 15:54:52.000000000 -0800
@@ -1,5 +1,39 @@
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
+ pretty crucial bug that I should have fixed long ago. Not having this
+ means that CPANPLUS will install modules even if their tests fail. :-(
+
+2.60 Wed May 24 14:48:44 CDT 2006
+ [FIXES]
+ * Fixed the headers in the summary failure table.
+
+2.58 Sat May 13 22:53:53 CDT 2006
+ No changes. Released to the world with a non-beta number.
+
2.57_06 Sun Apr 23 00:55:43 CDT 2006
[THINGS THAT MIGHT BREAK YOUR CODE]
* Anything that displays a percentage of tests passed has been
==== //depot/maint-5.8/perl/lib/Test/Harness/Results.pm#1 (text) ====
Index: perl/lib/Test/Harness/Results.pm
--- /dev/null 2007-01-16 11:55:45.526841103 -0800
+++ perl/lib/Test/Harness/Results.pm 2007-01-28 15:54:52.000000000 -0800
@@ -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;
==== //depot/maint-5.8/perl/lib/Test/Harness/Straps.pm#17 (text) ====
Index: perl/lib/Test/Harness/Straps.pm
--- perl/lib/Test/Harness/Straps.pm#16~28191~ 2006-05-14 04:01:39.000000000
-0700
+++ perl/lib/Test/Harness/Straps.pm 2007-01-28 15:54:52.000000000 -0800
@@ -9,6 +9,7 @@
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 @@
my $strap = Test::Harness::Straps->new;
# Various ways to interpret a test
- my %results = $strap->analyze($name, [EMAIL PROTECTED]);
- my %results = $strap->analyze_fh($name, $test_filehandle);
- my %results = $strap->analyze_file($test_file);
+ my $results = $strap->analyze($name, [EMAIL PROTECTED]);
+ 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 @@
=head2 $strap->analyze( $name, [EMAIL PROTECTED] )
- my %results = $strap->analyze($name, [EMAIL PROTECTED]);
+ my $results = $strap->analyze($name, [EMAIL PROTECTED]);
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 @@
$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 = ($totals{max} == 0 && defined $totals{skip_all}) ||
- ($totals{max} && $totals{seen} &&
- $totals{max} == $totals{seen} &&
- $totals{max} == $totals{ok});
- $totals{passing} = $passed ? 1 : 0;
+ my $passed =
+ (($results->max == 0) && defined $results->skip_all) ||
+ ($results->max &&
+ $results->seen &&
+ $results->max == $results->seen &&
+ $results->max == $results->ok);
- return %totals;
+ $results->set_passing( $passed ? 1 : 0 );
+
+ return $results;
}
sub _analyze_line {
my $self = shift;
my $line = shift;
- my $totals = shift;
+ my $results = shift;
$self->{line}++;
@@ -160,7 +155,7 @@
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 @@
}
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 @@
};
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 @@
$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 @@
}
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 @@
$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 @@
=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 @@
=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 @@
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 @@
$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 @@
return "";
}
+sub set_callback {
+ my $self = shift;
+ $self->{callback} = shift;
+}
+
+sub callback {
+ my $self = shift;
+ return $self->{callback};
+}
+
1;
==== //depot/maint-5.8/perl/lib/Test/Harness/Util.pm#2 (text) ====
Index: perl/lib/Test/Harness/Util.pm
--- perl/lib/Test/Harness/Util.pm#1~28191~ 2006-05-14 04:01:39.000000000
-0700
+++ perl/lib/Test/Harness/Util.pm 2007-01-28 15:54:52.000000000 -0800
@@ -4,6 +4,7 @@
use vars qw($VERSION);
$VERSION = '0.01';
+use File::Spec;
use Exporter;
use vars qw( @ISA @EXPORT @EXPORT_OK );
==== //depot/maint-5.8/perl/lib/Test/Harness/bin/prove#7 (text) ====
Index: perl/lib/Test/Harness/bin/prove
--- perl/lib/Test/Harness/bin/prove#6~28191~ 2006-05-14 04:01:39.000000000
-0700
+++ perl/lib/Test/Harness/bin/prove 2007-01-28 15:54:52.000000000 -0800
@@ -10,7 +10,7 @@
use File::Spec;
use vars qw( $VERSION );
-$VERSION = "1.04";
+$VERSION = '2.64';
my $shuffle = 0;
my $dry = 0;
@@ -25,10 +25,10 @@
# 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 @@
'H|man' => sub {pod2usage({-verbose => 2}); exit},
'I=s@' => [EMAIL PROTECTED],
'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 @@
# 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 @@
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 @@
--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 @@
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 @@
=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.
==== //depot/maint-5.8/perl/lib/Test/Harness/t/00compile.t#6 (text) ====
Index: perl/lib/Test/Harness/t/00compile.t
--- perl/lib/Test/Harness/t/00compile.t#5~24324~ 2005-04-25
08:04:43.000000000 -0700
+++ perl/lib/Test/Harness/t/00compile.t 2007-01-28 15:54:52.000000000 -0800
@@ -10,7 +10,7 @@
}
}
-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::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 }
==== //depot/maint-5.8/perl/lib/Test/Harness/t/callback.t#5 (text) ====
Index: perl/lib/Test/Harness/t/callback.t
--- perl/lib/Test/Harness/t/callback.t#4~22022~ 2003-12-31 05:41:17.000000000
-0800
+++ perl/lib/Test/Harness/t/callback.t 2007-01-28 15:54:52.000000000 -0800
@@ -52,10 +52,12 @@
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};
==== //depot/maint-5.8/perl/lib/Test/Harness/t/failure.t#1 (text) ====
Index: perl/lib/Test/Harness/t/failure.t
--- /dev/null 2007-01-16 11:55:45.526841103 -0800
+++ perl/lib/Test/Harness/t/failure.t 2007-01-28 15:54:52.000000000 -0800
@@ -0,0 +1,46 @@
+#!/usr/bin/perl -w
+
+BEGIN {
+ if ( $ENV{PERL_CORE} ) {
+ chdir 't';
+ @INC = ('../lib', 'lib');
+ }
+ else {
+ unshift @INC, 't/lib';
+ }
+}
+
+use strict;
+
+use Test::More tests => 6;
+use File::Spec;
+
+BEGIN {
+ use_ok( 'Test::Harness' );
+}
+
+my $died;
+sub prepare_for_death { $died = 0; }
+sub signal_death { $died = 1; }
+
+my $Curdir = File::Spec->curdir;
+my $SAMPLE_TESTS = $ENV{PERL_CORE}
+ ? File::Spec->catdir($Curdir, 'lib', 'sample-tests')
+ : File::Spec->catdir($Curdir, 't', 'sample-tests');
+
+PASSING: {
+ local $SIG{__DIE__} = \&signal_death;
+ prepare_for_death();
+ eval { runtests( File::Spec->catfile( $SAMPLE_TESTS, "simple" ) ) };
+ ok( !$@, "simple lives" );
+ is( $died, 0, "Death never happened" );
+}
+
+FAILING: {
+ local $SIG{__DIE__} = \&signal_death;
+ prepare_for_death();
+ eval { runtests( File::Spec->catfile( $SAMPLE_TESTS, "too_many" ) ) };
+ ok( $@, "$@" );
+ ok( $@ =~ m[Failed 1/1], "too_many dies" );
+ is( $died, 1, "Death happened" );
+}
==== //depot/maint-5.8/perl/lib/Test/Harness/t/prove-switches.t#6 (text) ====
Index: perl/lib/Test/Harness/t/prove-switches.t
--- perl/lib/Test/Harness/t/prove-switches.t#5~28191~ 2006-05-14
04:01:39.000000000 -0700
+++ perl/lib/Test/Harness/t/prove-switches.t 2007-01-28 15:54:52.000000000
-0800
@@ -18,7 +18,7 @@
# 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 @@
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 @@
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 @@
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_L: {
- local $/ = undef;
-
my @actual = qx/$prove -l -Ibongo -Dd/;
my @expected = ( "# \$Test::Harness::Switches: -Ilib -Ibongo\n" );
is_deeply( [EMAIL PROTECTED], [EMAIL PROTECTED], "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( [EMAIL PROTECTED], [EMAIL PROTECTED], "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/} );
+}
==== //depot/maint-5.8/perl/lib/Test/Harness/t/strap-analyze.t#8 (text) ====
Index: perl/lib/Test/Harness/t/strap-analyze.t
--- perl/lib/Test/Harness/t/strap-analyze.t#7~25380~ 2005-09-10
14:03:36.000000000 -0700
+++ perl/lib/Test/Harness/t/strap-analyze.t 2007-01-28 15:54:52.000000000
-0800
@@ -11,7 +11,7 @@
}
use strict;
-use Test::More;
+use Test::More tests => 247;
use File::Spec;
my $Curdir = File::Spec->curdir;
@@ -544,7 +544,6 @@
'wait' => 0
},
);
-plan tests => (keys(%samples) * 5) + 3;
use Test::Harness::Straps;
my @_INC = map { qq{"-I$_"} } @INC;
@@ -568,34 +567,33 @@
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" );
}
==== //depot/maint-5.8/perl/lib/Test/Harness/t/test-harness.t#10 (text) ====
Index: perl/lib/Test/Harness/t/test-harness.t
--- perl/lib/Test/Harness/t/test-harness.t#9~28191~ 2006-05-14
04:01:39.000000000 -0700
+++ perl/lib/Test/Harness/t/test-harness.t 2007-01-28 15:54:52.000000000
-0800
@@ -504,11 +504,12 @@
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 "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 "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 = "";
End of Patch.
