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
);
BEGIN {
- eval "use Time::HiRes 'time'";
+ eval q{use Time::HiRes 'time'};
$has_time_hires = !$@;
}
=head1 VERSION
-Version 2.62
+Version 2.64
=cut
-$VERSION = '2.62';
+$VERSION = '2.64';
# Backwards compatibility for exportable variable names.
*verbose = *Verbose;
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 };
$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;
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 ) {
}
# 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;
}
# 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
$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}});
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;
$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 ) {
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
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.
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
--- /dev/null
+# -*- 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;
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.
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;
=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
$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}++;
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,
}
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}++ ) {
};
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+$/ ) {
$self->{saw_header}++;
- $totals->{max} += $self->{max};
+ $results->inc_max( $self->{max} );
}
elsif ( $self->_is_bail_out($line, \$self->{bailout_reason}) ) {
$linetype = 'bailout';
}
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;
}
$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
=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.
=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.
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;
}
$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.
return "";
}
+sub set_callback {
+ my $self = shift;
+ $self->{callback} = shift;
+}
+
+sub callback {
+ my $self = shift;
+ return $self->{callback};
+}
+
1;
use vars qw($VERSION);
$VERSION = '0.01';
+use File::Spec;
use Exporter;
use vars qw( @ISA @EXPORT @EXPORT_OK );
use File::Spec;
use vars qw( $VERSION );
-$VERSION = "1.04";
+$VERSION = '2.64';
my $shuffle = 0;
my $dry = 0;
# 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,
'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; },
# 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;
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;
--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
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.
=head1 COPYRIGHT
-Copyright 200
5 by Andy Lester C<< <andy at petdance.com> >>.
+Copyright 200
4-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.
}
}
-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}}
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 }
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};
# 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" );
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" );
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" );
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" );
}
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/} );
+}
}
use strict;
-use Test::More;
+use Test::More tests => 247;
use File::Spec;
my $Curdir = File::Spec->curdir;
'wait' => 0
},
);
-plan tests => (keys(%samples) * 5) + 3;
use Test::Harness::Straps;
my @_INC = map { qq{"-I$_"} } @INC;
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" );
}
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);
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" );
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 = "";
projects / platform / upstream / perl.git / commitdiff