r4179 - in /packages/libtest-harness-perl/trunk: ./ bin/ debian/
lib/Test/ lib/Test/Harness/ t/
gwolf at users.alioth.debian.org
gwolf at users.alioth.debian.org
Sat Oct 28 03:07:09 CEST 2006
Author: gwolf
Date: Sat Oct 28 03:07:08 2006
New Revision: 4179
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=4179
Log:
New upstream version
Added:
packages/libtest-harness-perl/trunk/lib/Test/Harness/Results.pm
- copied unchanged from r4178, packages/libtest-harness-perl/branches/upstream/current/lib/Test/Harness/Results.pm
Modified:
packages/libtest-harness-perl/trunk/Changes
packages/libtest-harness-perl/trunk/MANIFEST
packages/libtest-harness-perl/trunk/META.yml
packages/libtest-harness-perl/trunk/Makefile.PL
packages/libtest-harness-perl/trunk/bin/prove
packages/libtest-harness-perl/trunk/debian/changelog
packages/libtest-harness-perl/trunk/lib/Test/Harness.pm
packages/libtest-harness-perl/trunk/lib/Test/Harness/Straps.pm
packages/libtest-harness-perl/trunk/lib/Test/Harness/Util.pm
packages/libtest-harness-perl/trunk/t/00compile.t
packages/libtest-harness-perl/trunk/t/callback.t
packages/libtest-harness-perl/trunk/t/failure.t
packages/libtest-harness-perl/trunk/t/prove-switches.t
packages/libtest-harness-perl/trunk/t/strap-analyze.t
packages/libtest-harness-perl/trunk/t/test-harness.t
Modified: packages/libtest-harness-perl/trunk/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libtest-harness-perl/trunk/Changes?rev=4179&op=diff
==============================================================================
--- packages/libtest-harness-perl/trunk/Changes (original)
+++ packages/libtest-harness-perl/trunk/Changes Sat Oct 28 03:07:08 2006
@@ -1,4 +1,25 @@
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]
Modified: packages/libtest-harness-perl/trunk/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libtest-harness-perl/trunk/MANIFEST?rev=4179&op=diff
==============================================================================
--- packages/libtest-harness-perl/trunk/MANIFEST (original)
+++ packages/libtest-harness-perl/trunk/MANIFEST Sat Oct 28 03:07:08 2006
@@ -8,6 +8,7 @@
lib/Test/Harness/Assert.pm
lib/Test/Harness/Iterator.pm
lib/Test/Harness/Point.pm
+lib/Test/Harness/Results.pm
lib/Test/Harness/Straps.pm
lib/Test/Harness/TAP.pod
lib/Test/Harness/Util.pm
Modified: packages/libtest-harness-perl/trunk/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libtest-harness-perl/trunk/META.yml?rev=4179&op=diff
==============================================================================
--- packages/libtest-harness-perl/trunk/META.yml (original)
+++ packages/libtest-harness-perl/trunk/META.yml Sat Oct 28 03:07:08 2006
@@ -1,11 +1,11 @@
# http://module-build.sourceforge.net/META-spec.html
#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
name: Test-Harness
-version: 2.62
+version: 2.63_02
version_from: lib/Test/Harness.pm
installdirs: perl
requires:
File::Spec: 0.6
distribution_type: module
-generated_by: ExtUtils::MakeMaker version 6.30
+generated_by: ExtUtils::MakeMaker version 6.17
Modified: packages/libtest-harness-perl/trunk/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libtest-harness-perl/trunk/Makefile.PL?rev=4179&op=diff
==============================================================================
--- packages/libtest-harness-perl/trunk/Makefile.PL (original)
+++ packages/libtest-harness-perl/trunk/Makefile.PL Sat Oct 28 03:07:08 2006
@@ -10,6 +10,7 @@
Harness/Iterator.pm
Harness/Assert.pm
Harness/Point.pm
+ Harness/Results.pm
Harness/Straps.pm
Harness/TAP.pod
Harness/Util.pm
Modified: packages/libtest-harness-perl/trunk/bin/prove
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libtest-harness-perl/trunk/bin/prove?rev=4179&op=diff
==============================================================================
--- packages/libtest-harness-perl/trunk/bin/prove (original)
+++ packages/libtest-harness-perl/trunk/bin/prove Sat Oct 28 03:07:08 2006
@@ -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};
-
-Getopt::Long::Configure( "no_ignore_case" );
-Getopt::Long::Configure( "bundling" );
+unshift @ARGV, split( ' ', $ENV{PROVE_SWITCHES} ) if defined $ENV{PROVE_SWITCHES};
+
+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@' => \@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 @@
# 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.
Modified: packages/libtest-harness-perl/trunk/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libtest-harness-perl/trunk/debian/changelog?rev=4179&op=diff
==============================================================================
--- packages/libtest-harness-perl/trunk/debian/changelog (original)
+++ packages/libtest-harness-perl/trunk/debian/changelog Sat Oct 28 03:07:08 2006
@@ -1,3 +1,9 @@
+libtest-harness-perl (2.64-1) unstable; urgency=low
+
+ * New upstream release
+
+ -- Gunnar Wolf <gwolf at debian.org> Fri, 27 Oct 2006 19:55:54 -0500
+
libtest-harness-perl (2.62-2) unstable; urgency=low
* Diverted Perl's /usr/bin/prove, as this package was uninstallable
Modified: packages/libtest-harness-perl/trunk/lib/Test/Harness.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libtest-harness-perl/trunk/lib/Test/Harness.pm?rev=4179&op=diff
==============================================================================
--- packages/libtest-harness-perl/trunk/lib/Test/Harness.pm (original)
+++ packages/libtest-harness-perl/trunk/lib/Test/Harness.pm Sat Oct 28 03:07:08 2006
@@ -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.62
+Version 2.64
=cut
-$VERSION = '2.62';
+$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;
@@ -333,7 +363,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 ) {
@@ -350,35 +380,36 @@
}
# 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 @@
}
# 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 @@
$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 @@
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 @@
$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 @@
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 @@
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.
Modified: packages/libtest-harness-perl/trunk/lib/Test/Harness/Straps.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libtest-harness-perl/trunk/lib/Test/Harness/Straps.pm?rev=4179&op=diff
==============================================================================
--- packages/libtest-harness-perl/trunk/lib/Test/Harness/Straps.pm (original)
+++ packages/libtest-harness-perl/trunk/lib/Test/Harness/Straps.pm Sat Oct 28 03:07:08 2006
@@ -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, \@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 @@
=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 @@
$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};
-
- 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;
+ $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);
+
+ $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{passing} = 0 unless $? == 0;
+ $results->set_exit( _wait2exit($?) );
+ }
+ $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;
Modified: packages/libtest-harness-perl/trunk/lib/Test/Harness/Util.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libtest-harness-perl/trunk/lib/Test/Harness/Util.pm?rev=4179&op=diff
==============================================================================
--- packages/libtest-harness-perl/trunk/lib/Test/Harness/Util.pm (original)
+++ packages/libtest-harness-perl/trunk/lib/Test/Harness/Util.pm Sat Oct 28 03:07:08 2006
@@ -4,6 +4,7 @@
use vars qw($VERSION);
$VERSION = '0.01';
+use File::Spec;
use Exporter;
use vars qw( @ISA @EXPORT @EXPORT_OK );
Modified: packages/libtest-harness-perl/trunk/t/00compile.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libtest-harness-perl/trunk/t/00compile.t?rev=4179&op=diff
==============================================================================
--- packages/libtest-harness-perl/trunk/t/00compile.t (original)
+++ packages/libtest-harness-perl/trunk/t/00compile.t Sat Oct 28 03:07:08 2006
@@ -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 }
Modified: packages/libtest-harness-perl/trunk/t/callback.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libtest-harness-perl/trunk/t/callback.t?rev=4179&op=diff
==============================================================================
--- packages/libtest-harness-perl/trunk/t/callback.t (original)
+++ packages/libtest-harness-perl/trunk/t/callback.t Sat Oct 28 03:07:08 2006
@@ -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};
Modified: packages/libtest-harness-perl/trunk/t/failure.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libtest-harness-perl/trunk/t/failure.t?rev=4179&op=diff
==============================================================================
--- packages/libtest-harness-perl/trunk/t/failure.t (original)
+++ packages/libtest-harness-perl/trunk/t/failure.t Sat Oct 28 03:07:08 2006
@@ -13,6 +13,7 @@
use strict;
use Test::More tests => 6;
+use File::Spec;
BEGIN {
use_ok( 'Test::Harness' );
@@ -22,10 +23,15 @@
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( "t/sample-tests/simple" ) };
+ eval { runtests( File::Spec->catfile( $SAMPLE_TESTS, "simple" ) ) };
ok( !$@, "simple lives" );
is( $died, 0, "Death never happened" );
}
@@ -33,7 +39,7 @@
FAILING: {
local $SIG{__DIE__} = \&signal_death;
prepare_for_death();
- eval { runtests( "t/sample-tests/too_many" ) };
+ eval { runtests( File::Spec->catfile( $SAMPLE_TESTS, "too_many" ) ) };
ok( $@, "$@" );
ok( $@ =~ m[Failed 1/1], "too_many dies" );
is( $died, 1, "Death happened" );
Modified: packages/libtest-harness-perl/trunk/t/prove-switches.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libtest-harness-perl/trunk/t/prove-switches.t?rev=4179&op=diff
==============================================================================
--- packages/libtest-harness-perl/trunk/t/prove-switches.t (original)
+++ packages/libtest-harness-perl/trunk/t/prove-switches.t Sat Oct 28 03:07:08 2006
@@ -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( \@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/} );
+}
Modified: packages/libtest-harness-perl/trunk/t/strap-analyze.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libtest-harness-perl/trunk/t/strap-analyze.t?rev=4179&op=diff
==============================================================================
--- packages/libtest-harness-perl/trunk/t/strap-analyze.t (original)
+++ packages/libtest-harness-perl/trunk/t/strap-analyze.t Sat Oct 28 03:07:08 2006
@@ -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);
-
- is_deeply($results{details}, $expect->{details}, qq{details of "$test"} );
+ my $results = $strap->analyze_file($test_path);
+
+ 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" );
}
Modified: packages/libtest-harness-perl/trunk/t/test-harness.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libtest-harness-perl/trunk/t/test-harness.t?rev=4179&op=diff
==============================================================================
--- packages/libtest-harness-perl/trunk/t/test-harness.t (original)
+++ packages/libtest-harness-perl/trunk/t/test-harness.t Sat Oct 28 03:07:08 2006
@@ -504,11 +504,12 @@
my $expect = $samples{$test};
# execute_tests() runs the tests but skips the formatting.
- my($totals, $failed);
+ my $test_path = File::Spec->catfile($SAMPLE_TESTS, $test);
+
+ print STDERR "# $test\n" if $ENV{TEST_VERBOSE};
+ my $totals;
+ my $failed;
my $warning = '';
- my $test_path = File::Spec->catfile($SAMPLE_TESTS, $test);
-
- print STDERR "# $test\n" if $ENV{TEST_VERBOSE};
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 = "";
More information about the Pkg-perl-cvs-commits
mailing list