diff options
| author | Leon Timmermans <fawaka@gmail.com> | 2022-04-17 18:06:22 +0200 |
|---|---|---|
| committer | James E Keenan <jkeenan@cpan.org> | 2022-04-18 08:12:22 -0400 |
| commit | 34b62aa65c7a985078cbf79c36e529a89db91c3c (patch) | |
| tree | 6a72f86d3894715fb2ae13d7d75930dbe2b53b05 | |
| parent | f00af02bfcdd78a1a7b4c35d19458cf10389ac23 (diff) | |
| download | perl-34b62aa65c7a985078cbf79c36e529a89db91c3c.tar.gz | |
Update Test::Harness to 3.44
57 files changed, 552 insertions, 263 deletions
diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 9a72c0c7e3..7c63a25b43 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -1080,7 +1080,7 @@ use File::Glob qw(:case); }, 'Test::Harness' => { - 'DISTRIBUTION' => 'LEONT/Test-Harness-3.42.tar.gz', + 'DISTRIBUTION' => 'LEONT/Test-Harness-3.44.tar.gz', 'FILES' => q[cpan/Test-Harness], 'EXCLUDED' => [ qr{^examples/}, @@ -1093,11 +1093,6 @@ use File::Glob qw(:case); t/lib/if.pm ), ], - 'CUSTOMIZED' => [ - # https://github.com/Perl-Toolchain-Gang/Test-Harness/pull/103 - # applied but not released - 't/source.t' - ], }, 'Test::Simple' => { diff --git a/cpan/Test-Harness/bin/prove b/cpan/Test-Harness/bin/prove index 3d41db06bd..1bd2733062 100644 --- a/cpan/Test-Harness/bin/prove +++ b/cpan/Test-Harness/bin/prove @@ -207,7 +207,7 @@ new problems have been introduced. =item C<all> -Run all tests in normal order. Multple options may be specified, so to +Run all tests in normal order. Multiple options may be specified, so to run all tests with the failures from last time first: $ prove -b --state=failed,all,save diff --git a/cpan/Test-Harness/lib/App/Prove.pm b/cpan/Test-Harness/lib/App/Prove.pm index a33fe971ff..e2785cbee7 100644 --- a/cpan/Test-Harness/lib/App/Prove.pm +++ b/cpan/Test-Harness/lib/App/Prove.pm @@ -18,11 +18,11 @@ App::Prove - Implements the C<prove> command. =head1 VERSION -Version 3.43 +Version 3.44 =cut -our $VERSION = '3.43'; +our $VERSION = '3.44'; =head1 DESCRIPTION @@ -344,13 +344,13 @@ sub _get_args { # Handle verbose, quiet, really_quiet flags my %verb_map = ( verbose => 1, quiet => -1, really_quiet => -2, ); - my @verb_adj = grep {$_} map { $self->$_() ? $verb_map{$_} : 0 } + my @verb_adj = map { $self->$_() ? $verb_map{$_} : () } keys %verb_map; die "Only one of verbose, quiet or really_quiet should be specified\n" if @verb_adj > 1; - $args{verbosity} = shift @verb_adj || 0; + $args{verbosity} = shift @verb_adj if @verb_adj; for my $a (qw( merge failures comments timer directives normalize )) { $args{$a} = 1 if $self->$a(); diff --git a/cpan/Test-Harness/lib/App/Prove/State.pm b/cpan/Test-Harness/lib/App/Prove/State.pm index 006d4f8712..f3f1125e6f 100644 --- a/cpan/Test-Harness/lib/App/Prove/State.pm +++ b/cpan/Test-Harness/lib/App/Prove/State.pm @@ -25,11 +25,11 @@ App::Prove::State - State storage for the C<prove> command. =head1 VERSION -Version 3.43 +Version 3.44 =cut -our $VERSION = '3.43'; +our $VERSION = '3.44'; =head1 DESCRIPTION diff --git a/cpan/Test-Harness/lib/App/Prove/State/Result.pm b/cpan/Test-Harness/lib/App/Prove/State/Result.pm index fb5e2d52d2..72b625ff9a 100644 --- a/cpan/Test-Harness/lib/App/Prove/State/Result.pm +++ b/cpan/Test-Harness/lib/App/Prove/State/Result.pm @@ -14,11 +14,11 @@ App::Prove::State::Result - Individual test suite results. =head1 VERSION -Version 3.43 +Version 3.44 =cut -our $VERSION = '3.43'; +our $VERSION = '3.44'; =head1 DESCRIPTION diff --git a/cpan/Test-Harness/lib/App/Prove/State/Result/Test.pm b/cpan/Test-Harness/lib/App/Prove/State/Result/Test.pm index f4cddace38..a45911e461 100644 --- a/cpan/Test-Harness/lib/App/Prove/State/Result/Test.pm +++ b/cpan/Test-Harness/lib/App/Prove/State/Result/Test.pm @@ -9,11 +9,11 @@ App::Prove::State::Result::Test - Individual test results. =head1 VERSION -Version 3.43 +Version 3.44 =cut -our $VERSION = '3.43'; +our $VERSION = '3.44'; =head1 DESCRIPTION diff --git a/cpan/Test-Harness/lib/TAP/Base.pm b/cpan/Test-Harness/lib/TAP/Base.pm index 289f093bc6..d3de9339e0 100644 --- a/cpan/Test-Harness/lib/TAP/Base.pm +++ b/cpan/Test-Harness/lib/TAP/Base.pm @@ -12,11 +12,11 @@ and L<TAP::Harness> =head1 VERSION -Version 3.43 +Version 3.44 =cut -our $VERSION = '3.43'; +our $VERSION = '3.44'; use constant GOT_TIME_HIRES => do { eval 'use Time::HiRes qw(time);'; diff --git a/cpan/Test-Harness/lib/TAP/Formatter/Base.pm b/cpan/Test-Harness/lib/TAP/Formatter/Base.pm index a9c0e3b04b..33fdd991f5 100644 --- a/cpan/Test-Harness/lib/TAP/Formatter/Base.pm +++ b/cpan/Test-Harness/lib/TAP/Formatter/Base.pm @@ -58,11 +58,11 @@ TAP::Formatter::Base - Base class for harness output delegates =head1 VERSION -Version 3.43 +Version 3.44 =cut -our $VERSION = '3.43'; +our $VERSION = '3.44'; =head1 DESCRIPTION @@ -387,7 +387,30 @@ sub _summary_test_header { $spaces = ' ' unless $spaces; my $output = $self->_get_output_method($parser); my $wait = $parser->wait; - defined $wait or $wait = '(none)'; + + if (defined $wait) { + my $signum = $wait & 0x7f; + + my $description; + + if ($signum) { + require Config; + my @names = split ' ', $Config::Config{'sig_name'}; + $description = "Signal: $names[$signum]"; + + my $dumped = $wait & 0x80; + $description .= ', dumped core' if $dumped; + } + elsif ($wait != 0) { + $description = sprintf 'exited %d', ($wait >> 8); + } + + $wait .= " ($description)" if $wait != 0; + } + else { + $wait = '(none)'; + } + $self->$output( sprintf "$test$spaces(Wstat: %s Tests: %d Failed: %d)\n", $wait, $parser->tests_run, scalar $parser->failed diff --git a/cpan/Test-Harness/lib/TAP/Formatter/Color.pm b/cpan/Test-Harness/lib/TAP/Formatter/Color.pm index 0f08edfe78..b10f2d5c36 100644 --- a/cpan/Test-Harness/lib/TAP/Formatter/Color.pm +++ b/cpan/Test-Harness/lib/TAP/Formatter/Color.pm @@ -39,11 +39,11 @@ TAP::Formatter::Color - Run Perl test scripts with color =head1 VERSION -Version 3.43 +Version 3.44 =cut -our $VERSION = '3.43'; +our $VERSION = '3.44'; =head1 DESCRIPTION diff --git a/cpan/Test-Harness/lib/TAP/Formatter/Console.pm b/cpan/Test-Harness/lib/TAP/Formatter/Console.pm index 3217099a71..d7df761cf8 100644 --- a/cpan/Test-Harness/lib/TAP/Formatter/Console.pm +++ b/cpan/Test-Harness/lib/TAP/Formatter/Console.pm @@ -11,11 +11,11 @@ TAP::Formatter::Console - Harness output delegate for default console output =head1 VERSION -Version 3.43 +Version 3.44 =cut -our $VERSION = '3.43'; +our $VERSION = '3.44'; =head1 DESCRIPTION diff --git a/cpan/Test-Harness/lib/TAP/Formatter/Console/ParallelSession.pm b/cpan/Test-Harness/lib/TAP/Formatter/Console/ParallelSession.pm index 7f6767c700..867e025e63 100644 --- a/cpan/Test-Harness/lib/TAP/Formatter/Console/ParallelSession.pm +++ b/cpan/Test-Harness/lib/TAP/Formatter/Console/ParallelSession.pm @@ -41,11 +41,11 @@ TAP::Formatter::Console::ParallelSession - Harness output delegate for parallel =head1 VERSION -Version 3.43 +Version 3.44 =cut -our $VERSION = '3.43'; +our $VERSION = '3.44'; =head1 DESCRIPTION diff --git a/cpan/Test-Harness/lib/TAP/Formatter/Console/Session.pm b/cpan/Test-Harness/lib/TAP/Formatter/Console/Session.pm index 8c2f95734d..aba854c4ea 100644 --- a/cpan/Test-Harness/lib/TAP/Formatter/Console/Session.pm +++ b/cpan/Test-Harness/lib/TAP/Formatter/Console/Session.pm @@ -26,11 +26,11 @@ TAP::Formatter::Console::Session - Harness output delegate for default console o =head1 VERSION -Version 3.43 +Version 3.44 =cut -our $VERSION = '3.43'; +our $VERSION = '3.44'; =head1 DESCRIPTION diff --git a/cpan/Test-Harness/lib/TAP/Formatter/File.pm b/cpan/Test-Harness/lib/TAP/Formatter/File.pm index 5a3a55813e..c103e52cce 100644 --- a/cpan/Test-Harness/lib/TAP/Formatter/File.pm +++ b/cpan/Test-Harness/lib/TAP/Formatter/File.pm @@ -13,11 +13,11 @@ TAP::Formatter::File - Harness output delegate for file output =head1 VERSION -Version 3.43 +Version 3.44 =cut -our $VERSION = '3.43'; +our $VERSION = '3.44'; =head1 DESCRIPTION diff --git a/cpan/Test-Harness/lib/TAP/Formatter/File/Session.pm b/cpan/Test-Harness/lib/TAP/Formatter/File/Session.pm index fb7b1829ba..e167bc5cec 100644 --- a/cpan/Test-Harness/lib/TAP/Formatter/File/Session.pm +++ b/cpan/Test-Harness/lib/TAP/Formatter/File/Session.pm @@ -10,11 +10,11 @@ TAP::Formatter::File::Session - Harness output delegate for file output =head1 VERSION -Version 3.43 +Version 3.44 =cut -our $VERSION = '3.43'; +our $VERSION = '3.44'; =head1 DESCRIPTION diff --git a/cpan/Test-Harness/lib/TAP/Formatter/Session.pm b/cpan/Test-Harness/lib/TAP/Formatter/Session.pm index a26048d9d9..59b6afa300 100644 --- a/cpan/Test-Harness/lib/TAP/Formatter/Session.pm +++ b/cpan/Test-Harness/lib/TAP/Formatter/Session.pm @@ -23,11 +23,11 @@ TAP::Formatter::Session - Abstract base class for harness output delegate =head1 VERSION -Version 3.43 +Version 3.44 =cut -our $VERSION = '3.43'; +our $VERSION = '3.44'; =head1 METHODS diff --git a/cpan/Test-Harness/lib/TAP/Harness.pm b/cpan/Test-Harness/lib/TAP/Harness.pm index 1b8ee87a65..54782decf4 100644 --- a/cpan/Test-Harness/lib/TAP/Harness.pm +++ b/cpan/Test-Harness/lib/TAP/Harness.pm @@ -16,11 +16,11 @@ TAP::Harness - Run test scripts with statistics =head1 VERSION -Version 3.43 +Version 3.44 =cut -our $VERSION = '3.43'; +our $VERSION = '3.44'; $ENV{HARNESS_ACTIVE} = 1; $ENV{HARNESS_VERSION} = $VERSION; @@ -555,8 +555,11 @@ sub runtests { $self->_make_callback( 'after_runtests', $aggregate ); }; my $run = sub { - $self->aggregate_tests( $aggregate, @tests ); + my $bailout; + eval { $self->aggregate_tests( $aggregate, @tests ); 1 } + or do { $bailout = $@ || 'unknown_error' }; $finish->(); + die $bailout if defined $bailout; }; if ( $self->trap ) { @@ -595,7 +598,12 @@ sub _after_test { } sub _bailout { - my ( $self, $result ) = @_; + my ( $self, $result, $parser, $session, $aggregate, $job ) = @_; + + $self->finish_parser( $parser, $session ); + $self->_after_test( $aggregate, $job, $parser ); + $job->finish; + my $explanation = $result->explanation; die "FAILED--Further testing stopped" . ( $explanation ? ": $explanation\n" : ".\n" ); @@ -629,7 +637,8 @@ sub _aggregate_parallel { my ( $session, $job ) = @$stash; if ( defined $result ) { $session->result($result); - $self->_bailout($result) if $result->is_bailout; + $self->_bailout($result, $parser, $session, $aggregate, $job ) + if $result->is_bailout; } else { @@ -661,7 +670,7 @@ sub _aggregate_single { # Keep reading until input is exhausted in the hope # of allowing any pending diagnostics to show up. 1 while $parser->next; - $self->_bailout($result); + $self->_bailout($result, $parser, $session, $aggregate, $job ); } } diff --git a/cpan/Test-Harness/lib/TAP/Harness/Env.pm b/cpan/Test-Harness/lib/TAP/Harness/Env.pm index 78e75fb92d..c27f3e5fbb 100644 --- a/cpan/Test-Harness/lib/TAP/Harness/Env.pm +++ b/cpan/Test-Harness/lib/TAP/Harness/Env.pm @@ -7,7 +7,7 @@ use constant IS_VMS => ( $^O eq 'VMS' ); use TAP::Object; use Text::ParseWords qw/shellwords/; -our $VERSION = '3.43'; +our $VERSION = '3.44'; # Get the parts of @INC which are changed from the stock list AND # preserve reordering of stock directories. @@ -126,7 +126,7 @@ TAP::Harness::Env - Parsing harness related environmental variables where approp =head1 VERSION -Version 3.43 +Version 3.44 =head1 SYNOPSIS @@ -189,7 +189,7 @@ C<file.tgz> =item C<< fPackage-With-Dashes >> Set the formatter_class of the harness being run. Since the C<HARNESS_OPTIONS> -is seperated by C<:>, we use C<-> instead. +is separated by C<:>, we use C<-> instead. =back diff --git a/cpan/Test-Harness/lib/TAP/Object.pm b/cpan/Test-Harness/lib/TAP/Object.pm index d3063c2b27..ac7c195179 100644 --- a/cpan/Test-Harness/lib/TAP/Object.pm +++ b/cpan/Test-Harness/lib/TAP/Object.pm @@ -9,11 +9,11 @@ TAP::Object - Base class that provides common functionality to all C<TAP::*> mod =head1 VERSION -Version 3.43 +Version 3.44 =cut -our $VERSION = '3.43'; +our $VERSION = '3.44'; =head1 SYNOPSIS diff --git a/cpan/Test-Harness/lib/TAP/Parser.pm b/cpan/Test-Harness/lib/TAP/Parser.pm index e8d51b12c8..8f0d7e17fc 100644 --- a/cpan/Test-Harness/lib/TAP/Parser.pm +++ b/cpan/Test-Harness/lib/TAP/Parser.pm @@ -27,11 +27,11 @@ TAP::Parser - Parse L<TAP|Test::Harness::TAP> output =head1 VERSION -Version 3.43 +Version 3.44 =cut -our $VERSION = '3.43'; +our $VERSION = '3.44'; my $DEFAULT_TAP_VERSION = 12; my $MAX_TAP_VERSION = 13; diff --git a/cpan/Test-Harness/lib/TAP/Parser/Aggregator.pm b/cpan/Test-Harness/lib/TAP/Parser/Aggregator.pm index 1f4ff5d961..af961e8b73 100644 --- a/cpan/Test-Harness/lib/TAP/Parser/Aggregator.pm +++ b/cpan/Test-Harness/lib/TAP/Parser/Aggregator.pm @@ -12,11 +12,11 @@ TAP::Parser::Aggregator - Aggregate TAP::Parser results =head1 VERSION -Version 3.43 +Version 3.44 =cut -our $VERSION = '3.43'; +our $VERSION = '3.44'; =head1 SYNOPSIS diff --git a/cpan/Test-Harness/lib/TAP/Parser/Grammar.pm b/cpan/Test-Harness/lib/TAP/Parser/Grammar.pm index 0cf4d5b4c7..398396ca13 100644 --- a/cpan/Test-Harness/lib/TAP/Parser/Grammar.pm +++ b/cpan/Test-Harness/lib/TAP/Parser/Grammar.pm @@ -14,11 +14,11 @@ TAP::Parser::Grammar - A grammar for the Test Anything Protocol. =head1 VERSION -Version 3.43 +Version 3.44 =cut -our $VERSION = '3.43'; +our $VERSION = '3.44'; =head1 SYNOPSIS diff --git a/cpan/Test-Harness/lib/TAP/Parser/Iterator.pm b/cpan/Test-Harness/lib/TAP/Parser/Iterator.pm index b516929b05..1ce907f49d 100644 --- a/cpan/Test-Harness/lib/TAP/Parser/Iterator.pm +++ b/cpan/Test-Harness/lib/TAP/Parser/Iterator.pm @@ -11,11 +11,11 @@ TAP::Parser::Iterator - Base class for TAP source iterators =head1 VERSION -Version 3.43 +Version 3.44 =cut -our $VERSION = '3.43'; +our $VERSION = '3.44'; =head1 SYNOPSIS diff --git a/cpan/Test-Harness/lib/TAP/Parser/Iterator/Array.pm b/cpan/Test-Harness/lib/TAP/Parser/Iterator/Array.pm index 3ea348d608..8f8dc4681e 100644 --- a/cpan/Test-Harness/lib/TAP/Parser/Iterator/Array.pm +++ b/cpan/Test-Harness/lib/TAP/Parser/Iterator/Array.pm @@ -11,11 +11,11 @@ TAP::Parser::Iterator::Array - Iterator for array-based TAP sources =head1 VERSION -Version 3.43 +Version 3.44 =cut -our $VERSION = '3.43'; +our $VERSION = '3.44'; =head1 SYNOPSIS diff --git a/cpan/Test-Harness/lib/TAP/Parser/Iterator/Process.pm b/cpan/Test-Harness/lib/TAP/Parser/Iterator/Process.pm index 8e95a44a23..144fc13fcf 100644 --- a/cpan/Test-Harness/lib/TAP/Parser/Iterator/Process.pm +++ b/cpan/Test-Harness/lib/TAP/Parser/Iterator/Process.pm @@ -16,11 +16,11 @@ TAP::Parser::Iterator::Process - Iterator for process-based TAP sources =head1 VERSION -Version 3.43 +Version 3.44 =cut -our $VERSION = '3.43'; +our $VERSION = '3.44'; =head1 SYNOPSIS diff --git a/cpan/Test-Harness/lib/TAP/Parser/Iterator/Stream.pm b/cpan/Test-Harness/lib/TAP/Parser/Iterator/Stream.pm index 305453124f..dab28ea11a 100644 --- a/cpan/Test-Harness/lib/TAP/Parser/Iterator/Stream.pm +++ b/cpan/Test-Harness/lib/TAP/Parser/Iterator/Stream.pm @@ -11,11 +11,11 @@ TAP::Parser::Iterator::Stream - Iterator for filehandle-based TAP sources =head1 VERSION -Version 3.43 +Version 3.44 =cut -our $VERSION = '3.43'; +our $VERSION = '3.44'; =head1 SYNOPSIS diff --git a/cpan/Test-Harness/lib/TAP/Parser/IteratorFactory.pm b/cpan/Test-Harness/lib/TAP/Parser/IteratorFactory.pm index 3529c2f86c..1a61e8260e 100644 --- a/cpan/Test-Harness/lib/TAP/Parser/IteratorFactory.pm +++ b/cpan/Test-Harness/lib/TAP/Parser/IteratorFactory.pm @@ -16,11 +16,11 @@ TAP::Parser::IteratorFactory - Figures out which SourceHandler objects to use fo =head1 VERSION -Version 3.43 +Version 3.44 =cut -our $VERSION = '3.43'; +our $VERSION = '3.44'; =head1 SYNOPSIS diff --git a/cpan/Test-Harness/lib/TAP/Parser/Multiplexer.pm b/cpan/Test-Harness/lib/TAP/Parser/Multiplexer.pm index 164e9af477..328aa49cc0 100644 --- a/cpan/Test-Harness/lib/TAP/Parser/Multiplexer.pm +++ b/cpan/Test-Harness/lib/TAP/Parser/Multiplexer.pm @@ -4,6 +4,7 @@ use strict; use warnings; use IO::Select; +use Errno; use base 'TAP::Object'; @@ -17,11 +18,11 @@ TAP::Parser::Multiplexer - Multiplex multiple TAP::Parsers =head1 VERSION -Version 3.43 +Version 3.44 =cut -our $VERSION = '3.43'; +our $VERSION = '3.44'; =head1 SYNOPSIS @@ -130,9 +131,10 @@ sub _iter { return ( $parser, $stash, $result ); } - unless (@ready) { + until (@ready) { return unless $sel->count; @ready = $sel->can_read; + last if @ready || $! != Errno::EINTR; } my ( $h, $parser, $stash, @handles ) = @{ shift @ready }; diff --git a/cpan/Test-Harness/lib/TAP/Parser/Result.pm b/cpan/Test-Harness/lib/TAP/Parser/Result.pm index 698402ab83..f5d1c211da 100644 --- a/cpan/Test-Harness/lib/TAP/Parser/Result.pm +++ b/cpan/Test-Harness/lib/TAP/Parser/Result.pm @@ -24,11 +24,11 @@ TAP::Parser::Result - Base class for TAP::Parser output objects =head1 VERSION -Version 3.43 +Version 3.44 =cut -our $VERSION = '3.43'; +our $VERSION = '3.44'; =head1 SYNOPSIS diff --git a/cpan/Test-Harness/lib/TAP/Parser/Result/Bailout.pm b/cpan/Test-Harness/lib/TAP/Parser/Result/Bailout.pm index 38ee45853c..528b0194b9 100644 --- a/cpan/Test-Harness/lib/TAP/Parser/Result/Bailout.pm +++ b/cpan/Test-Harness/lib/TAP/Parser/Result/Bailout.pm @@ -11,11 +11,11 @@ TAP::Parser::Result::Bailout - Bailout result token. =head1 VERSION -Version 3.43 +Version 3.44 =cut -our $VERSION = '3.43'; +our $VERSION = '3.44'; =head1 DESCRIPTION diff --git a/cpan/Test-Harness/lib/TAP/Parser/Result/Comment.pm b/cpan/Test-Harness/lib/TAP/Parser/Result/Comment.pm index a07308ea81..20cac16487 100644 --- a/cpan/Test-Harness/lib/TAP/Parser/Result/Comment.pm +++ b/cpan/Test-Harness/lib/TAP/Parser/Result/Comment.pm @@ -11,11 +11,11 @@ TAP::Parser::Result::Comment - Comment result token. =head1 VERSION -Version 3.43 +Version 3.44 =cut -our $VERSION = '3.43'; +our $VERSION = '3.44'; =head1 DESCRIPTION diff --git a/cpan/Test-Harness/lib/TAP/Parser/Result/Plan.pm b/cpan/Test-Harness/lib/TAP/Parser/Result/Plan.pm index 1029694d57..7da449208d 100644 --- a/cpan/Test-Harness/lib/TAP/Parser/Result/Plan.pm +++ b/cpan/Test-Harness/lib/TAP/Parser/Result/Plan.pm @@ -11,11 +11,11 @@ TAP::Parser::Result::Plan - Plan result token. =head1 VERSION -Version 3.43 +Version 3.44 =cut -our $VERSION = '3.43'; +our $VERSION = '3.44'; =head1 DESCRIPTION diff --git a/cpan/Test-Harness/lib/TAP/Parser/Result/Pragma.pm b/cpan/Test-Harness/lib/TAP/Parser/Result/Pragma.pm index 897e0da658..04a0e17851 100644 --- a/cpan/Test-Harness/lib/TAP/Parser/Result/Pragma.pm +++ b/cpan/Test-Harness/lib/TAP/Parser/Result/Pragma.pm @@ -11,11 +11,11 @@ TAP::Parser::Result::Pragma - TAP pragma token. =head1 VERSION -Version 3.43 +Version 3.44 =cut -our $VERSION = '3.43'; +our $VERSION = '3.44'; =head1 DESCRIPTION diff --git a/cpan/Test-Harness/lib/TAP/Parser/Result/Test.pm b/cpan/Test-Harness/lib/TAP/Parser/Result/Test.pm index e2c9781e16..dbe0817484 100644 --- a/cpan/Test-Harness/lib/TAP/Parser/Result/Test.pm +++ b/cpan/Test-Harness/lib/TAP/Parser/Result/Test.pm @@ -11,11 +11,11 @@ TAP::Parser::Result::Test - Test result token. =head1 VERSION -Version 3.43 +Version 3.44 =cut -our $VERSION = '3.43'; +our $VERSION = '3.44'; =head1 DESCRIPTION diff --git a/cpan/Test-Harness/lib/TAP/Parser/Result/Unknown.pm b/cpan/Test-Harness/lib/TAP/Parser/Result/Unknown.pm index cc04c8a385..1c77dc072c 100644 --- a/cpan/Test-Harness/lib/TAP/Parser/Result/Unknown.pm +++ b/cpan/Test-Harness/lib/TAP/Parser/Result/Unknown.pm @@ -11,11 +11,11 @@ TAP::Parser::Result::Unknown - Unknown result token. =head1 VERSION -Version 3.43 +Version 3.44 =cut -our $VERSION = '3.43'; +our $VERSION = '3.44'; =head1 DESCRIPTION diff --git a/cpan/Test-Harness/lib/TAP/Parser/Result/Version.pm b/cpan/Test-Harness/lib/TAP/Parser/Result/Version.pm index 8a2bd7ec44..c73a762004 100644 --- a/cpan/Test-Harness/lib/TAP/Parser/Result/Version.pm +++ b/cpan/Test-Harness/lib/TAP/Parser/Result/Version.pm @@ -11,11 +11,11 @@ TAP::Parser::Result::Version - TAP syntax version token. =head1 VERSION -Version 3.43 +Version 3.44 =cut -our $VERSION = '3.43'; +our $VERSION = '3.44'; =head1 DESCRIPTION diff --git a/cpan/Test-Harness/lib/TAP/Parser/Result/YAML.pm b/cpan/Test-Harness/lib/TAP/Parser/Result/YAML.pm index 17de945ef0..e20975b757 100644 --- a/cpan/Test-Harness/lib/TAP/Parser/Result/YAML.pm +++ b/cpan/Test-Harness/lib/TAP/Parser/Result/YAML.pm @@ -11,11 +11,11 @@ TAP::Parser::Result::YAML - YAML result token. =head1 VERSION -Version 3.43 +Version 3.44 =cut -our $VERSION = '3.43'; +our $VERSION = '3.44'; =head1 DESCRIPTION diff --git a/cpan/Test-Harness/lib/TAP/Parser/ResultFactory.pm b/cpan/Test-Harness/lib/TAP/Parser/ResultFactory.pm index 54d29a265d..894636269b 100644 --- a/cpan/Test-Harness/lib/TAP/Parser/ResultFactory.pm +++ b/cpan/Test-Harness/lib/TAP/Parser/ResultFactory.pm @@ -29,11 +29,11 @@ TAP::Parser::ResultFactory - Factory for creating TAP::Parser output objects =head1 VERSION -Version 3.43 +Version 3.44 =cut -our $VERSION = '3.43'; +our $VERSION = '3.44'; =head2 DESCRIPTION diff --git a/cpan/Test-Harness/lib/TAP/Parser/Scheduler.pm b/cpan/Test-Harness/lib/TAP/Parser/Scheduler.pm index 7e3ddc2c08..3ec5b7ca89 100644 --- a/cpan/Test-Harness/lib/TAP/Parser/Scheduler.pm +++ b/cpan/Test-Harness/lib/TAP/Parser/Scheduler.pm @@ -13,11 +13,11 @@ TAP::Parser::Scheduler - Schedule tests during parallel testing =head1 VERSION -Version 3.43 +Version 3.44 =cut -our $VERSION = '3.43'; +our $VERSION = '3.44'; =head1 SYNOPSIS diff --git a/cpan/Test-Harness/lib/TAP/Parser/Scheduler/Job.pm b/cpan/Test-Harness/lib/TAP/Parser/Scheduler/Job.pm index bfcb0f76b3..ce6ef14a43 100644 --- a/cpan/Test-Harness/lib/TAP/Parser/Scheduler/Job.pm +++ b/cpan/Test-Harness/lib/TAP/Parser/Scheduler/Job.pm @@ -10,11 +10,11 @@ TAP::Parser::Scheduler::Job - A single testing job. =head1 VERSION -Version 3.43 +Version 3.44 =cut -our $VERSION = '3.43'; +our $VERSION = '3.44'; =head1 SYNOPSIS diff --git a/cpan/Test-Harness/lib/TAP/Parser/Scheduler/Spinner.pm b/cpan/Test-Harness/lib/TAP/Parser/Scheduler/Spinner.pm index 29f5c0daf1..4cb974c875 100644 --- a/cpan/Test-Harness/lib/TAP/Parser/Scheduler/Spinner.pm +++ b/cpan/Test-Harness/lib/TAP/Parser/Scheduler/Spinner.pm @@ -10,11 +10,11 @@ TAP::Parser::Scheduler::Spinner - A no-op job. =head1 VERSION -Version 3.43 +Version 3.44 =cut -our $VERSION = '3.43'; +our $VERSION = '3.44'; =head1 SYNOPSIS diff --git a/cpan/Test-Harness/lib/TAP/Parser/Source.pm b/cpan/Test-Harness/lib/TAP/Parser/Source.pm index 74c22cce8b..e91439ac03 100644 --- a/cpan/Test-Harness/lib/TAP/Parser/Source.pm +++ b/cpan/Test-Harness/lib/TAP/Parser/Source.pm @@ -14,11 +14,11 @@ TAP::Parser::Source - a TAP source & meta data about it =head1 VERSION -Version 3.43 +Version 3.44 =cut -our $VERSION = '3.43'; +our $VERSION = '3.44'; =head1 SYNOPSIS diff --git a/cpan/Test-Harness/lib/TAP/Parser/SourceHandler.pm b/cpan/Test-Harness/lib/TAP/Parser/SourceHandler.pm index f80c1ca25c..b41ca01065 100644 --- a/cpan/Test-Harness/lib/TAP/Parser/SourceHandler.pm +++ b/cpan/Test-Harness/lib/TAP/Parser/SourceHandler.pm @@ -12,11 +12,11 @@ TAP::Parser::SourceHandler - Base class for different TAP source handlers =head1 VERSION -Version 3.43 +Version 3.44 =cut -our $VERSION = '3.43'; +our $VERSION = '3.44'; =head1 SYNOPSIS diff --git a/cpan/Test-Harness/lib/TAP/Parser/SourceHandler/Executable.pm b/cpan/Test-Harness/lib/TAP/Parser/SourceHandler/Executable.pm index 0ad412bc49..0aa78ad731 100644 --- a/cpan/Test-Harness/lib/TAP/Parser/SourceHandler/Executable.pm +++ b/cpan/Test-Harness/lib/TAP/Parser/SourceHandler/Executable.pm @@ -16,11 +16,11 @@ TAP::Parser::SourceHandler::Executable - Stream output from an executable TAP so =head1 VERSION -Version 3.43 +Version 3.44 =cut -our $VERSION = '3.43'; +our $VERSION = '3.44'; =head1 SYNOPSIS diff --git a/cpan/Test-Harness/lib/TAP/Parser/SourceHandler/File.pm b/cpan/Test-Harness/lib/TAP/Parser/SourceHandler/File.pm index 48f9821051..e93f786b33 100644 --- a/cpan/Test-Harness/lib/TAP/Parser/SourceHandler/File.pm +++ b/cpan/Test-Harness/lib/TAP/Parser/SourceHandler/File.pm @@ -16,11 +16,11 @@ TAP::Parser::SourceHandler::File - Stream TAP from a text file. =head1 VERSION -Version 3.43 +Version 3.44 =cut -our $VERSION = '3.43'; +our $VERSION = '3.44'; =head1 SYNOPSIS diff --git a/cpan/Test-Harness/lib/TAP/Parser/SourceHandler/Handle.pm b/cpan/Test-Harness/lib/TAP/Parser/SourceHandler/Handle.pm index 751e68aa30..1b9881cd01 100644 --- a/cpan/Test-Harness/lib/TAP/Parser/SourceHandler/Handle.pm +++ b/cpan/Test-Harness/lib/TAP/Parser/SourceHandler/Handle.pm @@ -16,11 +16,11 @@ TAP::Parser::SourceHandler::Handle - Stream TAP from an IO::Handle or a GLOB. =head1 VERSION -Version 3.43 +Version 3.44 =cut -our $VERSION = '3.43'; +our $VERSION = '3.44'; =head1 SYNOPSIS diff --git a/cpan/Test-Harness/lib/TAP/Parser/SourceHandler/Perl.pm b/cpan/Test-Harness/lib/TAP/Parser/SourceHandler/Perl.pm index 26b408a458..ce7a2b427b 100644 --- a/cpan/Test-Harness/lib/TAP/Parser/SourceHandler/Perl.pm +++ b/cpan/Test-Harness/lib/TAP/Parser/SourceHandler/Perl.pm @@ -21,11 +21,11 @@ TAP::Parser::SourceHandler::Perl - Stream TAP from a Perl executable =head1 VERSION -Version 3.43 +Version 3.44 =cut -our $VERSION = '3.43'; +our $VERSION = '3.44'; =head1 SYNOPSIS @@ -62,7 +62,7 @@ won't need to use this module directly. Only votes if $source looks like a file. Casts the following votes: 0.9 if it has a shebang ala "#!...perl" - 0.75 if it has any shebang + 0.3 if it has any shebang 0.8 if it's a .t file 0.9 if it's a .pl file 0.75 if it's in a 't' directory diff --git a/cpan/Test-Harness/lib/TAP/Parser/SourceHandler/RawTAP.pm b/cpan/Test-Harness/lib/TAP/Parser/SourceHandler/RawTAP.pm index 9bf3b272a8..c311935bf8 100644 --- a/cpan/Test-Harness/lib/TAP/Parser/SourceHandler/RawTAP.pm +++ b/cpan/Test-Harness/lib/TAP/Parser/SourceHandler/RawTAP.pm @@ -16,11 +16,11 @@ TAP::Parser::SourceHandler::RawTAP - Stream output from raw TAP in a scalar/arra =head1 VERSION -Version 3.43 +Version 3.44 =cut -our $VERSION = '3.43'; +our $VERSION = '3.44'; =head1 SYNOPSIS diff --git a/cpan/Test-Harness/lib/TAP/Parser/YAMLish/Reader.pm b/cpan/Test-Harness/lib/TAP/Parser/YAMLish/Reader.pm index eafc37aa0c..1c122300a3 100644 --- a/cpan/Test-Harness/lib/TAP/Parser/YAMLish/Reader.pm +++ b/cpan/Test-Harness/lib/TAP/Parser/YAMLish/Reader.pm @@ -5,16 +5,21 @@ use warnings; use base 'TAP::Object'; -our $VERSION = '3.43'; +our $VERSION = '3.44'; + + # No EBCDIC support on early perls +*to_native = (ord "A" == 65 || $] < 5.008) + ? sub { return shift } + : sub { utf8::unicode_to_native(shift) }; # TODO: # Handle blessed object syntax # Printable characters for escapes my %UNESCAPES = ( - z => "\x00", a => "\x07", t => "\x09", - n => "\x0a", v => "\x0b", f => "\x0c", - r => "\x0d", e => "\x1b", '\\' => '\\', + z => "\x00", a => "\a", t => "\t", + n => "\n", v => "\cK", f => "\f", + r => "\r", e => "\e", '\\' => '\\', ); my $QQ_STRING = qr{ " (?:\\. | [^"])* " }x; @@ -22,6 +27,7 @@ my $HASH_LINE = qr{ ^ ($QQ_STRING|\S+) \s* : \s* (?: (.+?) \s* )? $ }x; my $IS_HASH_KEY = qr{ ^ [\w\'\"] }x; my $IS_END_YAML = qr{ ^ \.\.\. \s* $ }x; my $IS_QQ_STRING = qr{ ^ $QQ_STRING $ }x; +my $IS_ARRAY_LINE = qr{ ^ - \s* ($QQ_STRING|\S+) }x; # new() implementation supplied by TAP::Object @@ -117,7 +123,8 @@ sub _read_qq { $str =~ s/\\"/"/gx; $str =~ s/ \\ ( [tartan\\favez] | x([0-9a-fA-F]{2}) ) - / (length($1) > 1) ? pack("H2", $2) : $UNESCAPES{$1} /gex; + / (length($1) > 1) ? pack("H2", to_native($2)) + : $UNESCAPES{$1} /gex; return $str; } @@ -240,9 +247,17 @@ sub _read_hash { my ( $key, $value ) = ( $self->_read_scalar($1), $2 ); $self->_next; + my ( $next_line, $next_indent ) = $self->_peek; + if ( defined $value ) { $hash->{$key} = $self->_read_scalar($value); } + elsif (not defined $value # no explicit undef ("~") given + and $next_indent <= $limit # next line is same or less indentation + and $next_line !~ $IS_ARRAY_LINE) # arrays can start at same indent + { + $hash->{$key} = undef; + } else { $hash->{$key} = $self->_read_nested; } @@ -269,7 +284,7 @@ TAP::Parser::YAMLish::Reader - Read YAMLish data from iterator =head1 VERSION -Version 3.43 +Version 3.44 =head1 SYNOPSIS diff --git a/cpan/Test-Harness/lib/TAP/Parser/YAMLish/Writer.pm b/cpan/Test-Harness/lib/TAP/Parser/YAMLish/Writer.pm index 9d6366c325..1199cf45bf 100644 --- a/cpan/Test-Harness/lib/TAP/Parser/YAMLish/Writer.pm +++ b/cpan/Test-Harness/lib/TAP/Parser/YAMLish/Writer.pm @@ -5,17 +5,26 @@ use warnings; use base 'TAP::Object'; -our $VERSION = '3.43'; +our $VERSION = '3.44'; -my $ESCAPE_CHAR = qr{ [ \x00-\x1f \" ] }x; + # No EBCDIC support on early perls +*from_native = (ord "A" == 65 || $] < 5.008) + ? sub { return shift } + : sub { utf8::native_to_unicode(shift) }; + +my $ESCAPE_CHAR = qr{ [ [:cntrl:] \" ] }x; my $ESCAPE_KEY = qr{ (?: ^\W ) | $ESCAPE_CHAR }x; -my @UNPRINTABLE = qw( - z x01 x02 x03 x04 x05 x06 a - x08 t n v f r x0e x0f - x10 x11 x12 x13 x14 x15 x16 x17 - x18 x19 x1a e x1c x1d x1e x1f -); +my @UNPRINTABLE; +$UNPRINTABLE[$_] = sprintf("x%02x", from_native($_)) for 0 .. ord(" ") - 1; +$UNPRINTABLE[ord "\0"] = 'z'; +$UNPRINTABLE[ord "\a"] = 'a'; +$UNPRINTABLE[ord "\t"] = 't'; +$UNPRINTABLE[ord "\n"] = 'n'; +$UNPRINTABLE[ord "\cK"] = 'v'; +$UNPRINTABLE[ord "\f"] = 'f'; +$UNPRINTABLE[ord "\r"] = 'r'; +$UNPRINTABLE[ord "\e"] = 'e'; # new() implementation supplied by TAP::Object @@ -76,7 +85,7 @@ sub _enc_scalar { if ( $val =~ /$rule/ ) { $val =~ s/\\/\\\\/g; $val =~ s/"/\\"/g; - $val =~ s/ ( [\x00-\x1f] ) / '\\' . $UNPRINTABLE[ ord($1) ] /gex; + $val =~ s/ ( [[:cntrl:]] ) / '\\' . $UNPRINTABLE[ ord($1) ] /gex; return qq{"$val"}; } @@ -146,7 +155,7 @@ TAP::Parser::YAMLish::Writer - Write YAMLish data =head1 VERSION -Version 3.43 +Version 3.44 =head1 SYNOPSIS diff --git a/cpan/Test-Harness/lib/Test/Harness.pm b/cpan/Test-Harness/lib/Test/Harness.pm index 7084d624e1..ea2302bd66 100644 --- a/cpan/Test-Harness/lib/Test/Harness.pm +++ b/cpan/Test-Harness/lib/Test/Harness.pm @@ -31,11 +31,11 @@ Test::Harness - Run Perl standard test scripts with statistics =head1 VERSION -Version 3.43 +Version 3.44 =cut -our $VERSION = '3.43'; +our $VERSION = '3.44'; # Backwards compatibility for exportable variable names. *verbose = *Verbose; @@ -550,7 +550,7 @@ C<file.tgz> =item C<< fPackage-With-Dashes >> Set the formatter_class of the harness being run. Since the C<HARNESS_OPTIONS> -is seperated by C<:>, we use C<-> instead. +is separated by C<:>, we use C<-> instead. =back diff --git a/cpan/Test-Harness/t/compat/test-harness-compat.t b/cpan/Test-Harness/t/compat/test-harness-compat.t index e4d369ac1f..14309163ed 100644 --- a/cpan/Test-Harness/t/compat/test-harness-compat.t +++ b/cpan/Test-Harness/t/compat/test-harness-compat.t @@ -6,6 +6,7 @@ BEGIN { use strict; use warnings; +use Config; # use lib 't/lib'; @@ -16,7 +17,20 @@ use Test::Harness qw(execute_tests); # unset this global when self-testing ('testcover' and etc issue) local $ENV{HARNESS_PERL_SWITCHES}; -my $TEST_DIR = 't/sample-tests'; +my $TEST_DIR = 't/sample-tests'; +my $NoTaintSupport = exists($Config{taint_support}) && !$Config{taint_support}; + +my @test_list = qw(descriptive die die_head_end die_last_minute duplicates + head_end head_fail inc_taint junk_before_plan lone_not_bug + no_nums no_output schwern sequence_misparse shbang_misparse + simple simple_fail skip skip_nomsg skipall skipall_nomsg + stdout_stderr taint todo_inline + todo_misparse too_many vms_nit + ); + +if ($NoTaintSupport) { + @test_list = grep { $_ !~ /taint/ && $_ ne 'shbang_misparse' } @test_list; +} { @@ -44,14 +58,7 @@ my $TEST_DIR = 't/sample-tests'; } }, join( - ',', qw( - descriptive die die_head_end die_last_minute duplicates - head_end head_fail inc_taint junk_before_plan lone_not_bug - no_nums no_output schwern sequence_misparse shbang_misparse - simple simple_fail skip skip_nomsg skipall skipall_nomsg - stdout_stderr taint todo_inline - todo_misparse too_many vms_nit - ) + ',', @test_list ) => { 'failed' => { "$TEST_DIR/die" => { @@ -94,6 +101,7 @@ my $TEST_DIR = 't/sample-tests'; 'name' => "$TEST_DIR/head_fail", 'wstat' => '' }, + $NoTaintSupport ? () : ( "$TEST_DIR/inc_taint" => { 'canon' => 1, 'estat' => 1, @@ -101,7 +109,7 @@ my $TEST_DIR = 't/sample-tests'; 'max' => 1, 'name' => "$TEST_DIR/inc_taint", 'wstat' => '256' - }, + }), "$TEST_DIR/no_nums" => { 'canon' => 3, 'estat' => '', @@ -162,15 +170,15 @@ my $TEST_DIR = 't/sample-tests'; } }, 'totals' => { - 'bad' => 12, + 'bad' => ($NoTaintSupport ? 11 : 12), 'bonus' => 1, - 'files' => 27, - 'good' => 15, - 'max' => 76, - 'ok' => 78, + 'files' => ($NoTaintSupport ? 24 : 27), + 'good' => ($NoTaintSupport ? 13 : 15), + 'max' => ($NoTaintSupport ? 72 : 76), + 'ok' => ($NoTaintSupport ? 75 : 78), 'skipped' => 2, 'sub_skipped' => 2, - 'tests' => 27, + 'tests' => ($NoTaintSupport ? 24 : 27), 'todo' => 2 } }, @@ -316,6 +324,7 @@ my $TEST_DIR = 't/sample-tests'; } }, 'inc_taint' => { + 'skip_if' => sub { $NoTaintSupport }, 'failed' => { "$TEST_DIR/inc_taint" => { 'canon' => 1, @@ -455,6 +464,7 @@ my $TEST_DIR = 't/sample-tests'; } }, 'shbang_misparse' => { + 'skip_if' => sub { $NoTaintSupport }, 'failed' => {}, 'todo' => {}, 'totals' => { @@ -620,9 +630,10 @@ my $TEST_DIR = 't/sample-tests'; } }, 'taint' => { - 'failed' => {}, - 'todo' => {}, - 'totals' => { + 'skip_if' => sub { $NoTaintSupport }, + 'failed' => {}, + 'todo' => {}, + 'totals' => { 'bad' => 0, 'bonus' => 0, 'files' => 1, @@ -636,9 +647,10 @@ my $TEST_DIR = 't/sample-tests'; } }, 'taint_warn' => { - 'failed' => {}, - 'todo' => {}, - 'totals' => { + 'skip_if' => sub { $NoTaintSupport }, + 'failed' => {}, + 'todo' => {}, + 'totals' => { 'bad' => 0, 'bonus' => 0, 'files' => 1, @@ -813,6 +825,10 @@ my $TEST_DIR = 't/sample-tests'; if $skip_if->(); } + if (($test_key eq 'inc_taint' || $test_key eq 'shbang_misparse') && $NoTaintSupport) { + skip "your perl was built without taint support", 4; + } + my @test_names = split( /,/, $test_key ); my @test_files = map { File::Spec->catfile( $TEST_DIR, $_ ) } @test_names; diff --git a/cpan/Test-Harness/t/harness-bailout.t b/cpan/Test-Harness/t/harness-bailout.t index 181e1eb50d..aafbd4df24 100644 --- a/cpan/Test-Harness/t/harness-bailout.t +++ b/cpan/Test-Harness/t/harness-bailout.t @@ -1,55 +1,239 @@ -#!perl +package My::Aggregator; +use strict; +use warnings; + +sub new { + my ($class) = @_; + + my $self = { results => {} }; + return bless( $self, $class ); +} + +sub start {} +sub stop {} +sub add { + my ($self, $description, $parser) = @_; + die "Test '$description' run twice" if exists $self->{results}{$description}; + $self->{results}{$description} = $parser; +} + +1; + +package My::Session; use strict; use warnings; -use File::Spec; -BEGIN { - *CORE::GLOBAL::exit = sub { die '!exit called!' }; +sub new { + my ($class, %args) = @_; + + my $self = { %args }; + return bless( $self, $class ); } -use TAP::Harness; +sub result { + my ($self, $result) = @_; + return $self->{result} = $result || $self->{result}; +} + +sub close_test { + shift->{closed} = 1; +} + +1; + +package My::Formatter; +use strict; +use warnings; + +sub new { + my ($class, $args) = @_; + + my $self = { %$args }; + return bless( $self, $class ); +} + +sub summary { + my ($self, $aggregator, $interrupted) = @_; + + return sprintf( + "My %sinterrupted formatter summary for %s", + $interrupted ? '' : 'un', + ref $aggregator + ); +} +sub verbosity { 0; } +sub prepare {}; +sub open_test { + my ($self, $test_name, $parser) = @_; + + return My::Session->new( name => $test_name, parser => $parser ); +}; + +1; +package My::Multiplexer; +use strict; +use warnings; + +sub new { + my ($class) = @_; + + my $self = { parsers => [] }; + return bless( $self, $class ); +} + +sub add { + my ( $self, $parser, $stash ) = @_; + push @{ $self->{parsers} }, [ $parser, $stash ]; +} + +sub parsers { return scalar @{ shift->{parsers} }; } + +sub next { + my ($self) = @_; + + return unless $self->parsers; + my ($parser, $stash) = @{ $self->{parsers}->[0] }; + my $result = $parser->next; + shift @{ $self->{parsers} } unless $result; + return ( $parser, $stash, $result ); +} + +1; + +package My::Result; +use strict; +use warnings; + +sub new { + my ($class, %args) = @_; + + my $self = { %args }; + return bless( $self, $class ); +} + +sub is_bailout { + return ( (shift->{source} || '') =~ '^bailout' ); +} + +sub explanation { + return shift->{source}; +} + +1; + +package My::Parser; +use strict; +use warnings; + +sub new { + my ($class, $args) = @_; + + my $self = { %$args, nexted => 0 }; + return bless( $self, $class ); +} + +sub next { + my ($self) = @_; + return if $self->{nexted}; + $self->{nexted} = 1; + return My::Result->new( source => $self->{source} ); +} + +sub delete_spool {} + +sub get_time { 0 } + +sub get_times { 0 } + +sub start_time {} + +sub start_times {} + +1; + +package My::Job; +use strict; +use warnings; + +our @finished_jobs; + +sub new { + my ($class, %args) = @_; + + my $self = { %args }; + return bless( $self, $class ); +} +sub description { shift->{description} }; +sub filename { shift->{filename} }; +sub is_spinner {}; +sub as_array_ref { return [ shift->description ] }; +sub finish { push @finished_jobs, shift->filename; } + +1; + +package My::Scheduler; +use strict; +use warnings; + +sub new { + my ($class, %args) = @_; + + my @jobs = map + { My::Job->new( filename => $_->[0], description => $_->[1] ) } + @{ delete( $args{tests} ) || [] }; + + my $self = { %args, jobs => [ @jobs ] }; + return bless( $self, $class ); +} + +sub get_all { @{ shift->{jobs} || [] }; } +sub get_job { shift( @{ shift->{jobs} } ); } +1; + +package main; +use strict; +use warnings; + use Test::More; +use TAP::Harness; -my @jobs = ( - { name => 'sequential', - args => { verbosity => -9 }, - }, - { name => 'parallel', - args => { verbosity => -9, jobs => 2 }, - }, -); +sub create_harness { + my (%arg) = @_; + + return TAP::Harness->new({ + aggregator_class => 'My::Aggregator', + formatter_class => 'My::Formatter', + multiplexer_class => 'My::Multiplexer', + parser_class => 'My::Parser', + scheduler_class => 'My::Scheduler', + jobs => $arg{jobs} || 1, + }); +} -plan tests => @jobs * 2; - -for my $test (@jobs) { - my $name = $test->{name}; - my $args = $test->{args}; - my $harness = TAP::Harness->new($args); - eval { - local ( *OLDERR, *OLDOUT ); - open OLDERR, '>&STDERR' or die $!; - open OLDOUT, '>&STDOUT' or die $!; - my $devnull = File::Spec->devnull; - open STDERR, ">$devnull" or die $!; - open STDOUT, ">$devnull" or die $!; - - $harness->runtests( - File::Spec->catfile( - 't', - 'sample-tests', - 'bailout' - ) - ); - - open STDERR, '>&OLDERR' or die $!; - open STDOUT, '>&OLDOUT' or die $!; - }; - my $err = $@; - unlike $err, qr{!exit called!}, "$name: didn't exit"; - like $err, qr{FAILED--Further testing stopped: GERONIMMMOOOOOO!!!}, - "$name: bailout message"; -} - -# vim:ts=2:sw=2:et:ft=perl +my @after_test_callbacks; + +my $harness = create_harness( jobs => 1 ); +$harness->callback( after_test => sub { push @after_test_callbacks, $_[0] } ); +eval { $harness->runtests( qw( no-bailout bailout not-executed ) ); }; +my $err = $@; +like $err, qr/FAILED--Further testing stopped: bailout/; + +$harness = create_harness( jobs => 2 ); +$harness->callback( after_test => sub { push @after_test_callbacks, $_[0] } ); +eval { $harness->runtests( qw( no-bailout-parallel bailout-parallel not-executed-parallel ) ); }; +$err = $@; +like $err, qr/FAILED--Further testing stopped: bailout/; + +is_deeply( + [ @after_test_callbacks ], + [ [ 'no-bailout' ], [ 'bailout' ], [ 'no-bailout-parallel' ], [ 'bailout-parallel' ], ], + 'After test callbacks called OK' +); +is_deeply( + [ @My::Job::finished_jobs ], + [ 'no-bailout', 'bailout', 'no-bailout-parallel', 'bailout-parallel', ], + 'Jobs finished OK' +); +done_testing(); diff --git a/cpan/Test-Harness/t/harness.t b/cpan/Test-Harness/t/harness.t index e86c455f5f..1fa94cff75 100644 --- a/cpan/Test-Harness/t/harness.t +++ b/cpan/Test-Harness/t/harness.t @@ -10,6 +10,9 @@ use warnings; use Test::More; use IO::c55Capture; +use Config; +use POSIX; + use TAP::Harness; # This is done to prevent the colors environment variables from @@ -24,7 +27,7 @@ my $HARNESS = 'TAP::Harness'; my $source_tests = 't/source_tests'; my $sample_tests = 't/sample-tests'; -plan tests => 132; +plan tests => 133; # note that this test will always pass when run through 'prove' ok $ENV{HARNESS_ACTIVE}, 'HARNESS_ACTIVE env variable should be set'; @@ -521,6 +524,17 @@ for my $test_args ( get_arg_sets() ) { $expected_summary = qr/^Files=1, Tests=2, +\d+ wallclock secs/; is_deeply \@output, \@expected, '... and the output should be correct'; + SKIP: { + skip "No SIGSEGV on $^O", 1 if $^O eq 'MSWin32' or $Config::Config{'sig_name'} !~ m/SEGV/; + + @output = (); + _runtests( $harness_failures, "$sample_tests/segfault" ); + + my $out_str = join q<>, @output; + + like( $out_str, qr<SEGV>, 'SIGSEGV is parsed out' ); + } + #XXXX } diff --git a/cpan/Test-Harness/t/prove.t b/cpan/Test-Harness/t/prove.t index 75718f62cb..1dd6541239 100644 --- a/cpan/Test-Harness/t/prove.t +++ b/cpan/Test-Harness/t/prove.t @@ -171,8 +171,7 @@ BEGIN { # START PLAN expect => {}, runlog => [ [ '_runtests', - { verbosity => 0, - show_count => 1, + { show_count => 1, }, 'one', 'two', 'three' ] @@ -206,7 +205,7 @@ BEGIN { # START PLAN }, runlog => [ [ '_runtests', - { verbosity => 0, show_count => 1 }, + { show_count => 1 }, 'one', 'two', 'three' ] @@ -223,7 +222,6 @@ BEGIN { # START PLAN runlog => [ [ '_runtests', { lib => mabs( [ 'blib/lib', 'blib/arch' ] ), - verbosity => 0, show_count => 1, }, 'one', 'two', 'three' @@ -242,7 +240,6 @@ BEGIN { # START PLAN runlog => [ [ '_runtests', { color => 1, - verbosity => 0, show_count => 1, }, 'one', 'two', 'three' @@ -261,7 +258,6 @@ BEGIN { # START PLAN runlog => [ [ '_runtests', { directives => 1, - verbosity => 0, show_count => 1, }, 'one', 'two', 'three' @@ -279,7 +275,6 @@ BEGIN { # START PLAN runlog => [ [ '_runtests', { exec => [1], - verbosity => 0, show_count => 1, }, 'one', 'two', 'three' @@ -297,7 +292,6 @@ BEGIN { # START PLAN runlog => [ [ '_runtests', { failures => 1, - verbosity => 0, show_count => 1, }, 'one', 'two', 'three' @@ -316,7 +310,6 @@ BEGIN { # START PLAN runlog => [ [ '_runtests', { formatter_class => 'TAP::Harness', - verbosity => 0, show_count => 1, }, 'one', 'two', 'three' @@ -335,7 +328,6 @@ BEGIN { # START PLAN runlog => [ [ '_runtests', { lib => mabs( [qw( four five six )] ), - verbosity => 0, show_count => 1, }, 'one', 'two', 'three' @@ -353,7 +345,6 @@ BEGIN { # START PLAN runlog => [ [ '_runtests', { lib => mabs( ['lib'] ), - verbosity => 0, show_count => 1, }, 'one', 'two', 'three' @@ -371,7 +362,6 @@ BEGIN { # START PLAN runlog => [ [ '_runtests', { merge => 1, - verbosity => 0, show_count => 1, }, 'one', 'two', 'three' @@ -389,7 +379,6 @@ BEGIN { # START PLAN runlog => [ [ '_runtests', { errors => 1, - verbosity => 0, show_count => 1, }, 'one', 'two', 'three' @@ -440,8 +429,7 @@ BEGIN { # START PLAN }, runlog => [ [ '_runtests', - { verbosity => 0, - show_count => 1, + { show_count => 1, }, 'one', 'two', 'three' ] @@ -457,8 +445,7 @@ BEGIN { # START PLAN }, runlog => [ [ '_runtests', - { verbosity => 0, - show_count => 1, + { show_count => 1, }, 'three', 'two', 'one' ] @@ -475,8 +462,7 @@ BEGIN { # START PLAN }, runlog => [ [ '_runtests', - { verbosity => 0, - show_count => 1, + { show_count => 1, }, 'xxxone', 'xxxtwo', 'xxxthree' @@ -494,7 +480,6 @@ BEGIN { # START PLAN runlog => [ [ '_runtests', { switches => ['-T'], - verbosity => 0, show_count => 1, }, 'one', 'two', 'three' @@ -512,7 +497,6 @@ BEGIN { # START PLAN runlog => [ [ '_runtests', { switches => ['-t'], - verbosity => 0, show_count => 1, }, 'one', 'two', 'three' @@ -547,7 +531,6 @@ BEGIN { # START PLAN runlog => [ [ '_runtests', { switches => ['-W'], - verbosity => 0, show_count => 1, }, 'one', 'two', 'three' @@ -565,7 +548,6 @@ BEGIN { # START PLAN runlog => [ [ '_runtests', { switches => ['-w'], - verbosity => 0, show_count => 1, }, 'one', 'two', 'three' @@ -619,7 +601,6 @@ BEGIN { # START PLAN runlog => [ [ '_runtests', { failures => 1, - verbosity => 0, show_count => 1, }, $dummy_test @@ -636,7 +617,6 @@ BEGIN { # START PLAN runlog => [ [ '_runtests', { failures => 1, - verbosity => 0, show_count => 1, }, $dummy_test @@ -653,7 +633,6 @@ BEGIN { # START PLAN runlog => [ [ '_runtests', { lib => mabs( ['lib'] ), - verbosity => 0, show_count => 1, }, $dummy_test @@ -670,7 +649,6 @@ BEGIN { # START PLAN runlog => [ [ '_runtests', { lib => mabs( ['lib'] ), - verbosity => 0, show_count => 1, }, $dummy_test @@ -687,7 +665,6 @@ BEGIN { # START PLAN runlog => [ [ '_runtests', { lib => mabs( [ 'blib/lib', 'blib/arch' ] ), - verbosity => 0, show_count => 1, }, $dummy_test @@ -704,7 +681,6 @@ BEGIN { # START PLAN runlog => [ [ '_runtests', { lib => mabs( [ 'blib/lib', 'blib/arch' ] ), - verbosity => 0, show_count => 1, }, $dummy_test @@ -720,8 +696,7 @@ BEGIN { # START PLAN expect => { shuffle => 1 }, runlog => [ [ '_runtests', - { verbosity => 0, - show_count => 1, + { show_count => 1, }, "xxx$dummy_test" ] @@ -736,8 +711,7 @@ BEGIN { # START PLAN expect => { shuffle => 1 }, runlog => [ [ '_runtests', - { verbosity => 0, - show_count => 1, + { show_count => 1, }, "xxx$dummy_test" ] @@ -753,7 +727,6 @@ BEGIN { # START PLAN runlog => [ [ '_runtests', { color => 1, - verbosity => 0, show_count => 1, }, $dummy_test @@ -769,8 +742,7 @@ BEGIN { # START PLAN expect => { recurse => 1 }, runlog => [ [ '_runtests', - { verbosity => 0, - show_count => 1, + { show_count => 1, }, $dummy_test ] @@ -785,8 +757,7 @@ BEGIN { # START PLAN expect => { recurse => 1 }, runlog => [ [ '_runtests', - { verbosity => 0, - show_count => 1, + { show_count => 1, }, $dummy_test ] @@ -801,8 +772,7 @@ BEGIN { # START PLAN expect => { backwards => 1 }, runlog => [ [ '_runtests', - { verbosity => 0, - show_count => 1, + { show_count => 1, }, reverse @dummy_tests ] @@ -820,7 +790,6 @@ BEGIN { # START PLAN runlog => [ [ '_runtests', { errors => 1, - verbosity => 0, show_count => 1, }, $dummy_test @@ -839,7 +808,6 @@ BEGIN { # START PLAN runlog => [ [ '_runtests', { errors => 1, - verbosity => 0, show_count => 1, }, $dummy_test @@ -920,7 +888,6 @@ BEGIN { # START PLAN runlog => [ [ '_runtests', { merge => 1, - verbosity => 0, show_count => 1, }, $dummy_test @@ -937,7 +904,6 @@ BEGIN { # START PLAN runlog => [ [ '_runtests', { merge => 1, - verbosity => 0, show_count => 1, }, $dummy_test @@ -954,7 +920,6 @@ BEGIN { # START PLAN runlog => [ [ '_runtests', { directives => 1, - verbosity => 0, show_count => 1, }, $dummy_test @@ -973,7 +938,6 @@ BEGIN { # START PLAN runlog => [ [ '_runtests', { exec => [], - verbosity => 0, show_count => 1, }, $dummy_test @@ -991,7 +955,6 @@ BEGIN { # START PLAN runlog => [ [ '_runtests', { exec => ['-s'], - verbosity => 0, show_count => 1, }, $dummy_test @@ -1009,7 +972,6 @@ BEGIN { # START PLAN runlog => [ [ '_runtests', { exec => [qw(/foo/bar/perl -Ilib)], - verbosity => 0, show_count => 1, }, $dummy_test @@ -1027,7 +989,6 @@ BEGIN { # START PLAN runlog => [ [ '_runtests', { exec => [], - verbosity => 0, show_count => 1, }, $dummy_test @@ -1041,8 +1002,7 @@ BEGIN { # START PLAN expect => { extensions => ['.wango'] }, runlog => [ [ '_runtests', - { verbosity => 0, - show_count => 1, + { show_count => 1, }, ] ], @@ -1054,8 +1014,7 @@ BEGIN { # START PLAN expect => { extensions => [ '.foo', '.bar' ] }, runlog => [ [ '_runtests', - { verbosity => 0, - show_count => 1, + { show_count => 1, }, ] ], @@ -1075,7 +1034,6 @@ BEGIN { # START PLAN { sources => { MyCustom => {}, }, - verbosity => 0, show_count => 1, }, $dummy_test @@ -1122,7 +1080,6 @@ BEGIN { # START PLAN sep => 'foo=bar', }, }, - verbosity => 0, show_count => 1, }, $dummy_test @@ -1147,8 +1104,7 @@ BEGIN { # START PLAN plan => 1, runlog => [ [ '_runtests', - { verbosity => 0, - show_count => 1, + { show_count => 1, }, $dummy_test ] @@ -1175,8 +1131,7 @@ BEGIN { # START PLAN plan => 1, runlog => [ [ '_runtests', - { verbosity => 0, - show_count => 1, + { show_count => 1, }, $dummy_test ] @@ -1199,8 +1154,7 @@ BEGIN { # START PLAN plan => 1, runlog => [ [ '_runtests', - { verbosity => 0, - show_count => 1, + { show_count => 1, }, $dummy_test ] @@ -1239,8 +1193,7 @@ BEGIN { # START PLAN plan => 5, runlog => [ [ '_runtests', - { verbosity => 0, - show_count => 1, + { show_count => 1, }, $dummy_test ] @@ -1263,8 +1216,7 @@ BEGIN { # START PLAN plan => 1, runlog => [ [ '_runtests', - { verbosity => 0, - show_count => 1, + { show_count => 1, }, $dummy_test ] diff --git a/cpan/Test-Harness/t/regression.t b/cpan/Test-Harness/t/regression.t index 2daa375f81..e67bb6a09e 100644 --- a/cpan/Test-Harness/t/regression.t +++ b/cpan/Test-Harness/t/regression.t @@ -20,8 +20,9 @@ use constant NOT_ZERO => "__NOT_ZERO__"; use TAP::Parser; -my $IsVMS = $^O eq 'VMS'; -my $IsWin32 = $^O eq 'MSWin32'; +my $IsVMS = $^O eq 'VMS'; +my $IsWin32 = $^O eq 'MSWin32'; +my $NoTaintSupport = exists($Config{taint_support}) && !$Config{taint_support}; my $SAMPLE_TESTS = File::Spec->catdir( File::Spec->curdir, @@ -1361,6 +1362,7 @@ my %samples = ( parse_errors => [], 'exit' => 0, wait => 0, + skip_if => sub {$NoTaintSupport}, version => 12, }, 'die' => { diff --git a/cpan/Test-Harness/t/sample-tests/segfault b/cpan/Test-Harness/t/sample-tests/segfault index c5670a42b5..15899db7e3 100644 --- a/cpan/Test-Harness/t/sample-tests/segfault +++ b/cpan/Test-Harness/t/sample-tests/segfault @@ -2,4 +2,4 @@ print "1..1\n"; print "ok 1\n"; -kill 11, $$; +kill 'SEGV', $$; diff --git a/cpan/Test-Harness/t/yamlish.t b/cpan/Test-Harness/t/yamlish.t index 8d4a7d08b3..07c3683869 100644 --- a/cpan/Test-Harness/t/yamlish.t +++ b/cpan/Test-Harness/t/yamlish.t @@ -138,6 +138,74 @@ BEGIN { six => '6' }, }, + { name => 'Edge cases for hash start vs. undefined scalar 1', + in => [ + '---', + 'one:', + ' five: 5', + ' two:', + ' four: 4', + ' three: 3', + 'six: 6', + '...', + ], + out => { + one => { two => undef, three => '3', four => '4', five => '5' }, + six => '6' + }, + }, + { name => 'Edge cases for hash start vs. undefined scalar 2', + in => [ + '---', + 'one:', + ' five: 5', + ' two: ~', + ' four: 4', + ' three: 3', + 'six: 6', + '...', + ], + out => { + one => { two => undef, three => '3', four => '4', five => '5' }, + six => '6' + }, + }, + { name => 'Edge cases for hash start vs. undefined scalar 3', + in => [ + '---', + 'two:', + 'four: 4', + 'three: 3', + '...', + ], + out => { + two => undef, three => '3', four => '4', + }, + }, + { name => 'Edge cases for hash start vs. undefined scalar 4', + in => [ + '---', + 'two:', + ' four: 4', + ' three: 3', + '...', + ], + out => { + two => { three => '3', four => '4' }, + }, + }, + { name => 'Edge cases for hash start vs. undefined scalar 5', + in => [ + '---', + 'two:', + '- four: 4', + '- three: 3', + '...', + ], + out => { + two => [ { four => '4' }, { three => '3' } ], + }, + }, { name => 'Space after colon', in => [ '---', 'spog: ', ' - 1', ' - 2', '...' ], out => { spog => [ 1, 2 ] }, @@ -451,7 +519,7 @@ BEGIN { ], name => 'Regression: inline_nested_hash' }, - { name => "Unprintables", + { name => "Unprintables", # This is an ASCII centric test in => [ "---", "- \"\\z\\x01\\x02\\x03\\x04\\x05\\x06\\a\\x08\\t\\n\\v\\f\\r\\x0e\\x0f\"", |