summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/TAP
diff options
context:
space:
mode:
authorKarl Berry <karl@freefriends.org>2015-04-26 22:16:26 +0000
committerKarl Berry <karl@freefriends.org>2015-04-26 22:16:26 +0000
commit342e672574c4e67d510e46ab6acd0e21a7d0cf54 (patch)
tree79e04202d08c0404bbd780bd26c1e34710e539b6 /Master/tlpkg/tlperl/lib/TAP
parentbe2706af7c57a0ef0f4d4e9f684ca4ef74922a82 (diff)
(tl)perl 5.20.2 for windows, from siep
git-svn-id: svn://tug.org/texlive/trunk@37064 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/tlperl/lib/TAP')
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Base.pm15
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Formatter/Base.pm11
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Formatter/Color.pm8
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Formatter/Console.pm27
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Formatter/Console/ParallelSession.pm11
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Formatter/Console/Session.pm10
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Formatter/File.pm10
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Formatter/File/Session.pm11
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Formatter/Session.pm10
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Harness.pm58
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Harness/Beyond.pod422
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Harness/Env.pm149
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Object.pm13
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Parser.pm42
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Parser/Aggregator.pm10
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Parser/Grammar.pm14
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Parser/Iterator.pm13
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Parser/Iterator/Array.pm10
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Parser/Iterator/Process.pm17
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Parser/Iterator/Stream.pm10
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Parser/IteratorFactory.pm15
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Parser/Multiplexer.pm11
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Parser/Result.pm13
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Parser/Result/Bailout.pm9
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Parser/Result/Comment.pm9
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Parser/Result/Plan.pm9
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Parser/Result/Pragma.pm9
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Parser/Result/Test.pm11
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Parser/Result/Unknown.pm11
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Parser/Result/Version.pm9
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Parser/Result/YAML.pm9
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Parser/ResultFactory.pm38
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Parser/Scheduler.pm152
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Parser/Scheduler/Job.pm34
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Parser/Scheduler/Spinner.pm16
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Parser/Source.pm12
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Parser/SourceHandler.pm17
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Parser/SourceHandler/Executable.pm12
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Parser/SourceHandler/File.pm9
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Parser/SourceHandler/Handle.pm9
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Parser/SourceHandler/Perl.pm39
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Parser/SourceHandler/RawTAP.pm9
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Parser/Utils.pm72
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Parser/YAMLish/Reader.pm9
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Parser/YAMLish/Writer.pm9
45 files changed, 1033 insertions, 390 deletions
diff --git a/Master/tlpkg/tlperl/lib/TAP/Base.pm b/Master/tlpkg/tlperl/lib/TAP/Base.pm
index ff8da427c8b..02f8b5e48ce 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Base.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Base.pm
@@ -1,11 +1,9 @@
package TAP::Base;
use strict;
-use vars qw($VERSION @ISA);
+use warnings;
-use TAP::Object;
-
-@ISA = qw(TAP::Object);
+use base 'TAP::Object';
=head1 NAME
@@ -14,11 +12,11 @@ and L<TAP::Harness>
=head1 VERSION
-Version 3.26
+Version 3.30
=cut
-$VERSION = '3.26';
+our $VERSION = '3.30';
use constant GOT_TIME_HIRES => do {
eval 'use Time::HiRes qw(time);';
@@ -29,10 +27,7 @@ use constant GOT_TIME_HIRES => do {
package TAP::Whatever;
- use TAP::Base;
-
- use vars qw($VERSION @ISA);
- @ISA = qw(TAP::Base);
+ use base 'TAP::Base';
# ... later ...
diff --git a/Master/tlpkg/tlperl/lib/TAP/Formatter/Base.pm b/Master/tlpkg/tlperl/lib/TAP/Formatter/Base.pm
index af7b3fca304..1bb357d9bd0 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Formatter/Base.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Formatter/Base.pm
@@ -1,17 +1,14 @@
package TAP::Formatter::Base;
use strict;
-use TAP::Base ();
+use warnings;
+use base 'TAP::Base';
use POSIX qw(strftime);
-use vars qw($VERSION @ISA);
-
my $MAX_ERRORS = 5;
my %VALIDATION_FOR;
BEGIN {
- @ISA = qw(TAP::Base);
-
%VALIDATION_FOR = (
directives => sub { shift; shift },
verbosity => sub { shift; shift },
@@ -61,11 +58,11 @@ TAP::Formatter::Base - Base class for harness output delegates
=head1 VERSION
-Version 3.26
+Version 3.30
=cut
-$VERSION = '3.26';
+our $VERSION = '3.30';
=head1 DESCRIPTION
diff --git a/Master/tlpkg/tlperl/lib/TAP/Formatter/Color.pm b/Master/tlpkg/tlperl/lib/TAP/Formatter/Color.pm
index 16d6f79d45f..d22752e12ee 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Formatter/Color.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Formatter/Color.pm
@@ -1,11 +1,11 @@
package TAP::Formatter::Color;
use strict;
-use vars qw($VERSION @ISA);
+use warnings;
use constant IS_WIN32 => ( $^O =~ /^(MS)?Win32$/ );
-@ISA = qw(TAP::Object);
+use base 'TAP::Object';
my $NO_COLOR;
@@ -71,11 +71,11 @@ TAP::Formatter::Color - Run Perl test scripts with color
=head1 VERSION
-Version 3.26
+Version 3.30
=cut
-$VERSION = '3.26';
+our $VERSION = '3.30';
=head1 DESCRIPTION
diff --git a/Master/tlpkg/tlperl/lib/TAP/Formatter/Console.pm b/Master/tlpkg/tlperl/lib/TAP/Formatter/Console.pm
index 0a9115f9e48..5ac9fa1a16e 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Formatter/Console.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Formatter/Console.pm
@@ -1,24 +1,21 @@
package TAP::Formatter::Console;
use strict;
-use TAP::Formatter::Base ();
+use warnings;
+use base 'TAP::Formatter::Base';
use POSIX qw(strftime);
-use vars qw($VERSION @ISA);
-
-@ISA = qw(TAP::Formatter::Base);
-
=head1 NAME
TAP::Formatter::Console - Harness output delegate for default console output
=head1 VERSION
-Version 3.26
+Version 3.30
=cut
-$VERSION = '3.26';
+our $VERSION = '3.30';
=head1 DESCRIPTION
@@ -70,16 +67,28 @@ sub _set_colors {
}
}
+sub _failure_color {
+ my ($self) = @_;
+
+ return $ENV{'HARNESS_SUMMARY_COLOR_FAIL'} || 'red';
+}
+
+sub _success_color {
+ my ($self) = @_;
+
+ return $ENV{'HARNESS_SUMMARY_COLOR_SUCCESS'} || 'green';
+}
+
sub _output_success {
my ( $self, $msg ) = @_;
- $self->_set_colors('green');
+ $self->_set_colors( $self->_success_color() );
$self->_output($msg);
$self->_set_colors('reset');
}
sub _failure_output {
my $self = shift;
- $self->_set_colors('red');
+ $self->_set_colors( $self->_failure_color() );
my $out = join '', @_;
my $has_newline = chomp $out;
$self->_output($out);
diff --git a/Master/tlpkg/tlperl/lib/TAP/Formatter/Console/ParallelSession.pm b/Master/tlpkg/tlperl/lib/TAP/Formatter/Console/ParallelSession.pm
index 873903988d0..f9cd7af5964 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Formatter/Console/ParallelSession.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Formatter/Console/ParallelSession.pm
@@ -1,15 +1,14 @@
package TAP::Formatter::Console::ParallelSession;
use strict;
+use warnings;
use File::Spec;
use File::Path;
-use TAP::Formatter::Console::Session;
use Carp;
-use constant WIDTH => 72; # Because Eric says
-use vars qw($VERSION @ISA);
+use base 'TAP::Formatter::Console::Session';
-@ISA = qw(TAP::Formatter::Console::Session);
+use constant WIDTH => 72; # Because Eric says
my %shared;
@@ -42,11 +41,11 @@ TAP::Formatter::Console::ParallelSession - Harness output delegate for parallel
=head1 VERSION
-Version 3.26
+Version 3.30
=cut
-$VERSION = '3.26';
+our $VERSION = '3.30';
=head1 DESCRIPTION
diff --git a/Master/tlpkg/tlperl/lib/TAP/Formatter/Console/Session.pm b/Master/tlpkg/tlperl/lib/TAP/Formatter/Console/Session.pm
index f5b3dc12295..16ce97153d9 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Formatter/Console/Session.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Formatter/Console/Session.pm
@@ -1,11 +1,9 @@
package TAP::Formatter::Console::Session;
use strict;
-use TAP::Formatter::Session;
+use warnings;
-use vars qw($VERSION @ISA);
-
-@ISA = qw(TAP::Formatter::Session);
+use base 'TAP::Formatter::Session';
my @ACCESSOR;
@@ -28,11 +26,11 @@ TAP::Formatter::Console::Session - Harness output delegate for default console o
=head1 VERSION
-Version 3.26
+Version 3.30
=cut
-$VERSION = '3.26';
+our $VERSION = '3.30';
=head1 DESCRIPTION
diff --git a/Master/tlpkg/tlperl/lib/TAP/Formatter/File.pm b/Master/tlpkg/tlperl/lib/TAP/Formatter/File.pm
index 8d94a2cff7a..2e72d914ba8 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Formatter/File.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Formatter/File.pm
@@ -1,13 +1,11 @@
package TAP::Formatter::File;
use strict;
-use TAP::Formatter::Base ();
+use warnings;
use TAP::Formatter::File::Session;
use POSIX qw(strftime);
-use vars qw($VERSION @ISA);
-
-@ISA = qw(TAP::Formatter::Base);
+use base 'TAP::Formatter::Base';
=head1 NAME
@@ -15,11 +13,11 @@ TAP::Formatter::File - Harness output delegate for file output
=head1 VERSION
-Version 3.26
+Version 3.30
=cut
-$VERSION = '3.26';
+our $VERSION = '3.30';
=head1 DESCRIPTION
diff --git a/Master/tlpkg/tlperl/lib/TAP/Formatter/File/Session.pm b/Master/tlpkg/tlperl/lib/TAP/Formatter/File/Session.pm
index 9b61cab3670..4719f22b1b6 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Formatter/File/Session.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Formatter/File/Session.pm
@@ -1,11 +1,8 @@
package TAP::Formatter::File::Session;
use strict;
-use TAP::Formatter::Session;
-
-use vars qw($VERSION @ISA);
-
-@ISA = qw(TAP::Formatter::Session);
+use warnings;
+use base 'TAP::Formatter::Session';
=head1 NAME
@@ -13,11 +10,11 @@ TAP::Formatter::File::Session - Harness output delegate for file output
=head1 VERSION
-Version 3.26
+Version 3.30
=cut
-$VERSION = '3.26';
+our $VERSION = '3.30';
=head1 DESCRIPTION
diff --git a/Master/tlpkg/tlperl/lib/TAP/Formatter/Session.pm b/Master/tlpkg/tlperl/lib/TAP/Formatter/Session.pm
index 081ca9aec95..120b4953c36 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Formatter/Session.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Formatter/Session.pm
@@ -1,11 +1,9 @@
package TAP::Formatter::Session;
use strict;
-use TAP::Base;
+use warnings;
-use vars qw($VERSION @ISA);
-
-@ISA = qw(TAP::Base);
+use base 'TAP::Base';
my @ACCESSOR;
@@ -25,11 +23,11 @@ TAP::Formatter::Session - Abstract base class for harness output delegate
=head1 VERSION
-Version 3.26
+Version 3.30
=cut
-$VERSION = '3.26';
+our $VERSION = '3.30';
=head1 METHODS
diff --git a/Master/tlpkg/tlperl/lib/TAP/Harness.pm b/Master/tlpkg/tlperl/lib/TAP/Harness.pm
index c60d1d98014..53d8d18bea6 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Harness.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Harness.pm
@@ -1,17 +1,14 @@
package TAP::Harness;
use strict;
+use warnings;
use Carp;
use File::Spec;
use File::Path;
use IO::Handle;
-use TAP::Base;
-
-use vars qw($VERSION @ISA);
-
-@ISA = qw(TAP::Base);
+use base 'TAP::Base';
=head1 NAME
@@ -19,11 +16,11 @@ TAP::Harness - Run test scripts with statistics
=head1 VERSION
-Version 3.26
+Version 3.30
=cut
-$VERSION = '3.26';
+our $VERSION = '3.30';
$ENV{HARNESS_ACTIVE} = 1;
$ENV{HARNESS_VERSION} = $VERSION;
@@ -248,7 +245,7 @@ I<NEW to 3.18>.
If set, C<sources> must be a hashref containing the names of the
L<TAP::Parser::SourceHandler>s to load and/or configure. The values are a
-hash of configuration that will be accessible to to the source handlers via
+hash of configuration that will be accessible to the source handlers via
L<TAP::Parser::Source/config_for>.
For example:
@@ -330,20 +327,37 @@ run only one test at a time.
=item * C<rules>
-A reference to a hash of rules that control which tests may be
-executed in parallel. This is an experimental feature and the
-interface may change.
-
- $harness->rules(
- { par => [
- { seq => '../ext/DB_File/t/*' },
- { seq => '../ext/IO_Compress_Zlib/t/*' },
- { seq => '../lib/CPANPLUS/*' },
- { seq => '../lib/ExtUtils/t/*' },
- '*'
- ]
- }
- );
+A reference to a hash of rules that control which tests may be executed in
+parallel. If no rules are declared, all tests are eligible for being run in
+parallel. Here some simple examples. For the full details of the data structure
+and the related glob-style pattern matching, see
+L<TAP::Parser::Scheduler/"Rules data structure">.
+
+ # Run all tests in sequence, except those starting with "p"
+ $harness->rules({
+ par => 't/p*.t'
+ });
+
+ # Run all tests in parallel, except those starting with "p"
+ $harness->rules({
+ seq => [
+ { seq => 't/p*.t' },
+ { par => '**' },
+ ],
+ });
+
+ # Run some startup tests in sequence, then some parallel tests than some
+ # teardown tests in sequence.
+ $harness->rules({
+ seq => [
+ { seq => 't/startup/*.t' },
+ { par => ['t/a/*.t','t/b/*.t','t/c/*.t'], }
+ { seq => 't/shutdown/*.t' },
+ ],
+
+ });
+
+This is an experimental feature and the interface may change.
=item * C<stdout>
diff --git a/Master/tlpkg/tlperl/lib/TAP/Harness/Beyond.pod b/Master/tlpkg/tlperl/lib/TAP/Harness/Beyond.pod
new file mode 100644
index 00000000000..b70564ec956
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/TAP/Harness/Beyond.pod
@@ -0,0 +1,422 @@
+=head1 NAME
+
+Test::Harness::Beyond - Beyond make test
+
+=head1 Beyond make test
+
+Test::Harness is responsible for running test scripts, analysing
+their output and reporting success or failure. When I type
+F<make test> (or F<./Build test>) for a module, Test::Harness is usually
+used to run the tests (not all modules use Test::Harness but the
+majority do).
+
+To start exploring some of the features of Test::Harness I need to
+switch from F<make test> to the F<prove> command (which ships with
+Test::Harness). For the following examples I'll also need a recent
+version of Test::Harness installed; 3.14 is current as I write.
+
+For the examples I'm going to assume that we're working with a
+'normal' Perl module distribution. Specifically I'll assume that
+typing F<make> or F<./Build> causes the built, ready-to-install module
+code to be available below ./blib/lib and ./blib/arch and that
+there's a directory called 't' that contains our tests. Test::Harness
+isn't hardwired to that configuration but it saves me from explaining
+which files live where for each example.
+
+Back to F<prove>; like F<make test> it runs a test suite - but it
+provides far more control over which tests are executed, in what
+order and how their results are reported. Typically F<make test>
+runs all the test scripts below the 't' directory. To do the same
+thing with prove I type:
+
+ prove -rb t
+
+The switches here are -r to recurse into any directories below 't'
+and -b which adds ./blib/lib and ./blib/arch to Perl's include path
+so that the tests can find the code they will be testing. If I'm
+testing a module of which an earlier version is already installed
+I need to be careful about the include path to make sure I'm not
+running my tests against the installed version rather than the new
+one that I'm working on.
+
+Unlike F<make test>, typing F<prove> doesn't automatically rebuild
+my module. If I forget to make before prove I will be testing against
+older versions of those files - which inevitably leads to confusion.
+I either get into the habit of typing
+
+ make && prove -rb t
+
+or - if I have no XS code that needs to be built I use the modules
+below F<lib> instead
+
+ prove -Ilib -r t
+
+So far I've shown you nothing that F<make test> doesn't do. Let's
+fix that.
+
+=head2 Saved State
+
+If I have failing tests in a test suite that consists of more than
+a handful of scripts and takes more than a few seconds to run it
+rapidly becomes tedious to run the whole test suite repeatedly as
+I track down the problems.
+
+I can tell prove just to run the tests that are failing like this:
+
+ prove -b t/this_fails.t t/so_does_this.t
+
+That speeds things up but I have to make a note of which tests are
+failing and make sure that I run those tests. Instead I can use
+prove's --state switch and have it keep track of failing tests for
+me. First I do a complete run of the test suite and tell prove to
+save the results:
+
+ prove -rb --state=save t
+
+That stores a machine readable summary of the test run in a file
+called '.prove' in the current directory. If I have failures I can
+then run just the failing scripts like this:
+
+ prove -b --state=failed
+
+I can also tell prove to save the results again so that it updates
+its idea of which tests failed:
+
+ prove -b --state=failed,save
+
+As soon as one of my failing tests passes it will be removed from
+the list of failed tests. Eventually I fix them all and prove can
+find no failing tests to run:
+
+ Files=0, Tests=0, 0 wallclock secs ( 0.00 usr + 0.00 sys = 0.00 CPU)
+ Result: NOTESTS
+
+As I work on a particular part of my module it's most likely that
+the tests that cover that code will fail. I'd like to run the whole
+test suite but have it prioritize these 'hot' tests. I can tell
+prove to do this:
+
+ prove -rb --state=hot,save t
+
+All the tests will run but those that failed most recently will be
+run first. If no tests have failed since I started saving state all
+tests will run in their normal order. This combines full test
+coverage with early notification of failures.
+
+The --state switch supports a number of options; for example to run
+failed tests first followed by all remaining tests ordered by the
+timestamps of the test scripts - and save the results - I can use
+
+ prove -rb --state=failed,new,save t
+
+See the prove documentation (type prove --man) for the full list
+of state options.
+
+When I tell prove to save state it writes a file called '.prove'
+('_prove' on Windows) in the current directory. It's a YAML document
+so it's quite easy to write tools of your own that work on the saved
+test state - but the format isn't officially documented so it might
+change without (much) warning in the future.
+
+=head2 Parallel Testing
+
+If my tests take too long to run I may be able to speed them up by
+running multiple test scripts in parallel. This is particularly
+effective if the tests are I/O bound or if I have multiple CPU
+cores. I tell prove to run my tests in parallel like this:
+
+ prove -rb -j 9 t
+
+The -j switch enables parallel testing; the number that follows it
+is the maximum number of tests to run in parallel. Sometimes tests
+that pass when run sequentially will fail when run in parallel. For
+example if two different test scripts use the same temporary file
+or attempt to listen on the same socket I'll have problems running
+them in parallel. If I see unexpected failures I need to check my
+tests to work out which of them are trampling on the same resource
+and rename temporary files or add locks as appropriate.
+
+To get the most performance benefit I want to have the test scripts
+that take the longest to run start first - otherwise I'll be waiting
+for the one test that takes nearly a minute to complete after all
+the others are done. I can use the --state switch to run the tests
+in slowest to fastest order:
+
+ prove -rb -j 9 --state=slow,save t
+
+=head2 Non-Perl Tests
+
+The Test Anything Protocol (http://testanything.org/) isn't just
+for Perl. Just about any language can be used to write tests that
+output TAP. There are TAP based testing libraries for C, C++, PHP,
+Python and many others. If I can't find a TAP library for my language
+of choice it's easy to generate valid TAP. It looks like this:
+
+ 1..3
+ ok 1 - init OK
+ ok 2 - opened file
+ not ok 3 - appended to file
+
+The first line is the plan - it specifies the number of tests I'm
+going to run so that it's easy to check that the test script didn't
+exit before running all the expected tests. The following lines are
+the test results - 'ok' for pass, 'not ok' for fail. Each test has
+a number and, optionally, a description. And that's it. Any language
+that can produce output like that on STDOUT can be used to write
+tests.
+
+Recently I've been rekindling a two-decades-old interest in Forth.
+Evidently I have a masochistic streak that even Perl can't satisfy.
+I want to write tests in Forth and run them using prove (you can
+find my gforth TAP experiments at
+https://svn.hexten.net/andy/Forth/Testing/). I can use the --exec
+switch to tell prove to run the tests using gforth like this:
+
+ prove -r --exec gforth t
+
+Alternately, if the language used to write my tests allows a shebang
+line I can use that to specify the interpreter. Here's a test written
+in PHP:
+
+ #!/usr/bin/php
+ <?php
+ print "1..2\n";
+ print "ok 1\n";
+ print "not ok 2\n";
+ ?>
+
+If I save that as t/phptest.t the shebang line will ensure that it
+runs correctly along with all my other tests.
+
+=head2 Mixing it up
+
+Subtle interdependencies between test programs can mask problems -
+for example an earlier test may neglect to remove a temporary file
+that affects the behaviour of a later test. To find this kind of
+problem I use the --shuffle and --reverse options to run my tests
+in random or reversed order.
+
+=head2 Rolling My Own
+
+If I need a feature that prove doesn't provide I can easily write my own.
+
+Typically you'll want to change how TAP gets I<input> into and I<output>
+from the parser. L<App::Prove> supports arbitrary plugins, and L<TAP::Harness>
+supports custom I<formatters> and I<source handlers> that you can load using
+either L<prove> or L<Module::Build>; there are many examples to base mine on.
+For more details see L<App::Prove>, L<TAP::Parser::SourceHandler>, and
+L<TAP::Formatter::Base>.
+
+If writing a plugin is not enough, you can write your own test harness; one of
+the motives for the 3.00 rewrite of Test::Harness was to make it easier to
+subclass and extend.
+
+The Test::Harness module is a compatibility wrapper around TAP::Harness.
+For new applications I should use TAP::Harness directly. As we'll
+see, prove uses TAP::Harness.
+
+When I run prove it processes its arguments, figures out which test
+scripts to run and then passes control to TAP::Harness to run the
+tests, parse, analyse and present the results. By subclassing
+TAP::Harness I can customise many aspects of the test run.
+
+I want to log my test results in a database so I can track them
+over time. To do this I override the summary method in TAP::Harness.
+I start with a simple prototype that dumps the results as a YAML
+document:
+
+ package My::TAP::Harness;
+
+ use base 'TAP::Harness';
+ use YAML;
+
+ sub summary {
+ my ( $self, $aggregate ) = @_;
+ print Dump( $aggregate );
+ $self->SUPER::summary( $aggregate );
+ }
+
+ 1;
+
+I need to tell prove to use my My::TAP::Harness. If My::TAP::Harness
+is on Perl's @INC include path I can
+
+ prove --harness=My::TAP::Harness -rb t
+
+If I don't have My::TAP::Harness installed on @INC I need to provide
+the correct path to perl when I run prove:
+
+ perl -Ilib `which prove` --harness=My::TAP::Harness -rb t
+
+I can incorporate these options into my own version of prove. It's
+pretty simple. Most of the work of prove is handled by App::Prove.
+The important code in prove is just:
+
+ use App::Prove;
+
+ my $app = App::Prove->new;
+ $app->process_args(@ARGV);
+ exit( $app->run ? 0 : 1 );
+
+If I write a subclass of App::Prove I can customise any aspect of
+the test runner while inheriting all of prove's behaviour. Here's
+myprove:
+
+ #!/usr/bin/env perl use lib qw( lib ); # Add ./lib to @INC
+ use App::Prove;
+
+ my $app = App::Prove->new;
+
+ # Use custom TAP::Harness subclass
+ $app->harness( 'My::TAP::Harness' );
+
+ $app->process_args( @ARGV ); exit( $app->run ? 0 : 1 );
+
+Now I can run my tests like this
+
+ ./myprove -rb t
+
+=head2 Deeper Customisation
+
+Now that I know how to subclass and replace TAP::Harness I can
+replace any other part of the harness. To do that I need to know
+which classes are responsible for which functionality. Here's a
+brief guided tour; the default class for each component is shown
+in parentheses. Normally any replacements I write will be subclasses
+of these default classes.
+
+When I run my tests TAP::Harness creates a scheduler
+(TAP::Parser::Scheduler) to work out the running order for the
+tests, an aggregator (TAP::Parser::Aggregator) to collect and analyse
+the test results and a formatter (TAP::Formatter::Console) to display
+those results.
+
+If I'm running my tests in parallel there may also be a multiplexer
+(TAP::Parser::Multiplexer) - the component that allows multiple
+tests to run simultaneously.
+
+Once it has created those helpers TAP::Harness starts running the
+tests. For each test it creates a new parser (TAP::Parser) which
+is responsible for running the test script and parsing its output.
+
+To replace any of these components I call one of these harness
+methods with the name of the replacement class:
+
+ aggregator_class
+ formatter_class
+ multiplexer_class
+ parser_class
+ scheduler_class
+
+For example, to replace the aggregator I would
+
+ $harness->aggregator_class( 'My::Aggregator' );
+
+Alternately I can supply the names of my substitute classes to the
+TAP::Harness constructor:
+
+ my $harness = TAP::Harness->new(
+ { aggregator_class => 'My::Aggregator' }
+ );
+
+If I need to reach even deeper into the internals of the harness I
+can replace the classes that TAP::Parser uses to execute test scripts
+and tokenise their output. Before running a test script TAP::Parser
+creates a grammar (TAP::Parser::Grammar) to decode the raw TAP into
+tokens, a result factory (TAP::Parser::ResultFactory) to turn the
+decoded TAP results into objects and, depending on whether it's
+running a test script or reading TAP from a file, scalar or array
+a source or an iterator (TAP::Parser::IteratorFactory).
+
+Each of these objects may be replaced by calling one of these parser
+methods:
+
+ source_class
+ perl_source_class
+ grammar_class
+ iterator_factory_class
+ result_factory_class
+
+=head2 Callbacks
+
+As an alternative to subclassing the components I need to change I
+can attach callbacks to the default classes. TAP::Harness exposes
+these callbacks:
+
+ parser_args Tweak the parameters used to create the parser
+ made_parser Just made a new parser
+ before_runtests About to run tests
+ after_runtests Have run all tests
+ after_test Have run an individual test script
+
+TAP::Parser also supports callbacks; bailout, comment, plan, test,
+unknown, version and yaml are called for the corresponding TAP
+result types, ALL is called for all results, ELSE is called for all
+results for which a named callback is not installed and EOF is
+called once at the end of each TAP stream.
+
+To install a callback I pass the name of the callback and a subroutine
+reference to TAP::Harness or TAP::Parser's callback method:
+
+ $harness->callback( after_test => sub {
+ my ( $script, $desc, $parser ) = @_;
+ } );
+
+I can also pass callbacks to the constructor:
+
+ my $harness = TAP::Harness->new({
+ callbacks => {
+ after_test => sub {
+ my ( $script, $desc, $parser ) = @_;
+ # Do something interesting here
+ }
+ }
+ });
+
+When it comes to altering the behaviour of the test harness there's
+more than one way to do it. Which way is best depends on my
+requirements. In general if I only want to observe test execution
+without changing the harness' behaviour (for example to log test
+results to a database) I choose callbacks. If I want to make the
+harness behave differently subclassing gives me more control.
+
+=head2 Parsing TAP
+
+Perhaps I don't need a complete test harness. If I already have a
+TAP test log that I need to parse all I need is TAP::Parser and the
+various classes it depends upon. Here's the code I need to run a
+test and parse its TAP output
+
+ use TAP::Parser;
+
+ my $parser = TAP::Parser->new( { source => 't/simple.t' } );
+ while ( my $result = $parser->next ) {
+ print $result->as_string, "\n";
+ }
+
+Alternately I can pass an open filehandle as source and have the
+parser read from that rather than attempting to run a test script:
+
+ open my $tap, '<', 'tests.tap'
+ or die "Can't read TAP transcript ($!)\n";
+ my $parser = TAP::Parser->new( { source => $tap } );
+ while ( my $result = $parser->next ) {
+ print $result->as_string, "\n";
+ }
+
+This approach is useful if I need to convert my TAP based test
+results into some other representation. See TAP::Convert::TET
+(http://search.cpan.org/dist/TAP-Convert-TET/) for an example of
+this approach.
+
+=head2 Getting Support
+
+The Test::Harness developers hang out on the tapx-dev mailing
+list[1]. For discussion of general, language independent TAP issues
+there's the tap-l[2] list. Finally there's a wiki dedicated to the
+Test Anything Protocol[3]. Contributions to the wiki, patches and
+suggestions are all welcome.
+
+[1] L<http://www.hexten.net/mailman/listinfo/tapx-dev>
+[2] L<http://testanything.org/mailman/listinfo/tap-l>
+[3] L<http://testanything.org/>
diff --git a/Master/tlpkg/tlperl/lib/TAP/Harness/Env.pm b/Master/tlpkg/tlperl/lib/TAP/Harness/Env.pm
new file mode 100644
index 00000000000..1a9d7196c40
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/TAP/Harness/Env.pm
@@ -0,0 +1,149 @@
+package TAP::Harness::Env;
+
+use strict;
+use warnings;
+
+use constant IS_VMS => ( $^O eq 'VMS' );
+use TAP::Object;
+use Text::ParseWords qw/shellwords/;
+
+our $VERSION = '3.30';
+
+# Get the parts of @INC which are changed from the stock list AND
+# preserve reordering of stock directories.
+sub _filtered_inc_vms {
+ my @inc = grep { !ref } @INC; #28567
+
+ # VMS has a 255-byte limit on the length of %ENV entries, so
+ # toss the ones that involve perl_root, the install location
+ @inc = grep { !/perl_root/i } @inc;
+
+ my @default_inc = _default_inc();
+
+ my @new_inc;
+ my %seen;
+ for my $dir (@inc) {
+ next if $seen{$dir}++;
+
+ if ( $dir eq ( $default_inc[0] || '' ) ) {
+ shift @default_inc;
+ }
+ else {
+ push @new_inc, $dir;
+ }
+
+ shift @default_inc while @default_inc and $seen{ $default_inc[0] };
+ }
+ return @new_inc;
+}
+
+# Cache this to avoid repeatedly shelling out to Perl.
+my @inc;
+
+sub _default_inc {
+ return @inc if @inc;
+
+ local $ENV{PERL5LIB};
+ local $ENV{PERLLIB};
+
+ my $perl = $ENV{HARNESS_PERL} || $^X;
+
+ # Avoid using -l for the benefit of Perl 6
+ chomp( @inc = `"$perl" -e "print join qq[\\n], \@INC, q[]"` );
+ return @inc;
+}
+
+sub create {
+ my $package = shift;
+ my %input = %{ shift || {} };
+
+ my @libs = @{ delete $input{libs} || [] };
+ my @raw_switches = @{ delete $input{switches} || [] };
+ my @opt
+ = ( @raw_switches, shellwords( $ENV{HARNESS_PERL_SWITCHES} || '' ) );
+ my @switches;
+ while ( my $opt = shift @opt ) {
+ if ( $opt =~ /^ -I (.*) $ /x ) {
+ push @libs, length($1) ? $1 : shift @opt;
+ }
+ else {
+ push @switches, $opt;
+ }
+ }
+
+ # Do things the old way on VMS...
+ push @libs, _filtered_inc_vms() if IS_VMS;
+
+ # If $Verbose isn't numeric default to 1. This helps core.
+ my $verbose
+ = $ENV{HARNESS_VERBOSE}
+ ? $ENV{HARNESS_VERBOSE} !~ /\d/
+ ? 1
+ : $ENV{HARNESS_VERBOSE}
+ : 0;
+
+ my %args = (
+ lib => \@libs,
+ timer => $ENV{HARNESS_TIMER} || 0,
+ switches => \@switches,
+ color => $ENV{HARNESS_COLOR} || 0,
+ verbosity => $verbose,
+ ignore_exit => $ENV{HARNESS_IGNORE_EXIT} || 0,
+ );
+
+ my $class = $ENV{HARNESS_SUBCLASS} || 'TAP::Harness';
+ if ( defined( my $env_opt = $ENV{HARNESS_OPTIONS} ) ) {
+ for my $opt ( split /:/, $env_opt ) {
+ if ( $opt =~ /^j(\d*)$/ ) {
+ $args{jobs} = $1 || 9;
+ }
+ elsif ( $opt eq 'c' ) {
+ $args{color} = 1;
+ }
+ elsif ( $opt =~ m/^f(.*)$/ ) {
+ my $fmt = $1;
+ $fmt =~ s/-/::/g;
+ $args{formatter_class} = $fmt;
+ }
+ elsif ( $opt =~ m/^a(.*)$/ ) {
+ my $archive = $1;
+ $class = 'TAP::Harness::Archive';
+ $args{archive} = $archive;
+ }
+ else {
+ die "Unknown HARNESS_OPTIONS item: $opt\n";
+ }
+ }
+ }
+ return TAP::Object->_construct($class, { %args, %input });
+}
+
+1;
+
+=head1 NAME
+
+TAP::Harness::Env - Parsing harness related environmental variables where appropriate
+
+=head1 VERSION
+
+Version 3.30
+
+=head1 SYNOPSIS
+
+ my ($class, $args) = get_test_arguments();
+ require_module($class);
+ $class->new($args);
+
+=head1 DESCRIPTION
+
+This module implements the environmental variables that L<Test::Harness> for use with TAP::Harness.
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item * get_test_options( \%args )
+
+This function reads the environment and generates an appropriate argument hash from it. If given any arguments, there will override the environmental defaults. It will return of C<$class> and C<$args>.
+
+=back
diff --git a/Master/tlpkg/tlperl/lib/TAP/Object.pm b/Master/tlpkg/tlperl/lib/TAP/Object.pm
index 6d0bc308217..21c53dc06a8 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Object.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Object.pm
@@ -1,7 +1,7 @@
package TAP::Object;
use strict;
-use vars qw($VERSION);
+use warnings;
=head1 NAME
@@ -9,22 +9,19 @@ TAP::Object - Base class that provides common functionality to all C<TAP::*> mod
=head1 VERSION
-Version 3.26
+Version 3.30
=cut
-$VERSION = '3.26';
+our $VERSION = '3.30';
=head1 SYNOPSIS
package TAP::Whatever;
use strict;
- use vars qw(@ISA);
- use TAP::Object;
-
- @ISA = qw(TAP::Object);
+ use base 'TAP::Object';
# new() implementation by TAP::Object
sub _initialize {
@@ -127,7 +124,7 @@ sub _construct {
unless ( $class->can('new') ) {
local $@;
eval "require $class";
- $self->_croak("Can't load $class") if $@;
+ $self->_croak("Can't load $class: $@") if $@;
}
return $class->new(@args);
diff --git a/Master/tlpkg/tlperl/lib/TAP/Parser.pm b/Master/tlpkg/tlperl/lib/TAP/Parser.pm
index 95909032418..1ebb0db969c 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Parser.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Parser.pm
@@ -1,9 +1,8 @@
package TAP::Parser;
use strict;
-use vars qw($VERSION @ISA);
+use warnings;
-use TAP::Base ();
use TAP::Parser::Grammar ();
use TAP::Parser::Result ();
use TAP::Parser::ResultFactory ();
@@ -18,17 +17,21 @@ use TAP::Parser::SourceHandler::Handle ();
use Carp qw( confess );
+use base 'TAP::Base';
+
+=encoding utf8
+
=head1 NAME
TAP::Parser - Parse L<TAP|Test::Harness::TAP> output
=head1 VERSION
-Version 3.26
+Version 3.30
=cut
-$VERSION = '3.26';
+our $VERSION = '3.30';
my $DEFAULT_TAP_VERSION = 12;
my $MAX_TAP_VERSION = 13;
@@ -42,8 +45,6 @@ END {
}
BEGIN { # making accessors
- @ISA = qw(TAP::Base);
-
__PACKAGE__->mk_methods(
qw(
_iterator
@@ -174,7 +175,7 @@ I<NEW to 3.18>.
If set, C<sources> must be a hashref containing the names of the
L<TAP::Parser::SourceHandler>s to load and/or configure. The values are a
-hash of configuration that will be accessible to to the source handlers via
+hash of configuration that will be accessible to the source handlers via
L<TAP::Parser::Source/config_for>.
For example:
@@ -638,7 +639,7 @@ C<$result> object.
Returns a list of pragmas each of which is a + or - followed by the
pragma name.
-
+
=head2 C<comment> methods
if ( $result->is_comment ) { ... }
@@ -795,7 +796,11 @@ but had a TODO directive, it will be counted as a passed test.
=cut
-sub passed { @{ shift->{passed} } }
+sub passed {
+ return @{ $_[0]->{passed} }
+ if ref $_[0]->{passed};
+ return wantarray ? 1 .. $_[0]->{passed} : $_[0]->{passed};
+}
=head3 C<failed>
@@ -822,7 +827,11 @@ regardless of whether or not a TODO directive was found.
=cut
-sub actual_passed { @{ shift->{actual_passed} } }
+sub actual_passed {
+ return @{ $_[0]->{actual_passed} }
+ if ref $_[0]->{actual_passed};
+ return wantarray ? 1 .. $_[0]->{actual_passed} : $_[0]->{actual_passed};
+}
*actual_ok = \&actual_passed;
=head3 C<actual_ok>
@@ -1496,6 +1505,17 @@ sub _finish {
}
$self->is_good_plan(0) unless defined $self->is_good_plan;
+
+ unless ( $self->parse_errors ) {
+ # Optimise storage where possible
+ if ( $self->tests_run == @{$self->{passed}} ) {
+ $self->{passed} = $self->tests_run;
+ }
+ if ( $self->tests_run == @{$self->{actual_passed}} ) {
+ $self->{actual_passed} = $self->tests_run;
+ }
+ }
+
return $self;
}
@@ -1745,7 +1765,7 @@ so without sub-classing C<TAP::Parser> by setting L</iterator_factory_class>.
If you just need to customize the objects on creation, subclass L<TAP::Parser>
and override L</make_iterator_factory>.
-Note that L</make_source> & L</make_perl_source> have been I<DEPRECATED> and
+Note that C<make_source> & C<make_perl_source> have been I<DEPRECATED> and
are now removed.
=head3 Iterators
diff --git a/Master/tlpkg/tlperl/lib/TAP/Parser/Aggregator.pm b/Master/tlpkg/tlperl/lib/TAP/Parser/Aggregator.pm
index d2836e552cb..ee4befd3fa3 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Parser/Aggregator.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Parser/Aggregator.pm
@@ -1,12 +1,10 @@
package TAP::Parser::Aggregator;
use strict;
+use warnings;
use Benchmark;
-use vars qw($VERSION @ISA);
-use TAP::Object ();
-
-@ISA = qw(TAP::Object);
+use base 'TAP::Object';
=head1 NAME
@@ -14,11 +12,11 @@ TAP::Parser::Aggregator - Aggregate TAP::Parser results
=head1 VERSION
-Version 3.26
+Version 3.30
=cut
-$VERSION = '3.26';
+our $VERSION = '3.30';
=head1 SYNOPSIS
diff --git a/Master/tlpkg/tlperl/lib/TAP/Parser/Grammar.pm b/Master/tlpkg/tlperl/lib/TAP/Parser/Grammar.pm
index aba4c66086b..fe1b9adba2e 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Parser/Grammar.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Parser/Grammar.pm
@@ -1,13 +1,12 @@
package TAP::Parser::Grammar;
use strict;
-use vars qw($VERSION @ISA);
+use warnings;
-use TAP::Object ();
use TAP::Parser::ResultFactory ();
use TAP::Parser::YAMLish::Reader ();
-@ISA = qw(TAP::Object);
+use base 'TAP::Object';
=head1 NAME
@@ -15,11 +14,11 @@ TAP::Parser::Grammar - A grammar for the Test Anything Protocol.
=head1 VERSION
-Version 3.26
+Version 3.30
=cut
-$VERSION = '3.26';
+our $VERSION = '3.30';
=head1 SYNOPSIS
@@ -405,7 +404,10 @@ sub _make_test_token {
my ( $self, $line, $ok, $num, $desc, $dir, $explanation ) = @_;
return {
ok => $ok,
- test_num => $num,
+
+ # forcing this to be an integer (and not a string) reduces memory
+ # consumption. RT #84939
+ test_num => ( defined $num ? 0 + $num : undef ),
description => _trim($desc),
directive => ( defined $dir ? uc $dir : '' ),
explanation => _trim($explanation),
diff --git a/Master/tlpkg/tlperl/lib/TAP/Parser/Iterator.pm b/Master/tlpkg/tlperl/lib/TAP/Parser/Iterator.pm
index aebcb94a5f4..886f5f4656b 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Parser/Iterator.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Parser/Iterator.pm
@@ -1,11 +1,9 @@
package TAP::Parser::Iterator;
use strict;
-use vars qw($VERSION @ISA);
+use warnings;
-use TAP::Object ();
-
-@ISA = qw(TAP::Object);
+use base 'TAP::Object';
=head1 NAME
@@ -13,18 +11,17 @@ TAP::Parser::Iterator - Base class for TAP source iterators
=head1 VERSION
-Version 3.26
+Version 3.30
=cut
-$VERSION = '3.26';
+our $VERSION = '3.30';
=head1 SYNOPSIS
# to subclass:
- use vars qw(@ISA);
use TAP::Parser::Iterator ();
- @ISA = qw(TAP::Parser::Iterator);
+ use base 'TAP::Parser::Iterator';
sub _initialize {
# see TAP::Object...
}
diff --git a/Master/tlpkg/tlperl/lib/TAP/Parser/Iterator/Array.pm b/Master/tlpkg/tlperl/lib/TAP/Parser/Iterator/Array.pm
index a3bb6621e7a..929b1004585 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Parser/Iterator/Array.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Parser/Iterator/Array.pm
@@ -1,11 +1,9 @@
package TAP::Parser::Iterator::Array;
use strict;
-use vars qw($VERSION @ISA);
+use warnings;
-use TAP::Parser::Iterator ();
-
-@ISA = 'TAP::Parser::Iterator';
+use base 'TAP::Parser::Iterator';
=head1 NAME
@@ -13,11 +11,11 @@ TAP::Parser::Iterator::Array - Iterator for array-based TAP sources
=head1 VERSION
-Version 3.26
+Version 3.30
=cut
-$VERSION = '3.26';
+our $VERSION = '3.30';
=head1 SYNOPSIS
diff --git a/Master/tlpkg/tlperl/lib/TAP/Parser/Iterator/Process.pm b/Master/tlpkg/tlperl/lib/TAP/Parser/Iterator/Process.pm
index 8f43f0a45bc..aaf6b6cf61a 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Parser/Iterator/Process.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Parser/Iterator/Process.pm
@@ -1,13 +1,12 @@
package TAP::Parser::Iterator::Process;
use strict;
-use vars qw($VERSION @ISA);
+use warnings;
-use TAP::Parser::Iterator ();
use Config;
use IO::Handle;
-@ISA = 'TAP::Parser::Iterator';
+use base 'TAP::Parser::Iterator';
my $IS_WIN32 = ( $^O =~ /^(MS)?Win32$/ );
@@ -17,11 +16,11 @@ TAP::Parser::Iterator::Process - Iterator for process-based TAP sources
=head1 VERSION
-Version 3.26
+Version 3.30
=cut
-$VERSION = '3.26';
+our $VERSION = '3.30';
=head1 SYNOPSIS
@@ -79,7 +78,7 @@ Get the exit status for this iterator's process.
{
- local $^W; # no warnings
+ no warnings 'uninitialized';
# get around a catch22 in the test suite that causes failures on Win32:
local $SIG{__DIE__} = undef;
eval { require POSIX; &POSIX::WEXITSTATUS(0) };
@@ -138,7 +137,7 @@ sub _initialize {
# HOTPATCH {{{
my $xclose = \&IPC::Open3::xclose;
- local $^W; # no warnings
+ no warnings;
local *IPC::Open3::xclose = sub {
my $fh = shift;
no strict 'refs';
@@ -158,9 +157,7 @@ sub _initialize {
};
die "Could not execute (@command): $@" if $@;
if ( $] >= 5.006 ) {
-
- # Kludge to avoid warning under 5.5
- eval 'binmode($out, ":crlf")';
+ binmode($out, ":crlf");
}
}
else {
diff --git a/Master/tlpkg/tlperl/lib/TAP/Parser/Iterator/Stream.pm b/Master/tlpkg/tlperl/lib/TAP/Parser/Iterator/Stream.pm
index 1d045744103..9181fc7ae79 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Parser/Iterator/Stream.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Parser/Iterator/Stream.pm
@@ -1,11 +1,9 @@
package TAP::Parser::Iterator::Stream;
use strict;
-use vars qw($VERSION @ISA);
+use warnings;
-use TAP::Parser::Iterator ();
-
-@ISA = 'TAP::Parser::Iterator';
+use base 'TAP::Parser::Iterator';
=head1 NAME
@@ -13,11 +11,11 @@ TAP::Parser::Iterator::Stream - Iterator for filehandle-based TAP sources
=head1 VERSION
-Version 3.26
+Version 3.30
=cut
-$VERSION = '3.26';
+our $VERSION = '3.30';
=head1 SYNOPSIS
diff --git a/Master/tlpkg/tlperl/lib/TAP/Parser/IteratorFactory.pm b/Master/tlpkg/tlperl/lib/TAP/Parser/IteratorFactory.pm
index cda251e8d72..8b75724fd8e 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Parser/IteratorFactory.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Parser/IteratorFactory.pm
@@ -1,14 +1,12 @@
package TAP::Parser::IteratorFactory;
use strict;
-use vars qw($VERSION @ISA);
-
-use TAP::Object ();
+use warnings;
use Carp qw( confess );
use File::Basename qw( fileparse );
-@ISA = qw(TAP::Object);
+use base 'TAP::Object';
use constant handlers => [];
@@ -18,11 +16,11 @@ TAP::Parser::IteratorFactory - Figures out which SourceHandler objects to use fo
=head1 VERSION
-Version 3.26
+Version 3.30
=cut
-$VERSION = '3.26';
+our $VERSION = '3.30';
=head1 SYNOPSIS
@@ -302,11 +300,8 @@ But in case you find the need to...
package MyIteratorFactory;
use strict;
- use vars '@ISA';
-
- use TAP::Parser::IteratorFactory;
- @ISA = qw( TAP::Parser::IteratorFactory );
+ use base 'TAP::Parser::IteratorFactory';
# override source detection algorithm
sub detect_source {
diff --git a/Master/tlpkg/tlperl/lib/TAP/Parser/Multiplexer.pm b/Master/tlpkg/tlperl/lib/TAP/Parser/Multiplexer.pm
index a3a23dae757..65cd46de13e 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Parser/Multiplexer.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Parser/Multiplexer.pm
@@ -1,28 +1,27 @@
package TAP::Parser::Multiplexer;
use strict;
-use vars qw($VERSION @ISA);
+use warnings;
use IO::Select;
-use TAP::Object ();
+
+use base 'TAP::Object';
use constant IS_WIN32 => $^O =~ /^(MS)?Win32$/;
use constant IS_VMS => $^O eq 'VMS';
use constant SELECT_OK => !( IS_VMS || IS_WIN32 );
-@ISA = 'TAP::Object';
-
=head1 NAME
TAP::Parser::Multiplexer - Multiplex multiple TAP::Parsers
=head1 VERSION
-Version 3.26
+Version 3.30
=cut
-$VERSION = '3.26';
+our $VERSION = '3.30';
=head1 SYNOPSIS
diff --git a/Master/tlpkg/tlperl/lib/TAP/Parser/Result.pm b/Master/tlpkg/tlperl/lib/TAP/Parser/Result.pm
index a0caebe24ca..eaad1d2f41b 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Parser/Result.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Parser/Result.pm
@@ -1,11 +1,9 @@
package TAP::Parser::Result;
use strict;
-use vars qw($VERSION @ISA);
+use warnings;
-use TAP::Object ();
-
-@ISA = 'TAP::Object';
+use base 'TAP::Object';
BEGIN {
@@ -26,11 +24,11 @@ TAP::Parser::Result - Base class for TAP::Parser output objects
=head1 VERSION
-Version 3.26
+Version 3.30
=cut
-$VERSION = '3.26';
+our $VERSION = '3.30';
=head1 SYNOPSIS
@@ -274,9 +272,8 @@ subclass L<TAP::Parser::Grammar> too, or else it'll never get used.
package MyResult;
use strict;
- use vars '@ISA';
- @ISA = 'TAP::Parser::Result';
+ use base 'TAP::Parser::Result';
# register with the factory:
TAP::Parser::ResultFactory->register_type( 'my_type' => __PACKAGE__ );
diff --git a/Master/tlpkg/tlperl/lib/TAP/Parser/Result/Bailout.pm b/Master/tlpkg/tlperl/lib/TAP/Parser/Result/Bailout.pm
index 14bef6c9ade..2ae35d6e603 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Parser/Result/Bailout.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Parser/Result/Bailout.pm
@@ -1,10 +1,9 @@
package TAP::Parser::Result::Bailout;
use strict;
+use warnings;
-use vars qw($VERSION @ISA);
-use TAP::Parser::Result;
-@ISA = 'TAP::Parser::Result';
+use base 'TAP::Parser::Result';
=head1 NAME
@@ -12,11 +11,11 @@ TAP::Parser::Result::Bailout - Bailout result token.
=head1 VERSION
-Version 3.26
+Version 3.30
=cut
-$VERSION = '3.26';
+our $VERSION = '3.30';
=head1 DESCRIPTION
diff --git a/Master/tlpkg/tlperl/lib/TAP/Parser/Result/Comment.pm b/Master/tlpkg/tlperl/lib/TAP/Parser/Result/Comment.pm
index 8a2cb934de5..d69ec5189c2 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Parser/Result/Comment.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Parser/Result/Comment.pm
@@ -1,10 +1,9 @@
package TAP::Parser::Result::Comment;
use strict;
+use warnings;
-use vars qw($VERSION @ISA);
-use TAP::Parser::Result;
-@ISA = 'TAP::Parser::Result';
+use base 'TAP::Parser::Result';
=head1 NAME
@@ -12,11 +11,11 @@ TAP::Parser::Result::Comment - Comment result token.
=head1 VERSION
-Version 3.26
+Version 3.30
=cut
-$VERSION = '3.26';
+our $VERSION = '3.30';
=head1 DESCRIPTION
diff --git a/Master/tlpkg/tlperl/lib/TAP/Parser/Result/Plan.pm b/Master/tlpkg/tlperl/lib/TAP/Parser/Result/Plan.pm
index b515e61c99a..d85243c9766 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Parser/Result/Plan.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Parser/Result/Plan.pm
@@ -1,10 +1,9 @@
package TAP::Parser::Result::Plan;
use strict;
+use warnings;
-use vars qw($VERSION @ISA);
-use TAP::Parser::Result;
-@ISA = 'TAP::Parser::Result';
+use base 'TAP::Parser::Result';
=head1 NAME
@@ -12,11 +11,11 @@ TAP::Parser::Result::Plan - Plan result token.
=head1 VERSION
-Version 3.26
+Version 3.30
=cut
-$VERSION = '3.26';
+our $VERSION = '3.30';
=head1 DESCRIPTION
diff --git a/Master/tlpkg/tlperl/lib/TAP/Parser/Result/Pragma.pm b/Master/tlpkg/tlperl/lib/TAP/Parser/Result/Pragma.pm
index 0416e3a81f1..1479e8836cd 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Parser/Result/Pragma.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Parser/Result/Pragma.pm
@@ -1,10 +1,9 @@
package TAP::Parser::Result::Pragma;
use strict;
+use warnings;
-use vars qw($VERSION @ISA);
-use TAP::Parser::Result;
-@ISA = 'TAP::Parser::Result';
+use base 'TAP::Parser::Result';
=head1 NAME
@@ -12,11 +11,11 @@ TAP::Parser::Result::Pragma - TAP pragma token.
=head1 VERSION
-Version 3.26
+Version 3.30
=cut
-$VERSION = '3.26';
+our $VERSION = '3.30';
=head1 DESCRIPTION
diff --git a/Master/tlpkg/tlperl/lib/TAP/Parser/Result/Test.pm b/Master/tlpkg/tlperl/lib/TAP/Parser/Result/Test.pm
index b977f71d9ba..749f26cbe2b 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Parser/Result/Test.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Parser/Result/Test.pm
@@ -1,12 +1,9 @@
package TAP::Parser::Result::Test;
use strict;
+use warnings;
-use vars qw($VERSION @ISA);
-use TAP::Parser::Result;
-@ISA = 'TAP::Parser::Result';
-
-use vars qw($VERSION);
+use base 'TAP::Parser::Result';
=head1 NAME
@@ -14,11 +11,11 @@ TAP::Parser::Result::Test - Test result token.
=head1 VERSION
-Version 3.26
+Version 3.30
=cut
-$VERSION = '3.26';
+our $VERSION = '3.30';
=head1 DESCRIPTION
diff --git a/Master/tlpkg/tlperl/lib/TAP/Parser/Result/Unknown.pm b/Master/tlpkg/tlperl/lib/TAP/Parser/Result/Unknown.pm
index 0d0e58304b6..3e1a6112271 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Parser/Result/Unknown.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Parser/Result/Unknown.pm
@@ -1,12 +1,9 @@
package TAP::Parser::Result::Unknown;
use strict;
+use warnings;
-use vars qw($VERSION @ISA);
-use TAP::Parser::Result;
-@ISA = 'TAP::Parser::Result';
-
-use vars qw($VERSION);
+use base 'TAP::Parser::Result';
=head1 NAME
@@ -14,11 +11,11 @@ TAP::Parser::Result::Unknown - Unknown result token.
=head1 VERSION
-Version 3.26
+Version 3.30
=cut
-$VERSION = '3.26';
+our $VERSION = '3.30';
=head1 DESCRIPTION
diff --git a/Master/tlpkg/tlperl/lib/TAP/Parser/Result/Version.pm b/Master/tlpkg/tlperl/lib/TAP/Parser/Result/Version.pm
index 2380c43349e..8b08e33d063 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Parser/Result/Version.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Parser/Result/Version.pm
@@ -1,10 +1,9 @@
package TAP::Parser::Result::Version;
use strict;
+use warnings;
-use vars qw($VERSION @ISA);
-use TAP::Parser::Result;
-@ISA = 'TAP::Parser::Result';
+use base 'TAP::Parser::Result';
=head1 NAME
@@ -12,11 +11,11 @@ TAP::Parser::Result::Version - TAP syntax version token.
=head1 VERSION
-Version 3.26
+Version 3.30
=cut
-$VERSION = '3.26';
+our $VERSION = '3.30';
=head1 DESCRIPTION
diff --git a/Master/tlpkg/tlperl/lib/TAP/Parser/Result/YAML.pm b/Master/tlpkg/tlperl/lib/TAP/Parser/Result/YAML.pm
index f92b43a78c7..a6f86e3c46d 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Parser/Result/YAML.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Parser/Result/YAML.pm
@@ -1,10 +1,9 @@
package TAP::Parser::Result::YAML;
use strict;
+use warnings;
-use vars qw($VERSION @ISA);
-use TAP::Parser::Result;
-@ISA = 'TAP::Parser::Result';
+use base 'TAP::Parser::Result';
=head1 NAME
@@ -12,11 +11,11 @@ TAP::Parser::Result::YAML - YAML result token.
=head1 VERSION
-Version 3.26
+Version 3.30
=cut
-$VERSION = '3.26';
+our $VERSION = '3.30';
=head1 DESCRIPTION
diff --git a/Master/tlpkg/tlperl/lib/TAP/Parser/ResultFactory.pm b/Master/tlpkg/tlperl/lib/TAP/Parser/ResultFactory.pm
index 729bf4fa6f4..65d31d25367 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Parser/ResultFactory.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Parser/ResultFactory.pm
@@ -1,9 +1,8 @@
package TAP::Parser::ResultFactory;
use strict;
-use vars qw($VERSION @ISA %CLASS_FOR);
+use warnings;
-use TAP::Object ();
use TAP::Parser::Result::Bailout ();
use TAP::Parser::Result::Comment ();
use TAP::Parser::Result::Plan ();
@@ -13,7 +12,7 @@ use TAP::Parser::Result::Unknown ();
use TAP::Parser::Result::Version ();
use TAP::Parser::Result::YAML ();
-@ISA = 'TAP::Object';
+use base 'TAP::Object';
##############################################################################
@@ -30,11 +29,11 @@ TAP::Parser::ResultFactory - Factory for creating TAP::Parser output objects
=head1 VERSION
-Version 3.26
+Version 3.30
=cut
-$VERSION = '3.26';
+our $VERSION = '3.30';
=head2 DESCRIPTION
@@ -83,8 +82,7 @@ a completely new type, eg:
# create a custom result type:
package MyResult;
use strict;
- use vars qw(@ISA);
- @ISA = 'TAP::Parser::Result';
+ use base 'TAP::Parser::Result';
# register with the factory:
TAP::Parser::ResultFactory->register_type( 'my_type' => __PACKAGE__ );
@@ -96,18 +94,16 @@ Your custom type should then be picked up automatically by the L<TAP::Parser>.
=cut
-BEGIN {
- %CLASS_FOR = (
- plan => 'TAP::Parser::Result::Plan',
- pragma => 'TAP::Parser::Result::Pragma',
- test => 'TAP::Parser::Result::Test',
- comment => 'TAP::Parser::Result::Comment',
- bailout => 'TAP::Parser::Result::Bailout',
- version => 'TAP::Parser::Result::Version',
- unknown => 'TAP::Parser::Result::Unknown',
- yaml => 'TAP::Parser::Result::YAML',
- );
-}
+our %CLASS_FOR = (
+ plan => 'TAP::Parser::Result::Plan',
+ pragma => 'TAP::Parser::Result::Pragma',
+ test => 'TAP::Parser::Result::Test',
+ comment => 'TAP::Parser::Result::Comment',
+ bailout => 'TAP::Parser::Result::Bailout',
+ version => 'TAP::Parser::Result::Version',
+ unknown => 'TAP::Parser::Result::Unknown',
+ yaml => 'TAP::Parser::Result::YAML',
+);
sub class_for {
my ( $class, $type ) = @_;
@@ -166,12 +162,10 @@ Of course, it's up to you to decide whether or not to ignore them.
package MyResultFactory;
use strict;
- use vars '@ISA';
use MyResult;
- use TAP::Parser::ResultFactory;
- @ISA = qw( TAP::Parser::ResultFactory );
+ use base 'TAP::Parser::ResultFactory';
# force all results to be 'MyResult'
sub class_for {
diff --git a/Master/tlpkg/tlperl/lib/TAP/Parser/Scheduler.pm b/Master/tlpkg/tlperl/lib/TAP/Parser/Scheduler.pm
index f7a3e46c67b..7c5cedf7edc 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Parser/Scheduler.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Parser/Scheduler.pm
@@ -1,7 +1,8 @@
package TAP::Parser::Scheduler;
use strict;
-use vars qw($VERSION);
+use warnings;
+
use Carp;
use TAP::Parser::Scheduler::Job;
use TAP::Parser::Scheduler::Spinner;
@@ -12,11 +13,11 @@ TAP::Parser::Scheduler - Schedule tests during parallel testing
=head1 VERSION
-Version 3.26
+Version 3.30
=cut
-$VERSION = '3.26';
+our $VERSION = '3.30';
=head1 SYNOPSIS
@@ -30,9 +31,98 @@ $VERSION = '3.26';
=head3 C<new>
- my $sched = TAP::Parser::Scheduler->new;
+ my $sched = TAP::Parser::Scheduler->new(tests => \@tests);
+ my $sched = TAP::Parser::Scheduler->new(
+ tests => [ ['t/test_name.t','Test Description'], ... ],
+ rules => \%rules,
+ );
+
+Given 'tests' and optional 'rules' as input, returns a new
+C<TAP::Parser::Scheduler> object. Each member of C<@tests> should be either a
+a test file name, or a two element arrayref, where the first element is a test
+file name, and the second element is a test description. By default, we'll use
+the test name as the description.
+
+The optional C<rules> attribute provides direction on which tests should be run
+in parallel and which should be run sequentially. If no rule data structure is
+provided, a default data structure is used which makes every test eligible to
+be run in parallel:
+
+ { par => '**' },
+
+The rules data structure is documented more in the next section.
+
+=head2 Rules data structure
+
+The "C<rules>" data structure is the the heart of the scheduler. It allows you
+to express simple rules like "run all tests in sequence" or "run all tests in
+parallel except these five tests.". However, the rules structure also supports
+glob-style pattern matching and recursive definitions, so you can also express
+arbitarily complicated patterns.
+
+The rule must only have one top level key: either 'par' for "parallel" or 'seq'
+for "sequence".
+
+Values must be either strings with possible glob-style matching, or arrayrefs
+of strings or hashrefs which follow this pattern recursively.
+
+Every element in an arrayref directly below a 'par' key is eligible to be run
+in parallel, while vavalues directly below a 'seq' key must be run in sequence.
+
+=head3 Rules examples
+
+Here are some examples:
+
+ # All tests be run in parallel (the default rule)
+ { par => '**' },
+
+ # Run all tests in sequence, except those starting with "p"
+ { par => 't/p*.t' },
+
+ # Run all tests in parallel, except those starting with "p"
+ {
+ seq => [
+ { seq => 't/p*.t' },
+ { par => '**' },
+ ],
+ }
+
+ # Run some startup tests in sequence, then some parallel tests than some
+ # teardown tests in sequence.
+ {
+ seq => [
+ { seq => 't/startup/*.t' },
+ { par => ['t/a/*.t','t/b/*.t','t/c/*.t'], }
+ { seq => 't/shutdown/*.t' },
+ ],
+ },
-Returns a new C<TAP::Parser::Scheduler> object.
+
+=head3 Rules resolution
+
+=over4
+
+=item * By default, all tests are eligible to be run in parallel. Specifying any of your own rules removes this one.
+
+=item * "First match wins". The first rule that matches a test will be the one that applies.
+
+=item * Any test which does not match a rule will be run in sequence at the end of the run.
+
+=item * The existence of a rule does not imply selecting a test. You must still specify the tests to run.
+
+=item * Specifying a rule to allow tests to run in parallel does not make the run in parallel. You still need specify the number of parallel C<jobs> in your Harness object.
+
+=back
+
+=head3 Glob-style pattern matching for rules
+
+We implement our own glob-style pattern matching. Here are the patterns it supports:
+
+ ** is any number of characters, including /, within a pathname
+ * is zero or more characters within a filename/directory name
+ ? is exactly one character within a filename/directory name
+ {foo,bar,baz} is any of foo, bar or baz.
+ \ is an escape character
=cut
@@ -70,6 +160,9 @@ sub new {
sub _set_rules {
my ( $self, $rules, $tests ) = @_;
+
+ # Convert all incoming tests to job objects.
+ # If no test description is provided use the file name as the description.
my @tests = map { TAP::Parser::Scheduler::Job->new(@$_) }
map { 'ARRAY' eq ref $_ ? $_ : [ $_, $_ ] } @$tests;
my $schedule = $self->_rule_clause( $rules, \@tests );
@@ -185,6 +278,8 @@ sub _expand {
return @match;
}
+=head2 Instance Methods
+
=head3 C<get_all>
Get a list of all remaining tests.
@@ -207,9 +302,9 @@ sub _gather {
=head3 C<get_job>
-Return the next available job or C<undef> if none are available. Returns
-a C<TAP::Parser::Scheduler::Spinner> if the scheduler still has pending
-jobs but none are available to run right now.
+Return the next available job as L<TAP::Parser::Scheduler::Job> object or
+C<undef> if none are available. Returns a L<TAP::Parser::Scheduler::Spinner> if
+the scheduler still has pending jobs but none are available to run right now.
=cut
@@ -281,9 +376,50 @@ sub _find_next_job {
=head3 C<as_string>
Return a human readable representation of the scheduling tree.
+For example:
+
+ my @tests = (qw{
+ t/startup/foo.t
+ t/shutdown/foo.t
+
+ t/a/foo.t t/b/foo.t t/c/foo.t t/d/foo.t
+ });
+ my $sched = TAP::Parser::Scheduler->new(
+ tests => \@tests,
+ rules => {
+ seq => [
+ { seq => 't/startup/*.t' },
+ { par => ['t/a/*.t','t/b/*.t','t/c/*.t'] },
+ { seq => 't/shutdown/*.t' },
+ ],
+ },
+ );
+
+Produces:
+
+ par:
+ seq:
+ par:
+ seq:
+ par:
+ seq:
+ 't/startup/foo.t'
+ par:
+ seq:
+ 't/a/foo.t'
+ seq:
+ 't/b/foo.t'
+ seq:
+ 't/c/foo.t'
+ par:
+ seq:
+ 't/shutdown/foo.t'
+ 't/d/foo.t'
+
=cut
+
sub as_string {
my $self = shift;
return $self->_as_string( $self->{schedule} );
diff --git a/Master/tlpkg/tlperl/lib/TAP/Parser/Scheduler/Job.pm b/Master/tlpkg/tlperl/lib/TAP/Parser/Scheduler/Job.pm
index bac5883f48f..6375a7b8786 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Parser/Scheduler/Job.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Parser/Scheduler/Job.pm
@@ -1,7 +1,7 @@
package TAP::Parser::Scheduler::Job;
use strict;
-use vars qw($VERSION);
+use warnings;
use Carp;
=head1 NAME
@@ -10,11 +10,11 @@ TAP::Parser::Scheduler::Job - A single testing job.
=head1 VERSION
-Version 3.26
+Version 3.30
=cut
-$VERSION = '3.26';
+our $VERSION = '3.30';
=head1 SYNOPSIS
@@ -31,10 +31,11 @@ Represents a single test 'job'.
=head3 C<new>
my $job = TAP::Parser::Scheduler::Job->new(
- $name, $desc
+ $filename, $description
);
-Returns a new C<TAP::Parser::Scheduler::Job> object.
+Given the filename and description of a test as scalars, returns a new
+L<TAP::Parser::Scheduler::Job> object.
=cut
@@ -47,9 +48,14 @@ sub new {
}, $class;
}
+=head2 Instance Methods
+
=head3 C<on_finish>
-Register a closure to be called when this job is destroyed.
+ $self->on_finish(\&method).
+
+Register a closure to be called when this job is destroyed. The callback
+will be passed the C<TAP::Parser::Scheduler::Job> object as it's only argument.
=cut
@@ -60,7 +66,10 @@ sub on_finish {
=head3 C<finish>
-Called when a job is complete to unlock it.
+ $self->finish;
+
+Called when a job is complete to unlock it. If a callback has been registered
+with C<on_finish>, it calls it. Otherwise, it does nothing.
=cut
@@ -71,6 +80,15 @@ sub finish {
}
}
+=head2 Attributes
+
+ $self->filename;
+ $self->description;
+ $self->context;
+
+These are all "getters" which return the data set for these attributes during object construction.
+
+
=head3 C<filename>
=head3 C<description>
@@ -96,6 +114,8 @@ sub as_array_ref {
=head3 C<is_spinner>
+ $self->is_spinner;
+
Returns false indicating that this is a real job rather than a
'spinner'. Spinners are returned when the scheduler still has pending
jobs but can't (because of locking) return one right now.
diff --git a/Master/tlpkg/tlperl/lib/TAP/Parser/Scheduler/Spinner.pm b/Master/tlpkg/tlperl/lib/TAP/Parser/Scheduler/Spinner.pm
index 21d4d67647a..f590ea58f04 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Parser/Scheduler/Spinner.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Parser/Scheduler/Spinner.pm
@@ -1,7 +1,7 @@
package TAP::Parser::Scheduler::Spinner;
use strict;
-use vars qw($VERSION);
+use warnings;
use Carp;
=head1 NAME
@@ -10,11 +10,11 @@ TAP::Parser::Scheduler::Spinner - A no-op job.
=head1 VERSION
-Version 3.26
+Version 3.30
=cut
-$VERSION = '3.26';
+our $VERSION = '3.30';
=head1 SYNOPSIS
@@ -34,12 +34,14 @@ return a real job.
my $job = TAP::Parser::Scheduler::Spinner->new;
-Returns a new C<TAP::Parser::Scheduler::Spinner> object.
+Ignores any arguments and returns a new C<TAP::Parser::Scheduler::Spinner> object.
=cut
sub new { bless {}, shift }
+=head2 Instance Methods
+
=head3 C<is_spinner>
Returns true indicating that is a 'spinner' job. Spinners are returned
@@ -50,4 +52,10 @@ return one right now.
sub is_spinner {1}
+=head1 SEE ALSO
+
+L<TAP::Parser::Scheduler>, L<TAP::Parser::Scheduler::Job>
+
+=cut
+
1;
diff --git a/Master/tlpkg/tlperl/lib/TAP/Parser/Source.pm b/Master/tlpkg/tlperl/lib/TAP/Parser/Source.pm
index 6eda5db839d..0e2da09f644 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Parser/Source.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Parser/Source.pm
@@ -1,26 +1,24 @@
package TAP::Parser::Source;
use strict;
-use vars qw($VERSION @ISA);
+use warnings;
-use TAP::Object ();
use File::Basename qw( fileparse );
+use base 'TAP::Object';
use constant BLK_SIZE => 512;
-@ISA = qw(TAP::Object);
-
=head1 NAME
TAP::Parser::Source - a TAP source & meta data about it
=head1 VERSION
-Version 3.26
+Version 3.30
=cut
-$VERSION = '3.26';
+our $VERSION = '3.30';
=head1 SYNOPSIS
@@ -329,7 +327,7 @@ May be called as a class method
open my $fh, '<', $file or die "Can't read $file: $!\n";
# Might be a binary file - so read a fixed number of bytes.
- my $got = read $fh, my $buf, BLK_SIZE;
+ my $got = read $fh, my ($buf), BLK_SIZE;
defined $got or die "I/O error: $!\n";
return $1 if $buf =~ /(.*)/;
return;
diff --git a/Master/tlpkg/tlperl/lib/TAP/Parser/SourceHandler.pm b/Master/tlpkg/tlperl/lib/TAP/Parser/SourceHandler.pm
index e8412ab309b..dc257e0ed9f 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Parser/SourceHandler.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Parser/SourceHandler.pm
@@ -1,12 +1,10 @@
package TAP::Parser::SourceHandler;
use strict;
-use vars qw($VERSION @ISA);
+use warnings;
-use TAP::Object ();
use TAP::Parser::Iterator ();
-
-@ISA = qw(TAP::Object);
+use base 'TAP::Object';
=head1 NAME
@@ -14,11 +12,11 @@ TAP::Parser::SourceHandler - Base class for different TAP source handlers
=head1 VERSION
-Version 3.26
+Version 3.30
=cut
-$VERSION = '3.26';
+our $VERSION = '3.30';
=head1 SYNOPSIS
@@ -27,7 +25,7 @@ $VERSION = '3.26';
# must be sub-classed for use
package MySourceHandler;
- use base qw( TAP::Parser::SourceHandler );
+ use base 'TAP::Parser::SourceHandler';
sub can_handle { return $confidence_level }
sub make_iterator { return $iterator }
@@ -105,7 +103,7 @@ a quick overview.
Start by familiarizing yourself with L<TAP::Parser::Source> and
L<TAP::Parser::IteratorFactory>. L<TAP::Parser::SourceHandler::RawTAP> is
-the easiest sub-class to use an an example.
+the easiest sub-class to use as an example.
It's important to point out that if you want your subclass to be automatically
used by L<TAP::Parser> you'll have to and make sure it gets loaded somehow.
@@ -123,12 +121,11 @@ L<TAP::Parser::IteratorFactory/register_handler>.
package MySourceHandler;
use strict;
- use vars '@ISA'; # compat with older perls
use MySourceHandler; # see TAP::Parser::SourceHandler
use TAP::Parser::IteratorFactory;
- @ISA = qw( TAP::Parser::SourceHandler );
+ use base 'TAP::Parser::SourceHandler';
TAP::Parser::IteratorFactory->register_handler( __PACKAGE__ );
diff --git a/Master/tlpkg/tlperl/lib/TAP/Parser/SourceHandler/Executable.pm b/Master/tlpkg/tlperl/lib/TAP/Parser/SourceHandler/Executable.pm
index f20e6514ab0..5522625d317 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Parser/SourceHandler/Executable.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Parser/SourceHandler/Executable.pm
@@ -1,13 +1,12 @@
package TAP::Parser::SourceHandler::Executable;
use strict;
-use vars qw($VERSION @ISA);
+use warnings;
-use TAP::Parser::SourceHandler ();
use TAP::Parser::IteratorFactory ();
use TAP::Parser::Iterator::Process ();
-@ISA = qw(TAP::Parser::SourceHandler);
+use base 'TAP::Parser::SourceHandler';
TAP::Parser::IteratorFactory->register_handler(__PACKAGE__);
@@ -17,11 +16,11 @@ TAP::Parser::SourceHandler::Executable - Stream output from an executable TAP so
=head1 VERSION
-Version 3.26
+Version 3.30
=cut
-$VERSION = '3.26';
+our $VERSION = '3.30';
=head1 SYNOPSIS
@@ -156,12 +155,11 @@ Please see L<TAP::Parser/SUBCLASSING> for a subclassing overview.
package MyRubySourceHandler;
use strict;
- use vars '@ISA';
use Carp qw( croak );
use TAP::Parser::SourceHandler::Executable;
- @ISA = qw( TAP::Parser::SourceHandler::Executable );
+ use base 'TAP::Parser::SourceHandler::Executable';
# expect $handler->(['mytest.rb', 'cmdline', 'args']);
sub make_iterator {
diff --git a/Master/tlpkg/tlperl/lib/TAP/Parser/SourceHandler/File.pm b/Master/tlpkg/tlperl/lib/TAP/Parser/SourceHandler/File.pm
index 1faacebe513..b48660fc782 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Parser/SourceHandler/File.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Parser/SourceHandler/File.pm
@@ -1,13 +1,12 @@
package TAP::Parser::SourceHandler::File;
use strict;
-use vars qw($VERSION @ISA);
+use warnings;
-use TAP::Parser::SourceHandler ();
use TAP::Parser::IteratorFactory ();
use TAP::Parser::Iterator::Stream ();
-@ISA = qw(TAP::Parser::SourceHandler);
+use base 'TAP::Parser::SourceHandler';
TAP::Parser::IteratorFactory->register_handler(__PACKAGE__);
@@ -17,11 +16,11 @@ TAP::Parser::SourceHandler::File - Stream TAP from a text file.
=head1 VERSION
-Version 3.26
+Version 3.30
=cut
-$VERSION = '3.26';
+our $VERSION = '3.30';
=head1 SYNOPSIS
diff --git a/Master/tlpkg/tlperl/lib/TAP/Parser/SourceHandler/Handle.pm b/Master/tlpkg/tlperl/lib/TAP/Parser/SourceHandler/Handle.pm
index f0043471250..944fb2a9b37 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Parser/SourceHandler/Handle.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Parser/SourceHandler/Handle.pm
@@ -1,13 +1,12 @@
package TAP::Parser::SourceHandler::Handle;
use strict;
-use vars qw($VERSION @ISA);
+use warnings;
-use TAP::Parser::SourceHandler ();
use TAP::Parser::IteratorFactory ();
use TAP::Parser::Iterator::Stream ();
-@ISA = qw(TAP::Parser::SourceHandler);
+use base 'TAP::Parser::SourceHandler';
TAP::Parser::IteratorFactory->register_handler(__PACKAGE__);
@@ -17,11 +16,11 @@ TAP::Parser::SourceHandler::Handle - Stream TAP from an IO::Handle or a GLOB.
=head1 VERSION
-Version 3.26
+Version 3.30
=cut
-$VERSION = '3.26';
+our $VERSION = '3.30';
=head1 SYNOPSIS
diff --git a/Master/tlpkg/tlperl/lib/TAP/Parser/SourceHandler/Perl.pm b/Master/tlpkg/tlperl/lib/TAP/Parser/SourceHandler/Perl.pm
index 97eba8ebc17..1a1867b922d 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Parser/SourceHandler/Perl.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Parser/SourceHandler/Perl.pm
@@ -1,18 +1,17 @@
package TAP::Parser::SourceHandler::Perl;
use strict;
+use warnings;
use Config;
-use vars qw($VERSION @ISA);
use constant IS_WIN32 => ( $^O =~ /^(MS)?Win32$/ );
use constant IS_VMS => ( $^O eq 'VMS' );
-use TAP::Parser::SourceHandler::Executable ();
use TAP::Parser::IteratorFactory ();
use TAP::Parser::Iterator::Process ();
-use TAP::Parser::Utils qw( split_shell );
+use Text::ParseWords qw(shellwords);
-@ISA = 'TAP::Parser::SourceHandler::Executable';
+use base 'TAP::Parser::SourceHandler::Executable';
TAP::Parser::IteratorFactory->register_handler(__PACKAGE__);
@@ -22,11 +21,11 @@ TAP::Parser::SourceHandler::Perl - Stream TAP from a Perl executable
=head1 VERSION
-Version 3.26
+Version 3.30
=cut
-$VERSION = '3.26';
+our $VERSION = '3.30';
=head1 SYNOPSIS
@@ -152,18 +151,27 @@ sub make_iterator {
$class->_run( $source, $libs, $switches );
}
+
+sub _has_taint_switch {
+ my( $class, $switches ) = @_;
+
+ my $has_taint = grep { $_ eq "-T" || $_ eq "-t" } @{$switches};
+ return $has_taint ? 1 : 0;
+}
+
sub _mangle_switches {
my ( $class, $libs, $switches ) = @_;
# Taint mode ignores environment variables so we must retranslate
# PERL5LIB as -I switches and place PERL5OPT on the command line
# in order that it be seen.
- if ( grep { $_ eq "-T" || $_ eq "-t" } @{$switches} ) {
+ if ( $class->_has_taint_switch($switches) ) {
+ my @perl5lib = defined $ENV{PERL5LIB} ? split /$Config{path_sep}/, $ENV{PERL5LIB} : ();
return (
$libs,
[ @{$switches},
- $class->_libs2switches($libs),
- split_shell( $ENV{PERL5OPT} )
+ $class->_libs2switches([@$libs, @perl5lib]),
+ defined $ENV{PERL5OPT} ? shellwords( $ENV{PERL5OPT} ) : ()
],
);
}
@@ -200,10 +208,10 @@ sub _filter_libs {
}
sub _iterator_hooks {
- my ( $class, $source, $libs ) = @_;
+ my ( $class, $source, $libs, $switches ) = @_;
my $setup = sub {
- if ( @{$libs} ) {
+ if ( @{$libs} and !$class->_has_taint_switch($switches) ) {
$ENV{PERL5LIB} = join(
$Config{path_sep}, grep {defined} @{$libs},
$ENV{PERL5LIB}
@@ -211,8 +219,8 @@ sub _iterator_hooks {
}
};
- # Cargo culted from comments seen elsewhere about VMS / environment
- # variables. I don't know if this is actually necessary.
+ # VMS environment variables aren't guaranteed to reset at the end of
+ # the process, so we need to put PERL5LIB back.
my $previous = $ENV{PERL5LIB};
my $teardown = sub {
if ( defined $previous ) {
@@ -232,7 +240,7 @@ sub _run {
my @command = $class->_get_command_for_switches( $source, $switches )
or $class->_croak("No command found!");
- my ( $setup, $teardown ) = $class->_iterator_hooks( $source, $libs );
+ my ( $setup, $teardown ) = $class->_iterator_hooks( $source, $libs, $switches );
return $class->_create_iterator( $source, \@command, $setup, $teardown );
}
@@ -333,11 +341,10 @@ Please see L<TAP::Parser/SUBCLASSING> for a subclassing overview.
package MyPerlSourceHandler;
use strict;
- use vars '@ISA';
use TAP::Parser::SourceHandler::Perl;
- @ISA = qw( TAP::Parser::SourceHandler::Perl );
+ use base 'TAP::Parser::SourceHandler::Perl';
# use the version of perl from the shebang line in the test file
sub get_perl {
diff --git a/Master/tlpkg/tlperl/lib/TAP/Parser/SourceHandler/RawTAP.pm b/Master/tlpkg/tlperl/lib/TAP/Parser/SourceHandler/RawTAP.pm
index 04b4b9c2da1..627a1e1311a 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Parser/SourceHandler/RawTAP.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Parser/SourceHandler/RawTAP.pm
@@ -1,13 +1,12 @@
package TAP::Parser::SourceHandler::RawTAP;
use strict;
-use vars qw($VERSION @ISA);
+use warnings;
-use TAP::Parser::SourceHandler ();
use TAP::Parser::IteratorFactory ();
use TAP::Parser::Iterator::Array ();
-@ISA = qw(TAP::Parser::SourceHandler);
+use base 'TAP::Parser::SourceHandler';
TAP::Parser::IteratorFactory->register_handler(__PACKAGE__);
@@ -17,11 +16,11 @@ TAP::Parser::SourceHandler::RawTAP - Stream output from raw TAP in a scalar/arra
=head1 VERSION
-Version 3.26
+Version 3.30
=cut
-$VERSION = '3.26';
+our $VERSION = '3.30';
=head1 SYNOPSIS
diff --git a/Master/tlpkg/tlperl/lib/TAP/Parser/Utils.pm b/Master/tlpkg/tlperl/lib/TAP/Parser/Utils.pm
deleted file mode 100644
index 2096b0ec4f1..00000000000
--- a/Master/tlpkg/tlperl/lib/TAP/Parser/Utils.pm
+++ /dev/null
@@ -1,72 +0,0 @@
-package TAP::Parser::Utils;
-
-use strict;
-use Exporter;
-use vars qw($VERSION @ISA @EXPORT_OK);
-
-@ISA = qw( Exporter );
-@EXPORT_OK = qw( split_shell );
-
-=head1 NAME
-
-TAP::Parser::Utils - Internal TAP::Parser utilities
-
-=head1 VERSION
-
-Version 3.26
-
-=cut
-
-$VERSION = '3.26';
-
-=head1 SYNOPSIS
-
- use TAP::Parser::Utils qw( split_shell )
- my @switches = split_shell( $arg );
-
-=head1 DESCRIPTION
-
-B<FOR INTERNAL USE ONLY!>
-
-=head2 INTERFACE
-
-=head3 C<split_shell>
-
-Shell style argument parsing. Handles backslash escaping, single and
-double quoted strings but not shell substitutions.
-
-Pass one or more strings containing shell escaped arguments. The return
-value is an array of arguments parsed from the input strings according
-to (approximate) shell parsing rules. It's legal to pass C<undef> in
-which case an empty array will be returned. That makes it possible to
-
- my @args = split_shell( $ENV{SOME_ENV_VAR} );
-
-without worrying about whether the environment variable exists.
-
-This is used to split HARNESS_PERL_ARGS into individual switches.
-
-=cut
-
-sub split_shell {
- my @parts = ();
-
- for my $switch ( grep defined && length, @_ ) {
- push @parts, $1 while $switch =~ /
- (
- (?: [^\\"'\s]+
- | \\.
- | " (?: \\. | [^"] )* "
- | ' (?: \\. | [^'] )* '
- )+
- ) /xg;
- }
-
- for (@parts) {
- s/ \\(.) | ['"] /defined $1 ? $1 : ''/exg;
- }
-
- return @parts;
-}
-
-1;
diff --git a/Master/tlpkg/tlperl/lib/TAP/Parser/YAMLish/Reader.pm b/Master/tlpkg/tlperl/lib/TAP/Parser/YAMLish/Reader.pm
index ac2c455ef3e..8a61a4bfd92 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Parser/YAMLish/Reader.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Parser/YAMLish/Reader.pm
@@ -1,12 +1,11 @@
package TAP::Parser::YAMLish::Reader;
use strict;
-use vars qw($VERSION @ISA);
+use warnings;
-use TAP::Object ();
+use base 'TAP::Object';
-@ISA = 'TAP::Object';
-$VERSION = '3.26';
+our $VERSION = '3.30';
# TODO:
# Handle blessed object syntax
@@ -270,7 +269,7 @@ TAP::Parser::YAMLish::Reader - Read YAMLish data from iterator
=head1 VERSION
-Version 3.26
+Version 3.30
=head1 SYNOPSIS
diff --git a/Master/tlpkg/tlperl/lib/TAP/Parser/YAMLish/Writer.pm b/Master/tlpkg/tlperl/lib/TAP/Parser/YAMLish/Writer.pm
index 9f20fb2c31b..811c190d124 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Parser/YAMLish/Writer.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Parser/YAMLish/Writer.pm
@@ -1,12 +1,11 @@
package TAP::Parser::YAMLish::Writer;
use strict;
-use vars qw($VERSION @ISA);
+use warnings;
-use TAP::Object ();
+use base 'TAP::Object';
-@ISA = 'TAP::Object';
-$VERSION = '3.26';
+our $VERSION = '3.30';
my $ESCAPE_CHAR = qr{ [ \x00-\x1f \" ] }x;
my $ESCAPE_KEY = qr{ (?: ^\W ) | $ESCAPE_CHAR }x;
@@ -147,7 +146,7 @@ TAP::Parser::YAMLish::Writer - Write YAMLish data
=head1 VERSION
-Version 3.26
+Version 3.30
=head1 SYNOPSIS