'abigail' => 'Abigail <abigail@abigail.be>',
'ams' => 'Abhijit Menon-Sen <ams@cpan.org>',
'andk' => 'Andreas J. Koenig <andk@cpan.org>',
- 'andya' => 'Andy Armstrong <andya@cpan.org>',
+ 'andya' => 'Andy Armstrong <andy@hexten.net>',
'arandal' => 'Allison Randal <allison@perl.org>',
'audreyt' => 'Audrey Tang <cpan@audreyt.org>',
'avar' => 'Ævar Arnfjörð Bjarmason <avar@cpan.org>',
=head1 VERSION
-Version 3.05
+Version 3.06
=cut
-$VERSION = '3.05';
+$VERSION = '3.06';
=head1 DESCRIPTION
=head1 VERSION
-Version 3.05
+Version 3.06
=cut
-$VERSION = '3.05';
+$VERSION = '3.06';
=head1 DESCRIPTION
$self->_select( order => sub { $_->{elapsed} } );
},
new => sub {
- $self->_select(
- order => sub {
- ( $_->{total_failures} || 0 )
- + ( $_->{total_passes} || 0 );
- }
- );
+ $self->_select( order => sub { -$_->{mtime} } );
},
old => sub {
- $self->_select(
- order => sub {
- -( ( $_->{total_failures} || 0 )
- + ( $_->{total_passes} || 0 ) );
- }
- );
+ $self->_select( order => sub { $_->{mtime} } );
},
save => sub {
$self->{should_save}++;
# Select
for my $test ( sort keys %$tests ) {
+ next unless -f $test;
local $_ = $tests->{$test};
push @got, $test if $where->();
}
}
push @tests,
- sort -d $arg
+ sort -d $arg
? $recurse
? $self->_expand_dir_recursive($arg)
: glob( File::Spec->catfile( $arg, '*.t' ) )
# $writer->write( $self->{tests} || {}, \*FH );
close FH;
$self->_regen_seq;
+ $self->_prune_and_stamp;
$self->{_}->{generation}++;
}
+sub _prune_and_stamp {
+ my $self = shift;
+ for my $name ( keys %{ $self->{_}->{tests} || {} } ) {
+ if ( my @stat = stat $name ) {
+ $self->{_}->{tests}->{$name}->{mtime} = $stat[9];
+ }
+ else {
+ delete $self->{_}->{tests}->{$name};
+ }
+ }
+}
+
sub _regen_seq {
my $self = shift;
for my $rec ( values %{ $self->{_}->{tests} || {} } ) {
=head1 VERSION
-Version 3.05
+Version 3.06
=cut
-$VERSION = '3.05';
+$VERSION = '3.06';
my $GOT_TIME_HIRES;
=head1 VERSION
-Version 3.05
+Version 3.06
=cut
-$VERSION = '3.05';
+$VERSION = '3.06';
=head1 DESCRIPTION
errors => sub { shift; shift },
color => sub { shift; shift },
jobs => sub { shift; shift },
- stdout => sub {
+ stdout => sub {
my ( $self, $ref ) = @_;
$self->_croak("option 'stdout' needs a filehandle")
unless ( ref $ref || '' ) eq 'GLOB'
=head1 VERSION
-Version 3.05
+Version 3.06
=cut
-$VERSION = '3.05';
+$VERSION = '3.06';
=head1 DESCRIPTION
$self->_printed_summary_header(0);
my ($parser) = $aggregate->parsers($test);
$self->_output_summary_failure(
- 'failed', " Failed test number(s): ",
- $test, $parser
+ 'failed',
+ [ ' Failed test: ', ' Failed tests: ' ],
+ $test, $parser
);
$self->_output_summary_failure(
'todo_passed',
# ugly hack. Must rethink this :(
my $output = $method eq 'failed' ? '_failure_output' : '_output';
- if ( $parser->$method() ) {
+ if ( my @r = $parser->$method() ) {
$self->_summary_test_header( $test, $parser );
- $self->$output($name);
- my @results = $self->_balanced_range( 40, $parser->$method() );
+ my ( $singular, $plural )
+ = 'ARRAY' eq ref $name ? @$name : ( $name, $name );
+ $self->$output( @r == 1 ? $singular : $plural );
+ my @results = $self->_balanced_range( 40, @r );
$self->$output( sprintf "%s\n" => shift @results );
my $spaces = ' ' x 16;
while (@results) {
=head1 VERSION
-Version 3.05
+Version 3.06
=cut
-$VERSION = '3.05';
+$VERSION = '3.06';
=head1 DESCRIPTION
=head1 VERSION
-Version 3.05
+Version 3.06
=cut
-$VERSION = '3.05';
+$VERSION = '3.06';
=head1 DESCRIPTION
=head1 VERSION
-Version 3.05
+Version 3.06
=cut
-$VERSION = '3.05';
+$VERSION = '3.06';
$ENV{HARNESS_ACTIVE} = 1;
$ENV{HARNESS_VERSION} = $VERSION;
while ( defined( my $result = $parser->next ) ) {
$session->result($result);
- exit 1 if $result->is_bailout;
+ if ( $result->is_bailout ) {
+
+ # Keep reading until input is exhausted in the hope
+ # of allowing any pending diagnostics to show up.
+ 1 while $parser->next;
+ exit 1;
+ }
}
$self->finish_parser( $parser, $session );
=head1 VERSION
-Version 3.05
+Version 3.06
=cut
-$VERSION = '3.05';
+$VERSION = '3.06';
my $DEFAULT_TAP_VERSION = 12;
my $MAX_TAP_VERSION = 13;
sub has_problems {
my $self = shift;
- return $self->failed
+ return
+ $self->failed
|| $self->parse_errors
|| $self->wait
|| $self->exit;
=head1 VERSION
-Version 3.05
+Version 3.06
=cut
-$VERSION = '3.05';
+$VERSION = '3.06';
=head1 SYNOPSIS
sub all_passed {
my $self = shift;
- return $self->total
+ return
+ $self->total
&& $self->total == $self->passed
&& !$self->has_errors;
}
sub has_errors {
my $self = shift;
- return $self->failed
+ return
+ $self->failed
|| $self->parse_errors
|| $self->exit
|| $self->wait;
=head1 VERSION
-Version 3.05
+Version 3.06
=cut
-$VERSION = '3.05';
+$VERSION = '3.06';
=head1 DESCRIPTION
=head1 VERSION
-Version 3.05
+Version 3.06
=cut
-$VERSION = '3.05';
+$VERSION = '3.06';
=head1 SYNOPSIS
=head1 VERSION
-Version 3.05
+Version 3.06
=cut
-$VERSION = '3.05';
+$VERSION = '3.06';
=head1 SYNOPSIS
=head1 VERSION
-Version 3.05
+Version 3.06
=cut
-$VERSION = '3.05';
+$VERSION = '3.06';
=head1 SYNOPSIS
=head1 VERSION
-Version 3.05
+Version 3.06
=cut
-$VERSION = '3.05';
+$VERSION = '3.06';
=head1 SYNOPSIS
=head1 VERSION
-Version 3.05
+Version 3.06
=cut
-$VERSION = '3.05';
+$VERSION = '3.06';
=head1 SYNOPSIS
=head1 VERSION
-Version 3.05
+Version 3.06
=cut
-$VERSION = '3.05';
+$VERSION = '3.06';
=head2 DESCRIPTION
=head1 VERSION
-Version 3.05
+Version 3.06
=cut
-$VERSION = '3.05';
+$VERSION = '3.06';
=head1 DESCRIPTION
=head1 VERSION
-Version 3.05
+Version 3.06
=cut
-$VERSION = '3.05';
+$VERSION = '3.06';
=head1 DESCRIPTION
=head1 VERSION
-Version 3.05
+Version 3.06
=cut
-$VERSION = '3.05';
+$VERSION = '3.06';
=head1 DESCRIPTION
=head1 VERSION
-Version 3.05
+Version 3.06
=cut
-$VERSION = '3.05';
+$VERSION = '3.06';
=head1 DESCRIPTION
=head1 VERSION
-Version 3.05
+Version 3.06
=cut
-$VERSION = '3.05';
+$VERSION = '3.06';
=head1 DESCRIPTION
=head1 VERSION
-Version 3.05
+Version 3.06
=cut
-$VERSION = '3.05';
+$VERSION = '3.06';
=head1 DESCRIPTION
=head1 VERSION
-Version 3.05
+Version 3.06
=cut
-$VERSION = '3.05';
+$VERSION = '3.06';
=head1 DESCRIPTION
=head1 VERSION
-Version 3.05
+Version 3.06
=cut
-$VERSION = '3.05';
+$VERSION = '3.06';
=head1 DESCRIPTION
=head1 VERSION
-Version 3.05
+Version 3.06
=cut
-$VERSION = '3.05';
+$VERSION = '3.06';
=head1 DESCRIPTION
sub _get_perl {
my $proto = shift;
- return $ENV{HARNESS_PERL} if defined $ENV{HARNESS_PERL};
+ return $ENV{HARNESS_PERL} if defined $ENV{HARNESS_PERL};
return Win32::GetShortPathName($^X) if IS_WIN32;
return $^X;
}
use vars qw{$VERSION};
-$VERSION = '3.05';
+$VERSION = '3.06';
# TODO:
# Handle blessed object syntax
=head1 VERSION
-Version 3.05
+Version 3.06
=head1 SYNOPSIS
use vars qw{$VERSION};
-$VERSION = '3.05';
+$VERSION = '3.06';
my $ESCAPE_CHAR = qr{ [ \x00-\x1f \" ] }x;
=head1 VERSION
-Version 3.05
+Version 3.06
=head1 SYNOPSIS
=head1 VERSION
-Version 3.05
+Version 3.06
=cut
-$VERSION = '3.05';
+$VERSION = '3.06';
# Backwards compatibility for exportable variable names.
*verbose = *Verbose;
Revision history for Test-Harness
+3.06
+ - Skip t/unicode.t if PERL_UNICODE set. Fixes #31731.
+ Thanks Lukas.
+ - App::Prove::State no longer complains about tests that
+ are deleted.
+ - --state=new and --state=old now consider the modification time
+ of test scripts.
+
3.05 2007-12-09
- Skip unicode.t if Encode unavailable
- Support for .proverc files.
Run only the tests that failed on the last run.
# Run all tests
-e $ prove -b --state=save
+ $ prove -b --state=save
# Run failures
$ prove -b --state=failed
't/source_tests/harness_failure (Wstat: 0 Tests: 2 Failed: 1)',
'[[reset]]',
'[[red]]',
- 'Failed test number(s):',
+ 'Failed test:',
'[[reset]]',
'[[red]]',
'2',
'Test Summary Report',
'-------------------',
't/source_tests/harness_failure (Wstat: 0 Tests: 2 Failed: 1)',
- 'Failed test number(s):',
+ 'Failed test:',
'2',
);
'Test Summary Report',
'-------------------',
't/source_tests/harness_failure (Wstat: 0 Tests: 2 Failed: 1)',
- 'Failed test number(s):',
+ 'Failed test:',
'2',
);
't/source_tests/harness_badtap (Wstat: 0 Tests: 2 Failed: 1)',
'[[reset]]',
'[[red]]',
- 'Failed test number(s):',
+ 'Failed test:',
'[[reset]]',
'[[red]]',
'2',
'Test Summary Report',
'-------------------',
't/source_tests/harness_failure (Wstat: 0 Tests: 2 Failed: 1)',
- 'Failed test number(s):',
+ 'Failed test:',
'2',
);
#!/usr/bin/perl -w
-
BEGIN {
- if( $ENV{PERL_CORE} ) {
+ if ( $ENV{PERL_CORE} ) {
chdir 't';
- @INC = ('../lib', 'lib');
+ @INC = ( '../lib', 'lib' );
}
else {
- use lib 't/lib';
+ use lib 't/lib';
}
}
use strict;
use NoFork;
-require ($ENV{PERL_CORE} && '../lib/Test/Harness/') . 't/multiplexer.t';
+require(
+ ( $ENV{PERL_CORE} ? '../lib/Test/Harness/' : '' ) . 't/multiplexer.t' );
wait => 0,
version => 12,
},
-
- # switches => {
- # results => [
- # { is_plan => TRUE,
- # passed => TRUE,
- # is_ok => TRUE,
- # raw => '1..1',
- # tests_planned => 1,
- # },
- # { actual_passed => TRUE,
- # is_actual_ok => TRUE,
- # passed => TRUE,
- # is_ok => TRUE,
- # is_test => TRUE,
- # has_skip => FALSE,
- # has_todo => FALSE,
- # number => 1,
- # description => "",
- # explanation => '',
- # },
- # ],
- # __ARGS__ => { switches => ['-Mstrict'] },
- # plan => '1..1',
- # passed => [1],
- # actual_passed => [1],
- # failed => [],
- # actual_failed => [],
- # todo => [],
- # todo_passed => [],
- # skipped => [],
- # good_plan => TRUE,
- # is_good_plan => TRUE,
- # tests_planned => 1,
- # tests_run => TRUE,
- # parse_errors => [],
- # 'exit' => 0,
- # wait => 0,
- # version => 12,
- # },
+ switches => {
+ results => [
+ { is_plan => TRUE,
+ passed => TRUE,
+ is_ok => TRUE,
+ raw => '1..1',
+ tests_planned => 1,
+ },
+ { actual_passed => TRUE,
+ is_actual_ok => TRUE,
+ passed => TRUE,
+ is_ok => TRUE,
+ is_test => TRUE,
+ has_skip => FALSE,
+ has_todo => FALSE,
+ number => 1,
+ description => "",
+ explanation => '',
+ },
+ ],
+ __ARGS__ => { switches => ['-Mstrict'] },
+ plan => '1..1',
+ passed => [1],
+ actual_passed => [1],
+ failed => [],
+ actual_failed => [],
+ todo => [],
+ todo_passed => [],
+ skipped => [],
+ good_plan => TRUE,
+ is_good_plan => TRUE,
+ tests_planned => 1,
+ tests_run => TRUE,
+ parse_errors => [],
+ 'exit' => 0,
+ wait => 0,
+ version => 12,
+ },
inc_taint => {
results => [
{ is_plan => TRUE,
#!/usr/bin/perl -w
-use strict;
-use lib 't/lib';
+BEGIN {
+ if ( $ENV{PERL_CORE} ) {
+ chdir 't';
+ @INC = '../lib';
+ }
+ else {
+ unshift @INC, 't/lib';
+ }
+}
+use strict;
use Test::More;
use App::Prove::State;
-my @schedule = (
+sub mn {
+ my $pfx = $ENV{PERL_CORE} ? '../lib/Test/Harness/' : '';
+ return map {"$pfx$_"} @_;
+}
- # last => sub {
- # failed => sub {
- # passed => sub {
- # all => sub {
- # todo => sub {
- # hot => sub {
- # save => sub {
- # adrian => sub {
+my @schedule = (
{ options => 'all',
get_tests_args => [],
expect => [
{ options => 'old',
get_tests_args => [],
expect => [
- 't/compat/env.t',
- 't/compat/failure.t',
+ 't/source.t',
't/compat/inc_taint.t',
't/compat/version.t',
- 't/source.t',
't/yamlish-writer.t',
+ 't/compat/failure.t',
+ 't/compat/env.t',
],
},
{ options => 'new',
get_tests_args => [],
expect => [
- 't/source.t',
- 't/yamlish-writer.t',
- 't/compat/inc_taint.t',
- 't/compat/version.t',
't/compat/env.t',
't/compat/failure.t',
+ 't/yamlish-writer.t',
+ 't/compat/version.t',
+ 't/compat/inc_taint.t',
+ 't/source.t',
],
},
);
$options = [$options] unless 'ARRAY' eq ref $options;
$state->apply_switch(@$options);
- my @got = $state->get_tests( @{ $test->{get_tests_args} } );
-
- unless ( is_deeply \@got, $test->{expect}, "$desc: order OK" ) {
+ my @got = $state->get_tests( @{ $test->{get_tests_args} } );
+ my @expect = mn( @{ $test->{expect} } );
+ unless ( is_deeply \@got, \@expect, "$desc: order OK" ) {
use Data::Dumper;
- diag( Dumper( { got => \@got, want => $test->{expect} } ) );
+ diag( Dumper( { got => \@got, want => \@expect } ) );
}
}
return {
'generation' => '51',
'tests' => {
- 't/compat/failure.t' => {
+ mn('t/compat/failure.t') => {
'last_result' => '0',
'last_run_time' => '1196371471.57738',
'last_pass_time' => '1196371471.57738',
'seq' => '1549',
'gen' => '51',
'elapsed' => 0.1230,
- 'last_todo' => '1'
+ 'last_todo' => '1',
+ 'mtime' => 1196285623,
},
- 't/yamlish-writer.t' => {
+ mn('t/yamlish-writer.t') => {
'last_result' => '0',
'last_run_time' => '1196371480.5761',
'last_pass_time' => '1196371480.5761',
'seq' => '1578',
'gen' => '49',
'elapsed' => 12.2983,
- 'last_todo' => '0'
+ 'last_todo' => '0',
+ 'mtime' => 1196285400,
},
- 't/compat/env.t' => {
+ mn('t/compat/env.t') => {
'last_result' => '0',
'last_run_time' => '1196371471.42967',
'last_pass_time' => '1196371471.42967',
'seq' => '1548',
'gen' => '52',
'elapsed' => 3.1290,
- 'last_todo' => '0'
+ 'last_todo' => '0',
+ 'mtime' => 1196285739,
},
- 't/compat/version.t' => {
+ mn('t/compat/version.t') => {
'last_result' => '2',
'last_run_time' => '1196371472.96476',
'last_pass_time' => '1196371472.96476',
'seq' => '1555',
'gen' => '51',
'elapsed' => 0.2363,
- 'last_todo' => '4'
+ 'last_todo' => '4',
+ 'mtime' => 1196285239,
},
- 't/compat/inc_taint.t' => {
+ mn('t/compat/inc_taint.t') => {
'last_result' => '3',
'last_run_time' => '1196371471.89682',
'last_pass_time' => '1196371471.89682',
'seq' => '1551',
'gen' => '51',
'elapsed' => 1.6938,
- 'last_todo' => '0'
+ 'last_todo' => '0',
+ 'mtime' => 1196185639,
},
- 't/source.t' => {
+ mn('t/source.t') => {
'last_result' => '0',
'last_run_time' => '1196371479.72508',
'last_pass_time' => '1196371479.72508',
'seq' => '1570',
'gen' => '51',
'elapsed' => 0.0143,
- 'last_todo' => '0'
+ 'last_todo' => '0',
+ 'mtime' => 1186285639,
},
}
};
plan skip_all => "unicode on Perl < 5.8.0"
unless $] > 5.008;
+ plan skip_all => "PERL_UNICODE set"
+ if $ENV{PERL_UNICODE};
+
eval "use File::Temp";
plan skip_all => "File::Temp unavailable"
if $@;
__END__
+Used to exercise the "empty test" case.