summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/TAP
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/TAP')
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Base.pm4
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Formatter/Base.pm25
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Formatter/Color.pm4
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Formatter/Console.pm6
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Formatter/Console/ParallelSession.pm6
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Formatter/Console/Session.pm4
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Formatter/File.pm4
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Formatter/File/Session.pm4
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Formatter/Session.pm4
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Harness.pm283
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Harness/Beyond.pod417
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Object.pm25
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Parser.pm389
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Parser/Aggregator.pm10
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Parser/Grammar.pm48
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Parser/Iterator.pm16
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Parser/Iterator/Array.pm14
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Parser/Iterator/Process.pm34
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Parser/Iterator/Stream.pm14
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Parser/IteratorFactory.pm327
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Parser/Multiplexer.pm4
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Parser/Result.pm6
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Parser/Result/Bailout.pm4
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Parser/Result/Comment.pm4
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Parser/Result/Plan.pm4
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Parser/Result/Pragma.pm4
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Parser/Result/Test.pm6
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Parser/Result/Unknown.pm4
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Parser/Result/Version.pm4
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Parser/Result/YAML.pm4
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Parser/ResultFactory.pm4
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Parser/Scheduler.pm6
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Parser/Scheduler/Job.pm4
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Parser/Scheduler/Spinner.pm4
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Parser/Source.pm374
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Parser/Source/Perl.pm326
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Parser/SourceHandler.pm194
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Parser/SourceHandler/Executable.pm186
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Parser/SourceHandler/File.pm136
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Parser/SourceHandler/Handle.pm125
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Parser/SourceHandler/Perl.pm362
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Parser/SourceHandler/RawTAP.pm131
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Parser/Utils.pm4
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Parser/YAMLish/Reader.pm8
-rw-r--r--Master/tlpkg/tlperl/lib/TAP/Parser/YAMLish/Writer.pm6
45 files changed, 2679 insertions, 873 deletions
diff --git a/Master/tlpkg/tlperl/lib/TAP/Base.pm b/Master/tlpkg/tlperl/lib/TAP/Base.pm
index f88ad11134c..9f91cad0663 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Base.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Base.pm
@@ -14,11 +14,11 @@ and L<TAP::Harness>
=head1 VERSION
-Version 3.17
+Version 3.23
=cut
-$VERSION = '3.17';
+$VERSION = '3.23';
use constant GOT_TIME_HIRES => do {
eval 'use Time::HiRes qw(time);';
diff --git a/Master/tlpkg/tlperl/lib/TAP/Formatter/Base.pm b/Master/tlpkg/tlperl/lib/TAP/Formatter/Base.pm
index f2b54a9ba3e..678ea2f0e3d 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Formatter/Base.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Formatter/Base.pm
@@ -43,15 +43,15 @@ BEGIN {
=head1 NAME
-TAP::Formatter::Console - Harness output delegate for default console output
+TAP::Formatter::Base - Base class for harness output delegates
=head1 VERSION
-Version 3.17
+Version 3.23
=cut
-$VERSION = '3.17';
+$VERSION = '3.23';
=head1 DESCRIPTION
@@ -206,7 +206,7 @@ sub prepare {
my $longest = 0;
- foreach my $test (@tests) {
+ for my $test (@tests) {
$longest = length $test if length $test > $longest;
}
@@ -257,13 +257,15 @@ sub _output_success {
$harness->summary( $aggregate );
-C<summary> prints the summary report after all tests are run. The argument is
-an aggregate.
+C<summary> prints the summary report after all tests are run. The first
+argument is an aggregate to summarise. An optional second argument may
+be set to a true value to indicate that the summary is being output as a
+result of an interrupted test run.
=cut
sub summary {
- my ( $self, $aggregate ) = @_;
+ my ( $self, $aggregate, $interrupted ) = @_;
return if $self->silent;
@@ -279,6 +281,9 @@ sub summary {
$self->_output( $self->_format_now(), "\n" );
}
+ $self->_failure_output("Test run interrupted!\n")
+ if $interrupted;
+
# TODO: Check this condition still works when all subtests pass but
# the exit status is nonzero
@@ -290,7 +295,7 @@ sub summary {
if ( $total != $passed or $aggregate->has_problems ) {
$self->_output("\nTest Summary Report");
$self->_output("\n-------------------\n");
- foreach my $test (@$tests) {
+ for my $test (@$tests) {
$self->_printed_summary_header(0);
my ($parser) = $aggregate->parsers($test);
$self->_output_summary_failure(
@@ -330,7 +335,7 @@ sub summary {
sprintf " Parse errors: %s\n",
shift @errors
);
- foreach my $error (@errors) {
+ for my $error (@errors) {
my $spaces = ' ' x 16;
$self->_failure_output("$spaces$error\n");
}
@@ -422,7 +427,7 @@ sub _range {
@numbers = sort { $a <=> $b } @numbers;
my ( $min, @range );
- foreach my $i ( 0 .. $#numbers ) {
+ for my $i ( 0 .. $#numbers ) {
my $num = $numbers[$i];
my $next = $numbers[ $i + 1 ];
if ( defined $next && $next == $num + 1 ) {
diff --git a/Master/tlpkg/tlperl/lib/TAP/Formatter/Color.pm b/Master/tlpkg/tlperl/lib/TAP/Formatter/Color.pm
index 349d3b84bf4..abf885b0f93 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Formatter/Color.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Formatter/Color.pm
@@ -71,11 +71,11 @@ TAP::Formatter::Color - Run Perl test scripts with color
=head1 VERSION
-Version 3.17
+Version 3.23
=cut
-$VERSION = '3.17';
+$VERSION = '3.23';
=head1 DESCRIPTION
diff --git a/Master/tlpkg/tlperl/lib/TAP/Formatter/Console.pm b/Master/tlpkg/tlperl/lib/TAP/Formatter/Console.pm
index aeca2f2b0d5..8925e864736 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Formatter/Console.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Formatter/Console.pm
@@ -14,11 +14,11 @@ TAP::Formatter::Console - Harness output delegate for default console output
=head1 VERSION
-Version 3.17
+Version 3.23
=cut
-$VERSION = '3.17';
+$VERSION = '3.23';
=head1 DESCRIPTION
@@ -31,7 +31,7 @@ This provides console orientated output formatting for TAP::Harness.
=head2 C<< open_test >>
-See L<TAP::Formatter::base>
+See L<TAP::Formatter::Base>
=cut
diff --git a/Master/tlpkg/tlperl/lib/TAP/Formatter/Console/ParallelSession.pm b/Master/tlpkg/tlperl/lib/TAP/Formatter/Console/ParallelSession.pm
index b6b5134cda1..1997564ade1 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Formatter/Console/ParallelSession.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Formatter/Console/ParallelSession.pm
@@ -42,11 +42,11 @@ TAP::Formatter::Console::ParallelSession - Harness output delegate for parallel
=head1 VERSION
-Version 3.17
+Version 3.23
=cut
-$VERSION = '3.17';
+$VERSION = '3.23';
=head1 DESCRIPTION
@@ -94,7 +94,7 @@ sub _output_ruler {
my $ruler = sprintf '===( %7d;%d ', $context->{tests}, $now - $start;
- foreach my $active ( @{ $context->{active} } ) {
+ for my $active ( @{ $context->{active} } ) {
my $parser = $active->parser;
my $tests = $parser->tests_run;
my $planned = $parser->tests_planned || '?';
diff --git a/Master/tlpkg/tlperl/lib/TAP/Formatter/Console/Session.pm b/Master/tlpkg/tlperl/lib/TAP/Formatter/Console/Session.pm
index 675512c71d0..b9cdc08eb00 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Formatter/Console/Session.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Formatter/Console/Session.pm
@@ -28,11 +28,11 @@ TAP::Formatter::Console::Session - Harness output delegate for default console o
=head1 VERSION
-Version 3.17
+Version 3.23
=cut
-$VERSION = '3.17';
+$VERSION = '3.23';
=head1 DESCRIPTION
diff --git a/Master/tlpkg/tlperl/lib/TAP/Formatter/File.pm b/Master/tlpkg/tlperl/lib/TAP/Formatter/File.pm
index 8514bc068bb..aaad61b06b3 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Formatter/File.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Formatter/File.pm
@@ -15,11 +15,11 @@ TAP::Formatter::File - Harness output delegate for file output
=head1 VERSION
-Version 3.17
+Version 3.23
=cut
-$VERSION = '3.17';
+$VERSION = '3.23';
=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 c6abfd63bcc..e7d576ef904 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Formatter/File/Session.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Formatter/File/Session.pm
@@ -13,11 +13,11 @@ TAP::Formatter::File::Session - Harness output delegate for file output
=head1 VERSION
-Version 3.17
+Version 3.23
=cut
-$VERSION = '3.17';
+$VERSION = '3.23';
=head1 DESCRIPTION
diff --git a/Master/tlpkg/tlperl/lib/TAP/Formatter/Session.pm b/Master/tlpkg/tlperl/lib/TAP/Formatter/Session.pm
index 21767e5eba7..5c0f57cca21 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Formatter/Session.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Formatter/Session.pm
@@ -25,11 +25,11 @@ TAP::Formatter::Session - Abstract base class for harness output delegate
=head1 VERSION
-Version 3.17
+Version 3.23
=cut
-$VERSION = '3.17';
+$VERSION = '3.23';
=head1 METHODS
diff --git a/Master/tlpkg/tlperl/lib/TAP/Harness.pm b/Master/tlpkg/tlperl/lib/TAP/Harness.pm
index 749e7af4166..2c663ae0204 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Harness.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Harness.pm
@@ -19,11 +19,11 @@ TAP::Harness - Run test scripts with statistics
=head1 VERSION
-Version 3.17
+Version 3.23
=cut
-$VERSION = '3.17';
+$VERSION = '3.23';
$ENV{HARNESS_ACTIVE} = 1;
$ENV{HARNESS_VERSION} = $VERSION;
@@ -84,6 +84,9 @@ BEGIN {
test_args => sub { shift; shift },
ignore_exit => sub { shift; shift },
rules => sub { shift; shift },
+ sources => sub { shift; shift },
+ version => sub { shift; shift },
+ trap => sub { shift; shift },
);
for my $method ( sort keys %VALIDATION_FOR ) {
@@ -192,6 +195,16 @@ only makes sense in the context of tests written in Perl.
A reference to an C<@INC> style array of arguments to be passed to each
test program.
+ test_args => ['foo', 'bar'],
+
+if you want to pass different arguments to each test then you should
+pass a hash of arrays, keyed by the alias for each test:
+
+ test_args => {
+ my_test => ['foo', 'bar'],
+ other_test => ['baz'],
+ }
+
=item * C<color>
Attempt to produce color output.
@@ -229,11 +242,41 @@ will be interpreted as raw TAP or as a TAP stream, respectively.
If C<merge> is true the harness will create parsers that merge STDOUT
and STDERR together for any processes they start.
+=item * C<sources>
+
+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
+L<TAP::Parser::Source/config_for>.
+
+For example:
+
+ sources => {
+ Perl => { exec => '/path/to/custom/perl' },
+ File => { extensions => [ '.tap', '.txt' ] },
+ MyCustom => { some => 'config' },
+ }
+
+The C<sources> parameter affects how C<source>, C<tap> and C<exec> parameters
+are handled.
+
+For more details, see the C<sources> parameter in L<TAP::Parser/new>,
+L<TAP::Parser::Source>, and L<TAP::Parser::IteratorFactory>.
+
=item * C<aggregator_class>
The name of the class to use to aggregate test results. The default is
L<TAP::Parser::Aggregator>.
+=item * C<version>
+
+I<NEW to 3.22>.
+
+Assume this TAP version for L<TAP::Parser> instead of default TAP
+version 12.
+
=item * C<formatter_class>
The name of the class to use to format output. The default is
@@ -306,6 +349,11 @@ interface may change.
A filehandle for catching standard output.
+=item * C<trap>
+
+Attempt to print summary information if run is interrupted by
+SIGINT (Ctrl-C).
+
=back
Any keys for which the value is C<undef> will be ignored.
@@ -393,7 +441,7 @@ Any keys for which the value is C<undef> will be ignored.
$harness->runtests(@tests);
-Accepts and array of C<@tests> to be run. This should generally be the
+Accepts an array of C<@tests> to be run. This should generally be the
names of test files, but this is not required. Each element in C<@tests>
will be passed to C<TAP::Parser::new()> as a C<source>. See
L<TAP::Parser> for more information.
@@ -427,23 +475,43 @@ sub runtests {
$self->_make_callback( 'before_runtests', $aggregate );
$aggregate->start;
- $self->aggregate_tests( $aggregate, @tests );
- $aggregate->stop;
- $self->summary($aggregate);
- $self->_make_callback( 'after_runtests', $aggregate );
+ my $finish = sub {
+ my $interrupted = shift;
+ $aggregate->stop;
+ $self->summary( $aggregate, $interrupted );
+ $self->_make_callback( 'after_runtests', $aggregate );
+ };
+ my $run = sub {
+ $self->aggregate_tests( $aggregate, @tests );
+ $finish->();
+ };
+
+ if ( $self->trap ) {
+ local $SIG{INT} = sub {
+ print "\n";
+ $finish->(1);
+ exit;
+ };
+ $run->();
+ }
+ else {
+ $run->();
+ }
return $aggregate;
}
=head3 C<summary>
-Output the summary for a TAP::Parser::Aggregator.
+ $harness->summary( $aggregator );
+
+Output the summary for a L<TAP::Parser::Aggregator>.
=cut
sub summary {
- my ( $self, $aggregate ) = @_;
- $self->formatter->summary($aggregate);
+ my ( $self, @args ) = @_;
+ $self->formatter->summary(@args);
}
sub _after_test {
@@ -533,7 +601,7 @@ sub _aggregate_single {
$harness->aggregate_tests( $aggregate, @tests );
Run the named tests and display a summary of result. Tests will be run
-in the order found.
+in the order found.
Test results will be added to the supplied L<TAP::Parser::Aggregator>.
C<aggregate_tests> may be called multiple times to run several sets of
@@ -561,20 +629,23 @@ are unsuitable for parallel execution.
Note that for simpler testing requirements it will often be possible to
replace the above code with a single call to C<runtests>.
-Each elements of the @tests array is either
+Each element of the C<@tests> array is either:
=over
-=item * the file name of a test script to run
+=item * the source name of a test to run
-=item * a reference to a [ file name, display name ] array
+=item * a reference to a [ source name, display name ] array
=back
+In the case of a perl test suite, typically I<source names> are simply the file
+names of the test scripts to run.
+
When you supply a separate display name it becomes possible to run a
test more than once; the display name is effectively the alias by which
the test is known inside the harness. The harness doesn't care if it
-runs the same script more than once when each invocation uses a
+runs the same test more than once when each invocation uses a
different name.
=cut
@@ -639,59 +710,13 @@ should be set higher.
##############################################################################
-=head1 SUBCLASSING
-
-C<TAP::Harness> is designed to be (mostly) easy to subclass. If you
-don't like how a particular feature functions, just override the
-desired methods.
-
-=head2 Methods
-
-TODO: This is out of date
-
-The following methods are ones you may wish to override if you want to
-subclass C<TAP::Harness>.
-
-=head3 C<summary>
-
- $harness->summary( \%args );
-
-C<summary> prints the summary report after all tests are run. The
-argument is a hashref with the following keys:
-
-=over 4
-
-=item * C<start>
-
-This is created with C<< Benchmark->new >> and it the time the tests
-started. You can print a useful summary time, if desired, with:
-
- $self->output(
- timestr( timediff( Benchmark->new, $start_time ), 'nop' ) );
-
-=item * C<tests>
-
-This is an array reference of all test names. To get the L<TAP::Parser>
-object for individual tests:
-
- my $aggregate = $args->{aggregate};
- my $tests = $args->{tests};
-
- for my $name ( @$tests ) {
- my ($parser) = $aggregate->parsers($test);
- ... do something with $parser
- }
-
-This is a bit clunky and will be cleaned up in a later release.
-
-=back
-
-=cut
-
sub _get_parser_args {
my ( $self, $job ) = @_;
my $test_prog = $job->filename;
my %args = ();
+
+ $args{sources} = $self->sources if $self->sources;
+
my @switches;
@switches = $self->lib if $self->lib;
push @switches => $self->switches if $self->switches;
@@ -699,6 +724,7 @@ sub _get_parser_args {
$args{spool} = $self->_open_spool($test_prog);
$args{merge} = $self->merge;
$args{ignore_exit} = $self->ignore_exit;
+ $args{version} = $self->version if $self->version;
if ( my $exec = $self->exec ) {
$args{exec}
@@ -717,6 +743,19 @@ sub _get_parser_args {
}
if ( defined( my $test_args = $self->test_args ) ) {
+
+ if ( ref($test_args) eq 'HASH' ) {
+
+ # different args for each test
+ if ( exists( $test_args->{ $job->description } ) ) {
+ $test_args = $test_args->{ $job->description };
+ }
+ else {
+ $self->_croak( "TAP::Harness Can't find test_args for "
+ . $job->description );
+ }
+ }
+
$args{test_args} = $test_args;
}
@@ -807,6 +846,120 @@ sub _croak {
return;
}
+1;
+
+__END__
+
+##############################################################################
+
+=head1 CONFIGURING
+
+C<TAP::Harness> is designed to be easy to configure.
+
+=head2 Plugins
+
+C<TAP::Parser> plugins let you change the way TAP is I<input> to and I<output>
+from the parser.
+
+L<TAP::Parser::SourceHandler>s handle TAP I<input>. You can configure them
+and load custom handlers using the C<sources> parameter to L</new>.
+
+L<TAP::Formatter>s handle TAP I<output>. You can load custom formatters by
+using the C<formatter_class> parameter to L</new>. To configure a formatter,
+you currently need to instantiate it outside of L<TAP::Harness> and pass it in
+with the C<formatter> parameter to L</new>. This I<may> be addressed by adding
+a I<formatters> parameter to L</new> in the future.
+
+=head2 C<Module::Build>
+
+L<Module::Build> version C<0.30> supports C<TAP::Harness>.
+
+To load C<TAP::Harness> plugins, you'll need to use the C<tap_harness_args>
+parameter to C<new>, typically from your C<Build.PL>. For example:
+
+ Module::Build->new(
+ module_name => 'MyApp',
+ test_file_exts => [qw(.t .tap .txt)],
+ use_tap_harness => 1,
+ tap_harness_args => {
+ sources => {
+ MyCustom => {},
+ File => {
+ extensions => ['.tap', '.txt'],
+ },
+ },
+ formatter => 'TAP::Formatter::HTML',
+ },
+ build_requires => {
+ 'Module::Build' => '0.30',
+ 'TAP::Harness' => '3.18',
+ },
+ )->create_build_script;
+
+See L</new>
+
+=head2 C<ExtUtils::MakeMaker>
+
+L<ExtUtils::MakeMaker> does not support L<TAP::Harness> out-of-the-box.
+
+=head2 C<prove>
+
+L<prove> supports C<TAP::Harness> plugins, and has a plugin system of its
+own. See L<prove/FORMATTERS>, L<prove/SOURCE HANDLERS> and L<App::Prove>
+for more details.
+
+=head1 WRITING PLUGINS
+
+If you can't configure C<TAP::Harness> to do what you want, and you can't find
+an existing plugin, consider writing one.
+
+The two primary use cases supported by L<TAP::Harness> for plugins are I<input>
+and I<output>:
+
+=over 2
+
+=item Customize how TAP gets into the parser
+
+To do this, you can either extend an existing L<TAP::Parser::SourceHandler>,
+or write your own. It's a pretty simple API, and they can be loaded and
+configured using the C<sources> parameter to L</new>.
+
+=item Customize how TAP results are output from the parser
+
+To do this, you can either extend an existing L<TAP::Formatter>, or write your
+own. Writing formatters are a bit more involved than writing a
+I<SourceHandler>, as you'll need to understand the L<TAP::Parser> API. A
+good place to start is by understanding how L</aggregate_tests> works.
+
+Custom formatters can be loaded configured using the C<formatter_class>
+parameter to L</new>.
+
+=back
+
+=head1 SUBCLASSING
+
+If you can't configure C<TAP::Harness> to do exactly what you want, and writing
+a plugin isn't an option, consider extending it. It is designed to be (mostly)
+easy to subclass, though the cases when sub-classing is necessary should be few
+and far between.
+
+=head2 Methods
+
+The following methods are ones you may wish to override if you want to
+subclass C<TAP::Harness>.
+
+=over 4
+
+=item L</new>
+
+=item L</runtests>
+
+=item L</summary>
+
+=back
+
+=cut
+
=head1 REPLACING
If you like the C<prove> utility and L<TAP::Parser> but you want your
@@ -825,6 +978,4 @@ L<Test::Harness>
=cut
-1;
-
# vim:ts=4:sw=4:et:sta
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..ed77e13c253
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/TAP/Harness/Beyond.pod
@@ -0,0 +1,417 @@
+=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 qw( 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/Object.pm b/Master/tlpkg/tlperl/lib/TAP/Object.pm
index 498bb805c91..e933179c916 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Object.pm
+++ b/Master/tlpkg/tlperl/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.17
+Version 3.23
=cut
-$VERSION = '3.17';
+$VERSION = '3.23';
=head1 SYNOPSIS
@@ -93,6 +93,25 @@ sub _croak {
return;
}
+=head3 C<_confess>
+
+Raise an exception using C<confess> from L<Carp>, eg:
+
+ $self->_confess( 'why me?', 'aaarrgh!' );
+
+May also be called as a I<class> method.
+
+ $class->_confess( 'this works too' );
+
+=cut
+
+sub _confess {
+ my $proto = shift;
+ require Carp;
+ Carp::confess(@_);
+ return;
+}
+
=head3 C<_construct>
Create a new instance of the specified class.
@@ -124,7 +143,7 @@ Create simple getter/setters.
sub mk_methods {
my ( $class, @methods ) = @_;
- foreach my $method_name (@methods) {
+ for my $method_name (@methods) {
my $method = "${class}::$method_name";
no strict 'refs';
*$method = sub {
diff --git a/Master/tlpkg/tlperl/lib/TAP/Parser.pm b/Master/tlpkg/tlperl/lib/TAP/Parser.pm
index ea3acd907ff..55edb0dbd87 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Parser.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Parser.pm
@@ -3,14 +3,18 @@ package TAP::Parser;
use strict;
use vars qw($VERSION @ISA);
-use TAP::Base ();
-use TAP::Parser::Grammar ();
-use TAP::Parser::Result ();
-use TAP::Parser::ResultFactory ();
-use TAP::Parser::Source ();
-use TAP::Parser::Source::Perl ();
-use TAP::Parser::Iterator ();
-use TAP::Parser::IteratorFactory ();
+use TAP::Base ();
+use TAP::Parser::Grammar ();
+use TAP::Parser::Result ();
+use TAP::Parser::ResultFactory ();
+use TAP::Parser::Source ();
+use TAP::Parser::Iterator ();
+use TAP::Parser::IteratorFactory ();
+use TAP::Parser::SourceHandler::Executable ();
+use TAP::Parser::SourceHandler::Perl ();
+use TAP::Parser::SourceHandler::File ();
+use TAP::Parser::SourceHandler::RawTAP ();
+use TAP::Parser::SourceHandler::Handle ();
use Carp qw( confess );
@@ -20,11 +24,11 @@ TAP::Parser - Parse L<TAP|Test::Harness::TAP> output
=head1 VERSION
-Version 3.17
+Version 3.23
=cut
-$VERSION = '3.17';
+$VERSION = '3.23';
my $DEFAULT_TAP_VERSION = 12;
my $MAX_TAP_VERSION = 13;
@@ -42,7 +46,7 @@ BEGIN { # making accessors
__PACKAGE__->mk_methods(
qw(
- _stream
+ _iterator
_spool
exec
exit
@@ -56,13 +60,16 @@ BEGIN { # making accessors
start_time
end_time
skip_all
- source_class
- perl_source_class
grammar_class
- iterator_factory_class
result_factory_class
+ iterator_factory_class
)
);
+
+ sub _stream { # deprecated
+ my $self = shift;
+ $self->_iterator(@_);
+ }
} # done making accessors
=head1 SYNOPSIS
@@ -105,39 +112,55 @@ The arguments should be a hashref with I<one> of the following keys:
=item * C<source>
-This is the preferred method of passing arguments to the constructor. To
-determine how to handle the source, the following steps are taken.
+I<CHANGED in 3.18>
-If the source contains a newline, it's assumed to be a string of raw TAP
-output.
+This is the preferred method of passing input to the constructor.
-If the source is a reference, it's assumed to be something to pass to
-the L<TAP::Parser::Iterator::Stream> constructor. This is used
-internally and you should not use it.
+The C<source> is used to create a L<TAP::Parser::Source> that is passed to the
+L</iterator_factory_class> which in turn figures out how to handle the source and
+creates a <TAP::Parser::Iterator> for it. The iterator is used by the parser to
+read in the TAP stream.
-Otherwise, the parser does a C<-e> check to see if the source exists. If so,
-it attempts to execute the source and read the output as a stream. This is by
-far the preferred method of using the parser.
+To configure the I<IteratorFactory> use the C<sources> parameter below.
- foreach my $file ( @test_files ) {
- my $parser = TAP::Parser->new( { source => $file } );
- # do stuff with the parser
- }
+Note that C<source>, C<tap> and C<exec> are I<mutually exclusive>.
=item * C<tap>
+I<CHANGED in 3.18>
+
The value should be the complete TAP output.
+The I<tap> is used to create a L<TAP::Parser::Source> that is passed to the
+L</iterator_factory_class> which in turn figures out how to handle the source and
+creates a <TAP::Parser::Iterator> for it. The iterator is used by the parser to
+read in the TAP stream.
+
+To configure the I<IteratorFactory> use the C<sources> parameter below.
+
+Note that C<source>, C<tap> and C<exec> are I<mutually exclusive>.
+
=item * C<exec>
-If passed an array reference, will attempt to create the iterator by
-passing a L<TAP::Parser::Source> object to
-L<TAP::Parser::Iterator::Source>, using the array reference strings as
-the command arguments to L<IPC::Open3::open3|IPC::Open3>:
+Must be passed an array reference.
+
+The I<exec> array ref is used to create a L<TAP::Parser::Source> that is passed
+to the L</iterator_factory_class> which in turn figures out how to handle the
+source and creates a <TAP::Parser::Iterator> for it. The iterator is used by
+the parser to read in the TAP stream.
+
+By default the L<TAP::Parser::SourceHandler::Executable> class will create a
+L<TAP::Parser::Iterator::Process> object to handle the source. This passes the
+array reference strings as command arguments to L<IPC::Open3::open3|IPC::Open3>:
exec => [ '/usr/bin/ruby', 't/my_test.rb' ]
-Note that C<source> and C<exec> are mutually exclusive.
+If any C<test_args> are given they will be appended to the end of the command
+argument list.
+
+To configure the I<IteratorFactory> use the C<sources> parameter below.
+
+Note that C<source>, C<tap> and C<exec> are I<mutually exclusive>.
=back
@@ -145,6 +168,34 @@ The following keys are optional.
=over 4
+=item * C<sources>
+
+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
+L<TAP::Parser::Source/config_for>.
+
+For example:
+
+ sources => {
+ Perl => { exec => '/path/to/custom/perl' },
+ File => { extensions => [ '.tap', '.txt' ] },
+ MyCustom => { some => 'config' },
+ }
+
+This will cause C<TAP::Parser> to pass custom configuration to two of the built-
+in source handlers - L<TAP::Parser::SourceHandler::Perl>,
+L<TAP::Parser::SourceHandler::File> - and attempt to load the C<MyCustom>
+class. See L<TAP::Parser::IteratorFactory/load_handlers> for more detail.
+
+The C<sources> parameter affects how C<source>, C<tap> and C<exec> parameters
+are handled.
+
+See L<TAP::Parser::IteratorFactory>, L<TAP::Parser::SourceHandler> and subclasses for
+more details.
+
=item * C<callback>
If present, each callback corresponding to a given result type will be called
@@ -159,7 +210,7 @@ with the result as the argument if the C<run> method is used:
);
my $aggregator = TAP::Parser::Aggregator->new;
- foreach my $file ( @test_files ) {
+ for my $file ( @test_files ) {
my $parser = TAP::Parser->new(
{
source => $file,
@@ -177,13 +228,13 @@ be used when invoking the perl executable.
my $parser = TAP::Parser->new( {
source => $test_file,
- switches => '-Ilib',
+ switches => [ '-Ilib' ],
} );
=item * C<test_args>
-Used in conjunction with the C<source> option to supply a reference to
-an C<@ARGV> style array of arguments to pass to the test program.
+Used in conjunction with the C<source> and C<exec> option to supply a reference
+to an C<@ARGV> style array of arguments to pass to the test program.
=item * C<spool>
@@ -201,20 +252,6 @@ allow exact synchronization.
Subtleties of this behavior may be platform-dependent and may change in
the future.
-=item * C<source_class>
-
-This option was introduced to let you easily customize which I<source> class
-the parser should use. It defaults to L<TAP::Parser::Source>.
-
-See also L</make_source>.
-
-=item * C<perl_source_class>
-
-This option was introduced to let you easily customize which I<perl source>
-class the parser should use. It defaults to L<TAP::Parser::Source::Perl>.
-
-See also L</make_perl_source>.
-
=item * C<grammar_class>
This option was introduced to let you easily customize which I<grammar> class
@@ -222,14 +259,6 @@ the parser should use. It defaults to L<TAP::Parser::Grammar>.
See also L</make_grammar>.
-=item * C<iterator_factory_class>
-
-This option was introduced to let you easily customize which I<iterator>
-factory class the parser should use. It defaults to
-L<TAP::Parser::IteratorFactory>.
-
-See also L</make_iterator>.
-
=item * C<result_factory_class>
This option was introduced to let you easily customize which I<result>
@@ -238,6 +267,14 @@ L<TAP::Parser::ResultFactory>.
See also L</make_result>.
+=item * C<iterator_factory_class>
+
+I<CHANGED in 3.18>
+
+This option was introduced to let you easily customize which I<iterator>
+factory class the parser should use. It defaults to
+L<TAP::Parser::IteratorFactory>.
+
=back
=cut
@@ -245,11 +282,9 @@ See also L</make_result>.
# new() implementation supplied by TAP::Base
# This should make overriding behaviour of the Parser in subclasses easier:
-sub _default_source_class {'TAP::Parser::Source'}
-sub _default_perl_source_class {'TAP::Parser::Source::Perl'}
sub _default_grammar_class {'TAP::Parser::Grammar'}
-sub _default_iterator_factory_class {'TAP::Parser::IteratorFactory'}
sub _default_result_factory_class {'TAP::Parser::ResultFactory'}
+sub _default_iterator_factory_class {'TAP::Parser::IteratorFactory'}
##############################################################################
@@ -297,20 +332,6 @@ sub run {
##############################################################################
-=head3 C<make_source>
-
-Make a new L<TAP::Parser::Source> object and return it. Passes through any
-arguments given.
-
-The C<source_class> can be customized, as described in L</new>.
-
-=head3 C<make_perl_source>
-
-Make a new L<TAP::Parser::Source::Perl> object and return it. Passes through
-any arguments given.
-
-The C<perl_source_class> can be customized, as described in L</new>.
-
=head3 C<make_grammar>
Make a new L<TAP::Parser::Grammar> object and return it. Passes through any
@@ -318,14 +339,6 @@ arguments given.
The C<grammar_class> can be customized, as described in L</new>.
-=head3 C<make_iterator>
-
-Make a new L<TAP::Parser::Iterator> object using the parser's
-L<TAP::Parser::IteratorFactory>, and return it. Passes through any arguments
-given.
-
-The C<iterator_factory_class> can be customized, as described in L</new>.
-
=head3 C<make_result>
Make a new L<TAP::Parser::Result> object using the parser's
@@ -334,28 +347,21 @@ given.
The C<result_factory_class> can be customized, as described in L</new>.
+=head3 C<make_iterator_factory>
+
+I<NEW to 3.18>.
+
+Make a new L<TAP::Parser::IteratorFactory> object and return it. Passes through
+any arguments given.
+
+C<iterator_factory_class> can be customized, as described in L</new>.
+
=cut
# This should make overriding behaviour of the Parser in subclasses easier:
-sub make_source { shift->source_class->new(@_); }
-sub make_perl_source { shift->perl_source_class->new(@_); }
-sub make_grammar { shift->grammar_class->new(@_); }
-sub make_iterator { shift->iterator_factory_class->make_iterator(@_); }
-sub make_result { shift->result_factory_class->make_result(@_); }
-
-sub _iterator_for_source {
- my ( $self, $source ) = @_;
-
- # If the source has a get_stream method then use it. This makes it
- # possible to pass a pre-existing source object to the parser's
- # constructor.
- if ( UNIVERSAL::can( $source, 'can' ) && $source->can('get_stream') ) {
- return $source->get_stream($self);
- }
- else {
- return $self->iterator_factory_class->make_iterator($source);
- }
-}
+sub make_iterator_factory { shift->iterator_factory_class->new(@_); }
+sub make_grammar { shift->grammar_class->new(@_); }
+sub make_result { shift->result_factory_class->make_result(@_); }
{
@@ -364,9 +370,7 @@ sub _iterator_for_source {
my %initialize = (
version => $DEFAULT_TAP_VERSION,
plan => '', # the test plan (e.g., 1..3)
- tap => '', # the TAP
tests_run => 0, # actual current test numbers
- results => [], # TAP parser results
skipped => [], #
todo => [], #
passed => [], #
@@ -393,18 +397,16 @@ sub _iterator_for_source {
);
my @class_overrides = qw(
- source_class
- perl_source_class
grammar_class
- iterator_factory_class
result_factory_class
+ iterator_factory_class
);
sub _initialize {
my ( $self, $arg_for ) = @_;
# everything here is basically designed to convert any TAP source to a
- # stream.
+ # TAP::Parser::Iterator.
# Shallow copy
my %args = %{ $arg_for || {} };
@@ -418,19 +420,22 @@ sub _iterator_for_source {
$self->$key($val);
}
- my $stream = delete $args{stream};
+ my $iterator = delete $args{iterator};
+ $iterator ||= delete $args{stream}; # deprecated
my $tap = delete $args{tap};
- my $source = delete $args{source};
+ my $version = delete $args{version};
+ my $raw_source = delete $args{source};
+ my $sources = delete $args{sources};
my $exec = delete $args{exec};
my $merge = delete $args{merge};
my $spool = delete $args{spool};
my $switches = delete $args{switches};
my $ignore_exit = delete $args{ignore_exit};
- my @test_args = @{ delete $args{test_args} || [] };
+ my $test_args = delete $args{test_args} || [];
- if ( 1 < grep {defined} $stream, $tap, $source, $exec ) {
+ if ( 1 < grep {defined} $iterator, $tap, $raw_source, $exec ) {
$self->_croak(
- "You may only choose one of 'exec', 'stream', 'tap' or 'source'"
+ "You may only choose one of 'exec', 'tap', 'source' or 'iterator'"
);
}
@@ -438,47 +443,43 @@ sub _iterator_for_source {
$self->_croak("Unknown options: @excess");
}
+ # convert $tap & $exec to $raw_source equiv.
+ my $type = '';
+ my $source = TAP::Parser::Source->new;
if ($tap) {
- $stream = $self->_iterator_for_source( [ split "\n" => $tap ] );
+ $type = 'raw TAP';
+ $source->raw( \$tap );
}
elsif ($exec) {
- my $source = $self->make_source;
- $source->source( [ @$exec, @test_args ] );
- $source->merge($merge); # XXX should just be arguments?
- $stream = $source->get_stream($self);
+ $type = 'exec ' . $exec->[0];
+ $source->raw( { exec => $exec } );
+ }
+ elsif ($raw_source) {
+ $type = 'source ' . ref($raw_source) || $raw_source;
+ $source->raw( ref($raw_source) ? $raw_source : \$raw_source );
+ }
+ elsif ($iterator) {
+ $type = 'iterator ' . ref($iterator);
}
- elsif ($source) {
- if ( $source =~ /\n/ ) {
- $stream
- = $self->_iterator_for_source( [ split "\n" => $source ] );
- }
- elsif ( ref $source ) {
- $stream = $self->_iterator_for_source($source);
- }
- elsif ( -e $source ) {
- my $perl = $self->make_perl_source;
-
- $perl->switches($switches)
- if $switches;
- $perl->merge($merge); # XXX args to new()?
- $perl->source( [ $source, @test_args ] );
- $stream = $perl->get_stream($self);
- }
- else {
- $self->_croak("Cannot determine source for $source");
- }
+ if ( $source->raw ) {
+ my $src_factory = $self->make_iterator_factory($sources);
+ $source->merge($merge)->switches($switches)
+ ->test_args($test_args);
+ $iterator = $src_factory->make_iterator($source);
}
- unless ($stream) {
- $self->_croak('PANIC: could not determine stream');
+ unless ($iterator) {
+ $self->_croak(
+ "PANIC: could not determine iterator for input $type");
}
while ( my ( $k, $v ) = each %initialize ) {
$self->{$k} = 'ARRAY' eq ref $v ? [] : $v;
}
- $self->_stream($stream);
+ $self->version($version) if $version;
+ $self->_iterator($iterator);
$self->_spool($spool);
$self->ignore_exit($ignore_exit);
@@ -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<commment> methods
+=head2 C<comment> methods
if ( $result->is_comment ) { ... }
@@ -715,7 +716,7 @@ line.
my $explanation = $result->explanation;
If a test had either a C<TODO> or C<SKIP> directive, this method will return
-the accompanying explantion, if present.
+the accompanying explanation, if present.
not ok 17 - 'Pigs can fly' # TODO not enough acid
@@ -1043,7 +1044,7 @@ an executable, it returns the exit status of the executable.
Once the parser is done, this will return the wait status. If the parser ran
an executable, it returns the wait status of the executable. Otherwise, this
-mererely returns the C<exit> status.
+merely returns the C<exit> status.
=head2 C<ignore_exit>
@@ -1308,7 +1309,7 @@ sub _make_state_table {
UNPLANNED_AFTER_TEST => {
test => { act => sub { }, continue => 'UNPLANNED' },
plan => { act => sub { }, continue => 'UNPLANNED' },
- yaml => { goto => 'PLANNED' },
+ yaml => { goto => 'UNPLANNED' },
},
);
@@ -1341,23 +1342,23 @@ determine the readiness of this parser.
=cut
-sub get_select_handles { shift->_stream->get_select_handles }
+sub get_select_handles { shift->_iterator->get_select_handles }
sub _grammar {
my $self = shift;
return $self->{_grammar} = shift if @_;
return $self->{_grammar} ||= $self->make_grammar(
- { stream => $self->_stream,
- parser => $self,
- version => $self->version
+ { iterator => $self->_iterator,
+ parser => $self,
+ version => $self->version
}
);
}
sub _iter {
my $self = shift;
- my $stream = $self->_stream;
+ my $iterator = $self->_iterator;
my $grammar = $self->_grammar;
my $spool = $self->_spool;
my $state = 'INIT';
@@ -1394,8 +1395,8 @@ sub _iter {
# Handle end of stream - which means either pop a block or finish
my $end_handler = sub {
- $self->exit( $stream->exit );
- $self->wait( $stream->wait );
+ $self->exit( $iterator->exit );
+ $self->wait( $iterator->wait );
$self->_finish;
return;
};
@@ -1458,7 +1459,7 @@ sub _finish {
$self->end_time( $self->get_time );
# Avoid leaks
- $self->_stream(undef);
+ $self->_iterator(undef);
$self->_grammar(undef);
# If we just delete the iter we won't get a fault if it's recreated.
@@ -1532,7 +1533,7 @@ result as its argument.
);
my $aggregator = TAP::Parser::Aggregator->new;
- foreach my $file ( @test_files ) {
+ for my $file ( @test_files ) {
my $parser = TAP::Parser->new(
{
source => $file,
@@ -1635,9 +1636,9 @@ passed instead.
If you're looking for an EBNF grammar, see L<TAP::Parser::Grammar>.
-=head1 BACKWARDS COMPATABILITY
+=head1 BACKWARDS COMPATIBILITY
-The Perl-QA list attempted to ensure backwards compatability with
+The Perl-QA list attempted to ensure backwards compatibility with
L<Test::Harness>. However, there are some minor differences.
=head2 Differences
@@ -1685,7 +1686,7 @@ never run. They're reported as parse failures (tests out of sequence).
If you find you need to provide custom functionality (as you would have using
L<Test::Harness::Straps>), you're in luck: C<TAP::Parser> and friends are
-designed to be easily subclassed.
+designed to be easily plugged-into and/or subclassed.
Before you start, it's important to know a few things:
@@ -1697,23 +1698,26 @@ All C<TAP::*> objects inherit from L<TAP::Object>.
=item 2
-Most C<TAP::*> classes have a I<SUBCLASSING> section to guide you.
+Many C<TAP::*> classes have a I<SUBCLASSING> section to guide you.
=item 3
-Note that C<TAP::Parser> is designed to be the central 'maker' - ie: it is
-responsible for creating new objects in the C<TAP::Parser::*> namespace.
+Note that C<TAP::Parser> is designed to be the central "maker" - ie: it is
+responsible for creating most new objects in the C<TAP::Parser::*> namespace.
This makes it possible for you to have a single point of configuring what
-subclasses should be used, which in turn means that in many cases you'll find
+subclasses should be used, which means that in many cases you'll find
you only need to sub-class one of the parser's components.
+The exception to this rule are I<SourceHandlers> & I<Iterators>, but those are
+both created with customizable I<IteratorFactory>.
+
=item 4
By subclassing, you may end up overriding undocumented methods. That's not
a bad thing per se, but be forewarned that undocumented methods may change
without warning from one release to the next - we cannot guarantee backwards
-compatability. If any I<documented> method needs changing, it will be
+compatibility. If any I<documented> method needs changing, it will be
deprecated first, and changed in a later release.
=back
@@ -1722,28 +1726,41 @@ deprecated first, and changed in a later release.
=head3 Sources
-A TAP parser consumes input from a I<source>. There are currently two types
-of sources: L<TAP::Parser::Source> for general non-perl commands, and
-L<TAP::Parser::Source::Perl>. You can subclass both of them. You'll need to
-customize your parser by setting the C<source_class> & C<perl_source_class>
-parameters. See L</new> for more details.
+A TAP parser consumes input from a single I<raw source> of TAP, which could come
+from anywhere (a file, an executable, a database, an IO handle, a URI, etc..).
+The source gets bundled up in a L<TAP::Parser::Source> object which gathers some
+meta data about it. The parser then uses a L<TAP::Parser::IteratorFactory> to
+determine which L<TAP::Parser::SourceHandler> to use to turn the raw source
+into a stream of TAP by way of L</Iterators>.
-If you need to customize the objects on creation, subclass L<TAP::Parser> and
-override L</make_source> or L</make_perl_source>.
+If you simply want C<TAP::Parser> to handle a new source of TAP you probably
+don't need to subclass C<TAP::Parser> itself. Rather, you'll need to create a
+new L<TAP::Parser::SourceHandler> class, and just plug it into the parser using
+the I<sources> param to L</new>. Before you start writing one, read through
+L<TAP::Parser::IteratorFactory> to get a feel for how the system works first.
+
+If you find you really need to use your own iterator factory you can still do
+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
+are now removed.
=head3 Iterators
-A TAP parser uses I<iterators> to loop through the I<stream> provided by the
-parser's I<source>. There are quite a few types of Iterators available.
-Choosing which class to use is the responsibility of the I<iterator factory>.
+A TAP parser uses I<iterators> to loop through the I<stream> of TAP read in
+from the I<source> it was given. There are a few types of Iterators available
+by default, all sub-classes of L<TAP::Parser::Iterator>. Choosing which
+iterator to use is the responsibility of the I<iterator factory>, though it
+simply delegates to the I<Source Handler> it uses.
-To create your own iterators you'll have to subclass
-L<TAP::Parser::IteratorFactory> and L<TAP::Parser::Iterator>. Then you'll
-need to customize the class used by your parser by setting the
-C<iterator_factory_class> parameter. See L</new> for more details.
+If you're writing your own L<TAP::Parser::SourceHandler>, you may need to
+create your own iterators too. If so you'll need to subclass
+L<TAP::Parser::Iterator>.
-If you need to customize the objects on creation, subclass L<TAP::Parser> and
-override L</make_iterator>.
+Note that L</make_iterator> has been I<DEPRECATED> and is now removed.
=head3 Results
@@ -1774,7 +1791,7 @@ override L</make_result>.
=head3 Grammar
-L<TAP::Parser::Grammar> is the heart of the parser - it tokenizes the TAP
+L<TAP::Parser::Grammar> is the heart of the parser. It tokenizes the TAP
input I<stream> and produces results. If you need to customize its behaviour
you should probably familiarize yourself with the source first. Enough
lecturing.
@@ -1785,7 +1802,7 @@ C<grammar_class> parameter. See L</new> for more details.
If you need to customize the objects on creation, subclass L<TAP::Parser> and
override L</make_grammar>
-=head1 ACKNOWLEDGEMENTS
+=head1 ACKNOWLEDGMENTS
All of the following have helped. Bug reports, patches, (im)moral
support, or just words of encouragement have all been forthcoming.
@@ -1830,6 +1847,10 @@ support, or just words of encouragement have all been forthcoming.
=item * Alex Vandiver
+=item * Cosimo Streppone
+
+=item * Ville Skyttä
+
=back
=head1 AUTHORS
@@ -1848,6 +1869,10 @@ Steve Purkis <spurkis@cpan.org>
Nicholas Clark <nick@ccl4.org>
+Lee Johnson <notfadeaway at btinternet dot com>
+
+Philippe Bruhat <book@cpan.org>
+
=head1 BUGS
Please report any bugs or feature requests to
@@ -1859,7 +1884,7 @@ progress on your bug as we make changes.
Obviously, bugs which include patches are best. If you prefer, you can
patch against bleed by via anonymous checkout of the latest version:
- svn checkout http://svn.hexten.net/tapx
+ git clone git://github.com/AndyA/Test-Harness.git
=head1 COPYRIGHT & LICENSE
diff --git a/Master/tlpkg/tlperl/lib/TAP/Parser/Aggregator.pm b/Master/tlpkg/tlperl/lib/TAP/Parser/Aggregator.pm
index 10b37ef72a3..822b0d7109e 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Parser/Aggregator.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Parser/Aggregator.pm
@@ -14,11 +14,11 @@ TAP::Parser::Aggregator - Aggregate TAP::Parser results
=head1 VERSION
-Version 3.17
+Version 3.23
=cut
-$VERSION = '3.17';
+$VERSION = '3.23';
=head1 SYNOPSIS
@@ -74,7 +74,7 @@ BEGIN { # install summary methods
$SUMMARY_METHOD_FOR{total} = 'tests_run';
$SUMMARY_METHOD_FOR{planned} = 'tests_planned';
- foreach my $method ( keys %SUMMARY_METHOD_FOR ) {
+ for my $method ( keys %SUMMARY_METHOD_FOR ) {
next if 'total' eq $method;
no strict 'refs';
*$method = sub {
@@ -90,7 +90,7 @@ sub _initialize {
my ($self) = @_;
$self->{parser_for} = {};
$self->{parse_order} = [];
- foreach my $summary ( keys %SUMMARY_METHOD_FOR ) {
+ for my $summary ( keys %SUMMARY_METHOD_FOR ) {
$self->{$summary} = 0;
next if 'total' eq $summary;
$self->{"descriptions_for_$summary"} = [];
@@ -175,7 +175,7 @@ sub parsers {
sub _get_parsers {
my ( $self, @descriptions ) = @_;
my @parsers;
- foreach my $description (@descriptions) {
+ for my $description (@descriptions) {
$self->_croak("A parser for ($description) could not be found")
unless exists $self->{parser_for}{$description};
push @parsers => $self->{parser_for}{$description};
diff --git a/Master/tlpkg/tlperl/lib/TAP/Parser/Grammar.pm b/Master/tlpkg/tlperl/lib/TAP/Parser/Grammar.pm
index 44f28a0491e..0646d15d292 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Parser/Grammar.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Parser/Grammar.pm
@@ -15,27 +15,27 @@ TAP::Parser::Grammar - A grammar for the Test Anything Protocol.
=head1 VERSION
-Version 3.17
+Version 3.23
=cut
-$VERSION = '3.17';
+$VERSION = '3.23';
=head1 SYNOPSIS
use TAP::Parser::Grammar;
my $grammar = $self->make_grammar({
- stream => $tap_parser_stream,
- parser => $tap_parser,
- version => 12,
+ iterator => $tap_parser_iterator,
+ parser => $tap_parser,
+ version => 12,
});
my $result = $grammar->tokenize;
=head1 DESCRIPTION
-C<TAP::Parser::Grammar> tokenizes lines from a TAP stream and constructs
-L<TAP::Parser::Result> subclasses to represent the tokens.
+C<TAP::Parser::Grammar> tokenizes lines from a L<TAP::Parser::Iterator> and
+constructs L<TAP::Parser::Result> subclasses to represent the tokens.
Do not attempt to use this class directly. It won't make sense. It's mainly
here to ensure that we will be able to have pluggable grammars when TAP is
@@ -49,22 +49,24 @@ parser).
=head3 C<new>
my $grammar = TAP::Parser::Grammar->new({
- stream => $stream,
- parser => $parser,
- version => $version,
+ iterator => $iterator,
+ parser => $parser,
+ version => $version,
});
-Returns L<TAP::Parser> grammar object that will parse the specified stream.
-Both C<stream> and C<parser> are required arguments. If C<version> is not set
-it defaults to C<12> (see L</set_version> for more details).
+Returns L<TAP::Parser> grammar object that will parse the TAP stream from the
+specified iterator. Both C<iterator> and C<parser> are required arguments.
+If C<version> is not set it defaults to C<12> (see L</set_version> for more
+details).
=cut
# new() implementation supplied by TAP::Object
sub _initialize {
my ( $self, $args ) = @_;
- $self->{stream} = $args->{stream}; # TODO: accessor
- $self->{parser} = $args->{parser}; # TODO: accessor
+ $self->{iterator} = $args->{iterator}; # TODO: accessor
+ $self->{iterator} ||= $args->{stream}; # deprecated
+ $self->{parser} = $args->{parser}; # TODO: accessor
$self->set_version( $args->{version} || 12 );
return $self;
}
@@ -162,7 +164,7 @@ my %language_for;
},
},
bailout => {
- syntax => qr/^Bail out!\s*(.*)/,
+ syntax => qr/^\s*Bail out!\s*(.*)/,
handler => sub {
my ( $self, $line ) = @_;
my $explanation = $1;
@@ -218,7 +220,7 @@ my %language_for;
'13' => {
tokens => \%v13,
setup => sub {
- shift->{stream}->handle_unicode;
+ shift->{iterator}->handle_unicode;
},
},
);
@@ -284,7 +286,7 @@ current line of TAP.
sub tokenize {
my $self = shift;
- my $line = $self->{stream}->next;
+ my $line = $self->{iterator}->next;
unless ( defined $line ) {
delete $self->{parser}; # break circular ref
return;
@@ -292,7 +294,7 @@ sub tokenize {
my $token;
- foreach my $token_data ( @{ $self->{ordered_tokens} } ) {
+ for my $token_data ( @{ $self->{ordered_tokens} } ) {
if ( $line =~ $token_data->{syntax} ) {
my $handler = $token_data->{handler};
$token = $self->$handler($line);
@@ -351,7 +353,7 @@ TAP parsing loop looks similar to the following:
my @tokens;
my $grammar = TAP::Grammar->new;
LINE: while ( defined( my $line = $parser->_next_chunk_of_tap ) ) {
- foreach my $type ( $grammar->token_types ) {
+ for my $type ( $grammar->token_types ) {
my $syntax = $grammar->syntax_for($type);
if ( $line =~ $syntax ) {
my $handler = $grammar->handler_for($type);
@@ -443,7 +445,7 @@ sub _make_yaml_token {
my $yaml = TAP::Parser::YAMLish::Reader->new;
- my $stream = $self->{stream};
+ my $iterator = $self->{iterator};
# Construct a reader that reads from our input stripping leading
# spaces from each line.
@@ -452,7 +454,7 @@ sub _make_yaml_token {
my @extra = ($marker);
my $reader = sub {
return shift @extra if @extra;
- my $line = $stream->next;
+ my $line = $iterator->next;
return $2 if $line =~ $strip;
return;
};
@@ -502,7 +504,7 @@ stream-based protocol. In fact, it's quite legal to have an infinite stream.
For the same reason that we don't apply regexes to streams, we're not using a
formal grammar here. Instead, we parse the TAP in lines.
-For purposes for forward compatability, any result which does not match the
+For purposes for forward compatibility, any result which does not match the
following grammar is currently referred to as
L<TAP::Parser::Result::Unknown>. It is I<not> a parse error.
diff --git a/Master/tlpkg/tlperl/lib/TAP/Parser/Iterator.pm b/Master/tlpkg/tlperl/lib/TAP/Parser/Iterator.pm
index 09d40bebccb..dd831995dcc 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Parser/Iterator.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Parser/Iterator.pm
@@ -9,20 +9,18 @@ use TAP::Object ();
=head1 NAME
-TAP::Parser::Iterator - Internal base class for TAP::Parser Iterators
+TAP::Parser::Iterator - Base class for TAP source iterators
=head1 VERSION
-Version 3.17
+Version 3.23
=cut
-$VERSION = '3.17';
+$VERSION = '3.23';
=head1 SYNOPSIS
- # see TAP::Parser::IteratorFactory for general usage
-
# to subclass:
use vars qw(@ISA);
use TAP::Parser::Iterator ();
@@ -31,11 +29,14 @@ $VERSION = '3.17';
# see TAP::Object...
}
+ sub next_raw { ... }
+ sub wait { ... }
+ sub exit { ... }
+
=head1 DESCRIPTION
This is a simple iterator base class that defines L<TAP::Parser>'s iterator
-API. See C<TAP::Parser::IteratorFactory> for the preferred way of creating
-iterators.
+API. Iterators are typically created from L<TAP::Parser::SourceHandler>s.
=head1 METHODS
@@ -156,7 +157,6 @@ There's not much point repeating it here.
L<TAP::Object>,
L<TAP::Parser>,
-L<TAP::Parser::IteratorFactory>,
L<TAP::Parser::Iterator::Array>,
L<TAP::Parser::Iterator::Stream>,
L<TAP::Parser::Iterator::Process>,
diff --git a/Master/tlpkg/tlperl/lib/TAP/Parser/Iterator/Array.pm b/Master/tlpkg/tlperl/lib/TAP/Parser/Iterator/Array.pm
index 1513d5b9945..4a195849bc9 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Parser/Iterator/Array.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Parser/Iterator/Array.pm
@@ -9,21 +9,18 @@ use TAP::Parser::Iterator ();
=head1 NAME
-TAP::Parser::Iterator::Array - Internal TAP::Parser array Iterator
+TAP::Parser::Iterator::Array - Iterator for array-based TAP sources
=head1 VERSION
-Version 3.17
+Version 3.23
=cut
-$VERSION = '3.17';
+$VERSION = '3.23';
=head1 SYNOPSIS
- # see TAP::Parser::IteratorFactory for preferred usage
-
- # to use directly:
use TAP::Parser::Iterator::Array;
my @data = ('foo', 'bar', baz');
my $it = TAP::Parser::Iterator::Array->new(\@data);
@@ -32,8 +29,8 @@ $VERSION = '3.17';
=head1 DESCRIPTION
This is a simple iterator wrapper for arrays of scalar content, used by
-L<TAP::Parser>. Unless you're subclassing, you probably won't need to use
-this module directly.
+L<TAP::Parser>. Unless you're writing a plugin or subclassing, you probably
+won't need to use this module directly.
=head1 METHODS
@@ -100,7 +97,6 @@ Originally ripped off from L<Test::Harness>.
L<TAP::Object>,
L<TAP::Parser>,
L<TAP::Parser::Iterator>,
-L<TAP::Parser::IteratorFactory>,
=cut
diff --git a/Master/tlpkg/tlperl/lib/TAP/Parser/Iterator/Process.pm b/Master/tlpkg/tlperl/lib/TAP/Parser/Iterator/Process.pm
index a0a5a8ed32e..f4332c94503 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Parser/Iterator/Process.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Parser/Iterator/Process.pm
@@ -13,21 +13,18 @@ my $IS_WIN32 = ( $^O =~ /^(MS)?Win32$/ );
=head1 NAME
-TAP::Parser::Iterator::Process - Internal TAP::Parser Iterator
+TAP::Parser::Iterator::Process - Iterator for process-based TAP sources
=head1 VERSION
-Version 3.17
+Version 3.23
=cut
-$VERSION = '3.17';
+$VERSION = '3.23';
=head1 SYNOPSIS
- # see TAP::Parser::IteratorFactory for preferred usage
-
- # to use directly:
use TAP::Parser::Iterator::Process;
my %args = (
command => ['python', 'setup.py', 'test'],
@@ -41,8 +38,8 @@ $VERSION = '3.17';
=head1 DESCRIPTION
This is a simple iterator wrapper for executing external processes, used by
-L<TAP::Parser>. Unless you're subclassing, you probably won't need to use
-this module directly.
+L<TAP::Parser>. Unless you're writing a plugin or subclassing, you probably
+won't need to use this module directly.
=head1 METHODS
@@ -80,12 +77,18 @@ Get the exit status for this iterator's process.
=cut
-eval { require POSIX; &POSIX::WEXITSTATUS(0) };
-if ($@) {
- *_wait2exit = sub { $_[1] >> 8 };
-}
-else {
- *_wait2exit = sub { POSIX::WEXITSTATUS( $_[1] ) }
+{
+
+ local $^W; # no warnings
+ # get around a catch22 in the test suite that causes failures on Win32:
+ local $SIG{__DIE__} = undef;
+ eval { require POSIX; &POSIX::WEXITSTATUS(0) };
+ if ($@) {
+ *_wait2exit = sub { $_[1] >> 8 };
+ }
+ else {
+ *_wait2exit = sub { POSIX::WEXITSTATUS( $_[1] ) }
+ }
}
sub _use_open3 {
@@ -117,6 +120,8 @@ sub _initialize {
my @command = @{ delete $args->{command} || [] }
or die "Must supply a command to execute";
+ $self->{command} = [@command];
+
# Private. Used to frig with chunk size during testing.
my $chunk_size = delete $args->{_chunk_size} || 65536;
@@ -371,7 +376,6 @@ Originally ripped off from L<Test::Harness>.
L<TAP::Object>,
L<TAP::Parser>,
L<TAP::Parser::Iterator>,
-L<TAP::Parser::IteratorFactory>,
=cut
diff --git a/Master/tlpkg/tlperl/lib/TAP/Parser/Iterator/Stream.pm b/Master/tlpkg/tlperl/lib/TAP/Parser/Iterator/Stream.pm
index c92cbabe089..27d87fb9961 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Parser/Iterator/Stream.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Parser/Iterator/Stream.pm
@@ -9,21 +9,18 @@ use TAP::Parser::Iterator ();
=head1 NAME
-TAP::Parser::Iterator::Stream - Internal TAP::Parser Iterator
+TAP::Parser::Iterator::Stream - Iterator for filehandle-based TAP sources
=head1 VERSION
-Version 3.17
+Version 3.23
=cut
-$VERSION = '3.17';
+$VERSION = '3.23';
=head1 SYNOPSIS
- # see TAP::Parser::IteratorFactory for preferred usage
-
- # to use directly:
use TAP::Parser::Iterator::Stream;
open( TEST, 'test.tap' );
my $it = TAP::Parser::Iterator::Stream->new(\*TEST);
@@ -32,8 +29,8 @@ $VERSION = '3.17';
=head1 DESCRIPTION
This is a simple iterator wrapper for reading from filehandles, used by
-L<TAP::Parser>. Unless you're subclassing, you probably won't need to use
-this module directly.
+L<TAP::Parser>. Unless you're writing a plugin or subclassing, you probably
+won't need to use this module directly.
=head1 METHODS
@@ -106,7 +103,6 @@ Originally ripped off from L<Test::Harness>.
L<TAP::Object>,
L<TAP::Parser>,
L<TAP::Parser::Iterator>,
-L<TAP::Parser::IteratorFactory>,
=cut
diff --git a/Master/tlpkg/tlperl/lib/TAP/Parser/IteratorFactory.pm b/Master/tlpkg/tlperl/lib/TAP/Parser/IteratorFactory.pm
index 064d7beb167..a45f08550cb 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Parser/IteratorFactory.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Parser/IteratorFactory.pm
@@ -3,40 +3,40 @@ package TAP::Parser::IteratorFactory;
use strict;
use vars qw($VERSION @ISA);
-use TAP::Object ();
-use TAP::Parser::Iterator::Array ();
-use TAP::Parser::Iterator::Stream ();
-use TAP::Parser::Iterator::Process ();
+use TAP::Object ();
+
+use Carp qw( confess );
+use File::Basename qw( fileparse );
@ISA = qw(TAP::Object);
+use constant handlers => [];
+
=head1 NAME
-TAP::Parser::IteratorFactory - Internal TAP::Parser Iterator
+TAP::Parser::IteratorFactory - Figures out which SourceHandler objects to use for a given Source
=head1 VERSION
-Version 3.17
+Version 3.23
=cut
-$VERSION = '3.17';
+$VERSION = '3.23';
=head1 SYNOPSIS
use TAP::Parser::IteratorFactory;
- my $factory = TAP::Parser::IteratorFactory->new;
- my $iter = $factory->make_iterator(\*TEST);
- my $iter = $factory->make_iterator(\@array);
- my $iter = $factory->make_iterator(\%hash);
-
- my $line = $iter->next;
+ my $factory = TAP::Parser::IteratorFactory->new({ %config });
+ my $iterator = $factory->make_iterator( $filename );
=head1 DESCRIPTION
-This is a factory class for simple iterator wrappers for arrays, filehandles,
-and hashes. Unless you're subclassing, you probably won't need to use this
-module directly.
+This is a factory class that takes a L<TAP::Parser::Source> and runs it through all the
+registered L<TAP::Parser::SourceHandler>s to see which one should handle the source.
+
+If you're a plugin author, you'll be interested in how to L</register_handler>s,
+how L</detect_source> works.
=head1 METHODS
@@ -44,128 +44,299 @@ module directly.
=head3 C<new>
-Creates a new factory class.
-I<Note:> You currently don't need to instantiate a factory in order to use it.
+Creates a new factory class:
-=head3 C<make_iterator>
+ my $sf = TAP::Parser::IteratorFactory->new( $config );
-Create an iterator. The type of iterator created depends on the arguments to
-the constructor:
+C<$config> is optional. If given, sets L</config> and calls L</load_handlers>.
- my $iter = TAP::Parser::Iterator->make_iterator( $filehandle );
+=cut
+
+sub _initialize {
+ my ( $self, $config ) = @_;
+ $self->config( $config || {} )->load_handlers;
+ return $self;
+}
-Creates a I<stream> iterator (see L</make_stream_iterator>).
+=head3 C<register_handler>
- my $iter = TAP::Parser::Iterator->make_iterator( $array_reference );
+Registers a new L<TAP::Parser::SourceHandler> with this factory.
-Creates an I<array> iterator (see L</make_array_iterator>).
+ __PACKAGE__->register_handler( $handler_class );
- my $iter = TAP::Parser::Iterator->make_iterator( $hash_reference );
+=head3 C<handlers>
-Creates a I<process> iterator (see L</make_process_iterator>).
+List of handlers that have been registered.
=cut
-sub make_iterator {
- my ( $proto, $thing ) = @_;
+sub register_handler {
+ my ( $class, $dclass ) = @_;
- my $ref = ref $thing;
- if ( $ref eq 'GLOB' || $ref eq 'IO::Handle' ) {
- return $proto->make_stream_iterator($thing);
- }
- elsif ( $ref eq 'ARRAY' ) {
- return $proto->make_array_iterator($thing);
- }
- elsif ( $ref eq 'HASH' ) {
- return $proto->make_process_iterator($thing);
- }
- else {
- die "Can't iterate with a $ref";
+ confess("$dclass must implement can_handle & make_iterator methods!")
+ unless UNIVERSAL::can( $dclass, 'can_handle' )
+ && UNIVERSAL::can( $dclass, 'make_iterator' );
+
+ my $handlers = $class->handlers;
+ push @{$handlers}, $dclass
+ unless grep { $_ eq $dclass } @{$handlers};
+
+ return $class;
+}
+
+##############################################################################
+
+=head2 Instance Methods
+
+=head3 C<config>
+
+ my $cfg = $sf->config;
+ $sf->config({ Perl => { %config } });
+
+Chaining getter/setter for the configuration of the available source handlers.
+This is a hashref keyed on handler class whose values contain config to be passed
+onto the handlers during detection & creation. Class names may be fully qualified
+or abbreviated, eg:
+
+ # these are equivalent
+ $sf->config({ 'TAP::Parser::SourceHandler::Perl' => { %config } });
+ $sf->config({ 'Perl' => { %config } });
+
+=cut
+
+sub config {
+ my $self = shift;
+ return $self->{config} unless @_;
+ unless ( 'HASH' eq ref $_[0] ) {
+ $self->_croak('Argument to &config must be a hash reference');
}
+ $self->{config} = shift;
+ return $self;
+}
+
+sub _last_handler {
+ my $self = shift;
+ return $self->{last_handler} unless @_;
+ $self->{last_handler} = shift;
+ return $self;
+}
+
+sub _testing {
+ my $self = shift;
+ return $self->{testing} unless @_;
+ $self->{testing} = shift;
+ return $self;
}
-=head3 C<make_stream_iterator>
+##############################################################################
+
+=head3 C<load_handlers>
+
+ $sf->load_handlers;
-Make a new stream iterator and return it. Passes through any arguments given.
-Defaults to a L<TAP::Parser::Iterator::Stream>.
+Loads the handler classes defined in L</config>. For example, given a config:
-=head3 C<make_array_iterator>
+ $sf->config({
+ MySourceHandler => { some => 'config' },
+ });
-Make a new array iterator and return it. Passes through any arguments given.
-Defaults to a L<TAP::Parser::Iterator::Array>.
+C<load_handlers> will attempt to load the C<MySourceHandler> class by looking in
+C<@INC> for it in this order:
-=head3 C<make_process_iterator>
+ TAP::Parser::SourceHandler::MySourceHandler
+ MySourceHandler
-Make a new process iterator and return it. Passes through any arguments given.
-Defaults to a L<TAP::Parser::Iterator::Process>.
+C<croak>s on error.
=cut
-sub make_stream_iterator {
- my $proto = shift;
- TAP::Parser::Iterator::Stream->new(@_);
+sub load_handlers {
+ my ($self) = @_;
+ for my $handler ( keys %{ $self->config } ) {
+ my $sclass = $self->_load_handler($handler);
+
+ # TODO: store which class we loaded anywhere?
+ }
+ return $self;
}
-sub make_array_iterator {
- my $proto = shift;
- TAP::Parser::Iterator::Array->new(@_);
+sub _load_handler {
+ my ( $self, $handler ) = @_;
+
+ my @errors;
+ for my $dclass ( "TAP::Parser::SourceHandler::$handler", $handler ) {
+ return $dclass
+ if UNIVERSAL::can( $dclass, 'can_handle' )
+ && UNIVERSAL::can( $dclass, 'make_iterator' );
+
+ eval "use $dclass";
+ if ( my $e = $@ ) {
+ push @errors, $e;
+ next;
+ }
+
+ return $dclass
+ if UNIVERSAL::can( $dclass, 'can_handle' )
+ && UNIVERSAL::can( $dclass, 'make_iterator' );
+ push @errors,
+ "handler '$dclass' does not implement can_handle & make_iterator";
+ }
+
+ $self->_croak(
+ "Cannot load handler '$handler': " . join( "\n", @errors ) );
}
-sub make_process_iterator {
- my $proto = shift;
- TAP::Parser::Iterator::Process->new(@_);
+##############################################################################
+
+=head3 C<make_iterator>
+
+ my $iterator = $src_factory->make_iterator( $source );
+
+Given a L<TAP::Parser::Source>, finds the most suitable L<TAP::Parser::SourceHandler>
+to use to create a L<TAP::Parser::Iterator> (see L</detect_source>). Dies on error.
+
+=cut
+
+sub make_iterator {
+ my ( $self, $source ) = @_;
+
+ $self->_croak('no raw source defined!') unless defined $source->raw;
+
+ $source->config( $self->config )->assemble_meta;
+
+ # is the raw source already an object?
+ return $source->raw
+ if ( $source->meta->{is_object}
+ && UNIVERSAL::isa( $source->raw, 'TAP::Parser::SourceHandler' ) );
+
+ # figure out what kind of source it is
+ my $sd_class = $self->detect_source($source);
+ $self->_last_handler($sd_class);
+
+ return if $self->_testing;
+
+ # create it
+ my $iterator = $sd_class->make_iterator($source);
+
+ return $iterator;
}
-1;
+=head3 C<detect_source>
-=head1 SUBCLASSING
+Given a L<TAP::Parser::Source>, detects what kind of source it is and
+returns I<one> L<TAP::Parser::SourceHandler> (the most confident one). Dies
+on error.
-Please see L<TAP::Parser/SUBCLASSING> for a subclassing overview.
+The detection algorithm works something like this:
+
+ for (@registered_handlers) {
+ # ask them how confident they are about handling this source
+ $confidence{$handler} = $handler->can_handle( $source )
+ }
+ # choose the most confident handler
+
+Ties are handled by choosing the first handler.
+
+=cut
+
+sub detect_source {
+ my ( $self, $source ) = @_;
-There are a few things to bear in mind when creating your own
-C<ResultFactory>:
+ confess('no raw source ref defined!') unless defined $source->raw;
-=over 4
+ # find a list of handlers that can handle this source:
+ my %handlers;
+ for my $dclass ( @{ $self->handlers } ) {
+ my $confidence = $dclass->can_handle($source);
-=item 1
+ # warn "handler: $dclass: $confidence\n";
+ $handlers{$dclass} = $confidence if $confidence;
+ }
+
+ if ( !%handlers ) {
+
+ # use Data::Dump qw( pp );
+ # warn pp( $meta );
+
+ # error: can't detect source
+ my $raw_source_short = substr( ${ $source->raw }, 0, 50 );
+ confess("Cannot detect source of '$raw_source_short'!");
+ return;
+ }
-The factory itself is never instantiated (this I<may> change in the future).
-This means that C<_initialize> is never called.
+ # if multiple handlers can handle it, choose the most confident one
+ my @handlers = (
+ map {$_}
+ sort { $handlers{$a} cmp $handlers{$b} }
+ keys %handlers
+ );
+
+ # this is really useful for debugging handlers:
+ if ( $ENV{TAP_HARNESS_SOURCE_FACTORY_VOTES} ) {
+ warn(
+ "votes: ",
+ join( ', ', map {"$_: $handlers{$_}"} @handlers ),
+ "\n"
+ );
+ }
+
+ # return 1st
+ return pop @handlers;
+}
+
+1;
-=back
+__END__
+
+=head1 SUBCLASSING
+
+Please see L<TAP::Parser/SUBCLASSING> for a subclassing overview.
=head2 Example
+If we've done things right, you'll probably want to write a new source,
+rather than sub-classing this (see L<TAP::Parser::SourceHandler> for that).
+
+But in case you find the need to...
+
package MyIteratorFactory;
use strict;
use vars '@ISA';
- use MyStreamIterator;
use TAP::Parser::IteratorFactory;
@ISA = qw( TAP::Parser::IteratorFactory );
- # override stream iterator
- sub make_stream_iterator {
- my $proto = shift;
- MyStreamIterator->new(@_);
+ # override source detection algorithm
+ sub detect_source {
+ my ($self, $raw_source_ref, $meta) = @_;
+ # do detective work, using $meta and whatever else...
}
1;
+=head1 AUTHORS
+
+Steve Purkis
+
=head1 ATTRIBUTION
Originally ripped off from L<Test::Harness>.
+Moved out of L<TAP::Parser> & converted to a factory class to support
+extensible TAP source detective work by Steve Purkis.
+
=head1 SEE ALSO
L<TAP::Object>,
L<TAP::Parser>,
-L<TAP::Parser::Iterator>,
-L<TAP::Parser::Iterator::Array>,
-L<TAP::Parser::Iterator::Stream>,
-L<TAP::Parser::Iterator::Process>,
+L<TAP::Parser::SourceHandler>,
+L<TAP::Parser::SourceHandler::File>,
+L<TAP::Parser::SourceHandler::Perl>,
+L<TAP::Parser::SourceHandler::RawTAP>,
+L<TAP::Parser::SourceHandler::Handle>,
+L<TAP::Parser::SourceHandler::Executable>
=cut
diff --git a/Master/tlpkg/tlperl/lib/TAP/Parser/Multiplexer.pm b/Master/tlpkg/tlperl/lib/TAP/Parser/Multiplexer.pm
index 2e5d9296888..934933cae39 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Parser/Multiplexer.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Parser/Multiplexer.pm
@@ -18,11 +18,11 @@ TAP::Parser::Multiplexer - Multiplex multiple TAP::Parsers
=head1 VERSION
-Version 3.17
+Version 3.23
=cut
-$VERSION = '3.17';
+$VERSION = '3.23';
=head1 SYNOPSIS
diff --git a/Master/tlpkg/tlperl/lib/TAP/Parser/Result.pm b/Master/tlpkg/tlperl/lib/TAP/Parser/Result.pm
index b01e95c5d9a..c8120302f34 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Parser/Result.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Parser/Result.pm
@@ -26,15 +26,15 @@ TAP::Parser::Result - Base class for TAP::Parser output objects
=head1 VERSION
-Version 3.17
+Version 3.23
=cut
-$VERSION = '3.17';
+$VERSION = '3.23';
=head1 SYNOPSIS
- # abstract class - not meany to be used directly
+ # abstract class - not meant to be used directly
# see TAP::Parser::ResultFactory for preferred usage
# directly:
diff --git a/Master/tlpkg/tlperl/lib/TAP/Parser/Result/Bailout.pm b/Master/tlpkg/tlperl/lib/TAP/Parser/Result/Bailout.pm
index 3e42f4110fd..e85d2a9a951 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Parser/Result/Bailout.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Parser/Result/Bailout.pm
@@ -12,11 +12,11 @@ TAP::Parser::Result::Bailout - Bailout result token.
=head1 VERSION
-Version 3.17
+Version 3.23
=cut
-$VERSION = '3.17';
+$VERSION = '3.23';
=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 1e9ba13c5f2..239a3eb22be 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Parser/Result/Comment.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Parser/Result/Comment.pm
@@ -12,11 +12,11 @@ TAP::Parser::Result::Comment - Comment result token.
=head1 VERSION
-Version 3.17
+Version 3.23
=cut
-$VERSION = '3.17';
+$VERSION = '3.23';
=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 67c01df200d..56ac06ac4ec 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Parser/Result/Plan.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Parser/Result/Plan.pm
@@ -12,11 +12,11 @@ TAP::Parser::Result::Plan - Plan result token.
=head1 VERSION
-Version 3.17
+Version 3.23
=cut
-$VERSION = '3.17';
+$VERSION = '3.23';
=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 3eb62b3322b..b2a9709c337 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Parser/Result/Pragma.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Parser/Result/Pragma.pm
@@ -12,11 +12,11 @@ TAP::Parser::Result::Pragma - TAP pragma token.
=head1 VERSION
-Version 3.17
+Version 3.23
=cut
-$VERSION = '3.17';
+$VERSION = '3.23';
=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 11cf302de6a..dd1ecd2edfa 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Parser/Result/Test.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Parser/Result/Test.pm
@@ -14,11 +14,11 @@ TAP::Parser::Result::Test - Test result token.
=head1 VERSION
-Version 3.17
+Version 3.23
=cut
-$VERSION = '3.17';
+$VERSION = '3.23';
=head1 DESCRIPTION
@@ -101,7 +101,7 @@ sub directive { shift->{directive} }
my $explanation = $result->explanation;
If a test had either a C<TODO> or C<SKIP> directive, this method will return
-the accompanying explantion, if present.
+the accompanying explanation, if present.
not ok 17 - 'Pigs can fly' # TODO not enough acid
diff --git a/Master/tlpkg/tlperl/lib/TAP/Parser/Result/Unknown.pm b/Master/tlpkg/tlperl/lib/TAP/Parser/Result/Unknown.pm
index 52e19585d9a..861de5e29fa 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Parser/Result/Unknown.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Parser/Result/Unknown.pm
@@ -14,11 +14,11 @@ TAP::Parser::Result::Unknown - Unknown result token.
=head1 VERSION
-Version 3.17
+Version 3.23
=cut
-$VERSION = '3.17';
+$VERSION = '3.23';
=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 b97681eb065..f20c7a1d0a8 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Parser/Result/Version.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Parser/Result/Version.pm
@@ -12,11 +12,11 @@ TAP::Parser::Result::Version - TAP syntax version token.
=head1 VERSION
-Version 3.17
+Version 3.23
=cut
-$VERSION = '3.17';
+$VERSION = '3.23';
=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 ada3ae445bb..28aae77a10e 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Parser/Result/YAML.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Parser/Result/YAML.pm
@@ -12,11 +12,11 @@ TAP::Parser::Result::YAML - YAML result token.
=head1 VERSION
-Version 3.17
+Version 3.23
=cut
-$VERSION = '3.17';
+$VERSION = '3.23';
=head1 DESCRIPTION
diff --git a/Master/tlpkg/tlperl/lib/TAP/Parser/ResultFactory.pm b/Master/tlpkg/tlperl/lib/TAP/Parser/ResultFactory.pm
index 46d0df29dbd..37ec96b201b 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Parser/ResultFactory.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Parser/ResultFactory.pm
@@ -30,11 +30,11 @@ TAP::Parser::ResultFactory - Factory for creating TAP::Parser output objects
=head1 VERSION
-Version 3.17
+Version 3.23
=cut
-$VERSION = '3.17';
+$VERSION = '3.23';
=head2 DESCRIPTION
diff --git a/Master/tlpkg/tlperl/lib/TAP/Parser/Scheduler.pm b/Master/tlpkg/tlperl/lib/TAP/Parser/Scheduler.pm
index f1817093af0..522194182b8 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Parser/Scheduler.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Parser/Scheduler.pm
@@ -12,11 +12,11 @@ TAP::Parser::Scheduler - Schedule tests during parallel testing
=head1 VERSION
-Version 3.17
+Version 3.23
=cut
-$VERSION = '3.17';
+$VERSION = '3.23';
=head1 SYNOPSIS
@@ -231,7 +231,7 @@ sub get_job {
sub _not_empty {
my $ar = shift;
return 1 unless 'ARRAY' eq ref $ar;
- foreach (@$ar) {
+ for (@$ar) {
return 1 if _not_empty($_);
}
return;
diff --git a/Master/tlpkg/tlperl/lib/TAP/Parser/Scheduler/Job.pm b/Master/tlpkg/tlperl/lib/TAP/Parser/Scheduler/Job.pm
index 7ab68f9f673..18c1026a9dd 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Parser/Scheduler/Job.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Parser/Scheduler/Job.pm
@@ -10,11 +10,11 @@ TAP::Parser::Scheduler::Job - A single testing job.
=head1 VERSION
-Version 3.17
+Version 3.23
=cut
-$VERSION = '3.17';
+$VERSION = '3.23';
=head1 SYNOPSIS
diff --git a/Master/tlpkg/tlperl/lib/TAP/Parser/Scheduler/Spinner.pm b/Master/tlpkg/tlperl/lib/TAP/Parser/Scheduler/Spinner.pm
index 10af5e33697..eb88b444011 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Parser/Scheduler/Spinner.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Parser/Scheduler/Spinner.pm
@@ -10,11 +10,11 @@ TAP::Parser::Scheduler::Spinner - A no-op job.
=head1 VERSION
-Version 3.17
+Version 3.23
=cut
-$VERSION = '3.17';
+$VERSION = '3.23';
=head1 SYNOPSIS
diff --git a/Master/tlpkg/tlperl/lib/TAP/Parser/Source.pm b/Master/tlpkg/tlperl/lib/TAP/Parser/Source.pm
index 9263e9e5442..a33fe6fdb62 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Parser/Source.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Parser/Source.pm
@@ -3,35 +3,49 @@ package TAP::Parser::Source;
use strict;
use vars qw($VERSION @ISA);
-use TAP::Object ();
-use TAP::Parser::IteratorFactory ();
+use TAP::Object ();
+use File::Basename qw( fileparse );
@ISA = qw(TAP::Object);
-# Causes problem on MacOS and shouldn't be necessary anyway
-#$SIG{CHLD} = sub { wait };
-
=head1 NAME
-TAP::Parser::Source - Stream output from some source
+TAP::Parser::Source - a TAP source & meta data about it
=head1 VERSION
-Version 3.17
+Version 3.23
=cut
-$VERSION = '3.17';
+$VERSION = '3.23';
=head1 SYNOPSIS
use TAP::Parser::Source;
my $source = TAP::Parser::Source->new;
- my $stream = $source->source(['/usr/bin/ruby', 'mytest.rb'])->get_stream;
+ $source->raw( \'reference to raw TAP source' )
+ ->config( \%config )
+ ->merge( $boolean )
+ ->switches( \@switches )
+ ->test_args( \@args )
+ ->assemble_meta;
+
+ do { ... } if $source->meta->{is_file};
+ # see assemble_meta for a full list of data available
=head1 DESCRIPTION
-Takes a command and hopefully returns a stream from it.
+A TAP I<source> is something that produces a stream of TAP for the parser to
+consume, such as an executable file, a text file, an archive, an IO handle, a
+database, etc. C<TAP::Parser::Source>s encapsulate these I<raw> sources, and
+provide some useful meta data about them. They are used by
+L<TAP::Parser::SourceHandler>s, which do whatever is required to produce &
+capture a stream of TAP from the I<raw> source, and package it up in a
+L<TAP::Parser::Iterator> for the parser to consume.
+
+Unless you're writing a new L<TAP::Parser::SourceHandler>, a plugin or
+subclassing L<TAP::Parser>, you probably won't need to use this module directly.
=head1 METHODS
@@ -48,10 +62,9 @@ Returns a new C<TAP::Parser::Source> object.
# new() implementation supplied by TAP::Object
sub _initialize {
- my ( $self, $args ) = @_;
- $self->{switches} = [];
- _autoflush( \*STDOUT );
- _autoflush( \*STDERR );
+ my ($self) = @_;
+ $self->meta( {} );
+ $self->config( {} );
return $self;
}
@@ -59,69 +72,86 @@ sub _initialize {
=head2 Instance Methods
-=head3 C<source>
+=head3 C<raw>
- my $source = $source->source;
- $source->source(['./some_prog some_test_file']);
+ my $raw = $source->raw;
+ $source->raw( $some_value );
- # or
- $source->source(['/usr/bin/ruby', 't/ruby_test.rb']);
+Chaining getter/setter for the raw TAP source. This is a reference, as it may
+contain large amounts of data (eg: raw TAP).
-Getter/setter for the source. The source should generally consist of an array
-reference of strings which, when executed via L<&IPC::Open3::open3|IPC::Open3>,
-should return a filehandle which returns successive rows of TAP. C<croaks> if
-it doesn't get an arrayref.
+=head3 C<meta>
-=cut
+ my $meta = $source->meta;
+ $source->meta({ %some_value });
-sub source {
- my $self = shift;
- return $self->{source} unless @_;
- unless ( 'ARRAY' eq ref $_[0] ) {
- $self->_croak('Argument to &source must be an array reference');
- }
- $self->{source} = shift;
- return $self;
-}
+Chaining getter/setter for meta data about the source. This defaults to an
+empty hashref. See L</assemble_meta> for more info.
-##############################################################################
+=head3 C<has_meta>
-=head3 C<get_stream>
+True if the source has meta data.
- my $stream = $source->get_stream;
+=head3 C<config>
-Returns a L<TAP::Parser::Iterator> stream of the output generated by executing
-C<source>. C<croak>s if there was no command found.
+ my $config = $source->config;
+ $source->config({ %some_value });
-Must be passed an object that implements a C<make_iterator> method.
-Typically this is a TAP::Parser instance.
+Chaining getter/setter for the source's configuration, if any has been provided
+by the user. How it's used is up to you. This defaults to an empty hashref.
+See L</config_for> for more info.
-=cut
+=head3 C<merge>
-sub get_stream {
- my ( $self, $factory ) = @_;
- my @command = $self->_get_command
- or $self->_croak('No command found!');
+ my $merge = $source->merge;
+ $source->config( $bool );
- return $factory->make_iterator(
- { command => \@command,
- merge => $self->merge
- }
- );
-}
+Chaining getter/setter for the flag that dictates whether STDOUT and STDERR
+should be merged (where appropriate). Defaults to undef.
-sub _get_command { return @{ shift->source || [] } }
+=head3 C<switches>
-##############################################################################
+ my $switches = $source->switches;
+ $source->config([ @switches ]);
-=head3 C<merge>
+Chaining getter/setter for the list of command-line switches that should be
+passed to the source (where appropriate). Defaults to undef.
- my $merge = $source->merge;
+=head3 C<test_args>
+
+ my $test_args = $source->test_args;
+ $source->config([ @test_args ]);
-Sets or returns the flag that dictates whether STDOUT and STDERR are merged.
+Chaining getter/setter for the list of command-line arguments that should be
+passed to the source (where appropriate). Defaults to undef.
=cut
+sub raw {
+ my $self = shift;
+ return $self->{raw} unless @_;
+ $self->{raw} = shift;
+ return $self;
+}
+
+sub meta {
+ my $self = shift;
+ return $self->{meta} unless @_;
+ $self->{meta} = shift;
+ return $self;
+}
+
+sub has_meta {
+ return scalar %{ shift->meta } ? 1 : 0;
+}
+
+sub config {
+ my $self = shift;
+ return $self->{config} unless @_;
+ $self->{config} = shift;
+ return $self;
+}
+
sub merge {
my $self = shift;
return $self->{merge} unless @_;
@@ -129,45 +159,227 @@ sub merge {
return $self;
}
-# Turns on autoflush for the handle passed
-sub _autoflush {
- my $flushed = shift;
- my $old_fh = select $flushed;
- $| = 1;
- select $old_fh;
+sub switches {
+ my $self = shift;
+ return $self->{switches} unless @_;
+ $self->{switches} = shift;
+ return $self;
}
-1;
+sub test_args {
+ my $self = shift;
+ return $self->{test_args} unless @_;
+ $self->{test_args} = shift;
+ return $self;
+}
+
+=head3 C<assemble_meta>
+
+ my $meta = $source->assemble_meta;
+
+Gathers meta data about the L</raw> source, stashes it in L</meta> and returns
+it as a hashref. This is done so that the L<TAP::Parser::SourceHandler>s don't
+have to repeat common checks. Currently this includes:
+
+ is_scalar => $bool,
+ is_hash => $bool,
+ is_array => $bool,
+
+ # for scalars:
+ length => $n
+ has_newlines => $bool
+
+ # only done if the scalar looks like a filename
+ is_file => $bool,
+ is_dir => $bool,
+ is_symlink => $bool,
+ file => {
+ # only done if the scalar looks like a filename
+ basename => $string, # including ext
+ dir => $string,
+ ext => $string,
+ lc_ext => $string,
+ # system checks
+ exists => $bool,
+ stat => [ ... ], # perldoc -f stat
+ empty => $bool,
+ size => $n,
+ text => $bool,
+ binary => $bool,
+ read => $bool,
+ write => $bool,
+ execute => $bool,
+ setuid => $bool,
+ setgid => $bool,
+ sticky => $bool,
+ is_file => $bool,
+ is_dir => $bool,
+ is_symlink => $bool,
+ # only done if the file's a symlink
+ lstat => [ ... ], # perldoc -f lstat
+ # only done if the file's a readable text file
+ shebang => $first_line,
+ }
-=head1 SUBCLASSING
+ # for arrays:
+ size => $n,
-Please see L<TAP::Parser/SUBCLASSING> for a subclassing overview.
+=cut
-=head2 Example
+sub assemble_meta {
+ my ($self) = @_;
- package MyRubySource;
+ return $self->meta if $self->has_meta;
- use strict;
- use vars '@ISA';
+ my $meta = $self->meta;
+ my $raw = $self->raw;
- use Carp qw( croak );
- use TAP::Parser::Source;
+ # rudimentary is object test - if it's blessed it'll
+ # inherit from UNIVERSAL
+ $meta->{is_object} = UNIVERSAL::isa( $raw, 'UNIVERSAL' ) ? 1 : 0;
+
+ if ( $meta->{is_object} ) {
+ $meta->{class} = ref($raw);
+ }
+ else {
+ my $ref = lc( ref($raw) );
+ $meta->{"is_$ref"} = 1;
+ }
+
+ if ( $meta->{is_scalar} ) {
+ my $source = $$raw;
+ $meta->{length} = length($$raw);
+ $meta->{has_newlines} = $$raw =~ /\n/ ? 1 : 0;
+
+ # only do file checks if it looks like a filename
+ if ( !$meta->{has_newlines} and $meta->{length} < 1024 ) {
+ my $file = {};
+ $file->{exists} = -e $source ? 1 : 0;
+ if ( $file->{exists} ) {
+ $meta->{file} = $file;
+
+ # avoid extra system calls (see `perldoc -f -X`)
+ $file->{stat} = [ stat(_) ];
+ $file->{empty} = -z _ ? 1 : 0;
+ $file->{size} = -s _;
+ $file->{text} = -T _ ? 1 : 0;
+ $file->{binary} = -B _ ? 1 : 0;
+ $file->{read} = -r _ ? 1 : 0;
+ $file->{write} = -w _ ? 1 : 0;
+ $file->{execute} = -x _ ? 1 : 0;
+ $file->{setuid} = -u _ ? 1 : 0;
+ $file->{setgid} = -g _ ? 1 : 0;
+ $file->{sticky} = -k _ ? 1 : 0;
+
+ $meta->{is_file} = $file->{is_file} = -f _ ? 1 : 0;
+ $meta->{is_dir} = $file->{is_dir} = -d _ ? 1 : 0;
+
+ # symlink check requires another system call
+ $meta->{is_symlink} = $file->{is_symlink}
+ = -l $source ? 1 : 0;
+ if ( $file->{is_symlink} ) {
+ $file->{lstat} = [ lstat(_) ];
+ }
+
+ # put together some common info about the file
+ ( $file->{basename}, $file->{dir}, $file->{ext} )
+ = map { defined $_ ? $_ : '' }
+ fileparse( $source, qr/\.[^.]*/ );
+ $file->{lc_ext} = lc( $file->{ext} );
+ $file->{basename} .= $file->{ext} if $file->{ext};
+
+ if ( $file->{text} and $file->{read} ) {
+ eval { $file->{shebang} = $self->_read_shebang($$raw); };
+ if ( my $e = $@ ) {
+ warn $e;
+ }
+ }
+ }
+ }
+ }
+ elsif ( $meta->{is_array} ) {
+ $meta->{size} = $#$raw + 1;
+ }
+ elsif ( $meta->{is_hash} ) {
+ ; # do nothing
+ }
+
+ return $meta;
+}
+
+=head3 C<shebang>
+
+Get the shebang line for a script file.
+
+ my $shebang = TAP::Parser::Source->shebang( $some_script );
+
+May be called as a class method
+
+=cut
+
+{
+
+ # Global shebang cache.
+ my %shebang_for;
- @ISA = qw( TAP::Parser::Source );
+ sub _read_shebang {
+ my ( $self, $file ) = @_;
+ my $shebang;
+ local *TEST;
+ if ( open( TEST, $file ) ) {
+ $shebang = <TEST>;
+ chomp $shebang;
+ close(TEST) or die "Can't close $file. $!\n";
+ }
+ else {
+ die "Can't open $file. $!\n";
+ }
+ return $shebang;
+ }
+
+ sub shebang {
+ my ( $class, $file ) = @_;
+ $shebang_for{$file} = $class->_read_shebang($file)
+ unless exists $shebang_for{$file};
+ return $shebang_for{$file};
+ }
+}
+
+=head3 C<config_for>
+
+ my $config = $source->config_for( $class );
+
+Returns L</config> for the $class given. Class names may be fully qualified
+or abbreviated, eg:
+
+ # these are equivalent
+ $source->config_for( 'Perl' );
+ $source->config_for( 'TAP::Parser::SourceHandler::Perl' );
- # expect $source->(['mytest.rb', 'cmdline', 'args']);
- sub source {
- my ($self, $args) = @_;
- my ($rb_file) = @$args;
- croak("error: Ruby file '$rb_file' not found!") unless (-f $rb_file);
- return $self->SUPER::source(['/usr/bin/ruby', @$args]);
- }
+If a fully qualified $class is given, its abbreviated version is checked first.
+
+=cut
+
+sub config_for {
+ my ( $self, $class ) = @_;
+ my ($abbrv_class) = ( $class =~ /(?:\:\:)?(\w+)$/ );
+ my $config = $self->config->{$abbrv_class} || $self->config->{$class};
+ return $config;
+}
+
+1;
+
+__END__
+
+=head1 AUTHORS
+
+Steve Purkis.
=head1 SEE ALSO
L<TAP::Object>,
L<TAP::Parser>,
-L<TAP::Parser::Source::Perl>,
+L<TAP::Parser::IteratorFactory>,
+L<TAP::Parser::SourceHandler>
=cut
-
diff --git a/Master/tlpkg/tlperl/lib/TAP/Parser/Source/Perl.pm b/Master/tlpkg/tlperl/lib/TAP/Parser/Source/Perl.pm
deleted file mode 100644
index 1f4f2e1428c..00000000000
--- a/Master/tlpkg/tlperl/lib/TAP/Parser/Source/Perl.pm
+++ /dev/null
@@ -1,326 +0,0 @@
-package TAP::Parser::Source::Perl;
-
-use strict;
-use Config;
-use vars qw($VERSION @ISA);
-
-use constant IS_WIN32 => ( $^O =~ /^(MS)?Win32$/ );
-use constant IS_VMS => ( $^O eq 'VMS' );
-
-use TAP::Parser::Source;
-use TAP::Parser::Utils qw( split_shell );
-
-@ISA = 'TAP::Parser::Source';
-
-=head1 NAME
-
-TAP::Parser::Source::Perl - Stream Perl output
-
-=head1 VERSION
-
-Version 3.17
-
-=cut
-
-$VERSION = '3.17';
-
-=head1 SYNOPSIS
-
- use TAP::Parser::Source::Perl;
- my $perl = TAP::Parser::Source::Perl->new;
- my $stream = $perl->source( [ $filename, @args ] )->get_stream;
-
-=head1 DESCRIPTION
-
-Takes a filename and hopefully returns a stream from it. The filename should
-be the name of a Perl program.
-
-Note that this is a subclass of L<TAP::Parser::Source>. See that module for
-more methods.
-
-=head1 METHODS
-
-=head2 Class Methods
-
-=head3 C<new>
-
- my $perl = TAP::Parser::Source::Perl->new;
-
-Returns a new C<TAP::Parser::Source::Perl> object.
-
-=head2 Instance Methods
-
-=head3 C<source>
-
-Getter/setter the name of the test program and any arguments it requires.
-
- my ($filename, @args) = @{ $perl->source };
- $perl->source( [ $filename, @args ] );
-
-C<croak>s if C<$filename> could not be found.
-
-=cut
-
-sub source {
- my $self = shift;
- $self->_croak("Cannot find ($_[0][0])")
- if @_ && !-f $_[0][0];
- return $self->SUPER::source(@_);
-}
-
-=head3 C<switches>
-
- my $switches = $perl->switches;
- my @switches = $perl->switches;
- $perl->switches( \@switches );
-
-Getter/setter for the additional switches to pass to the perl executable. One
-common switch would be to set an include directory:
-
- $perl->switches( ['-Ilib'] );
-
-=cut
-
-sub switches {
- my $self = shift;
- unless (@_) {
- return wantarray ? @{ $self->{switches} } : $self->{switches};
- }
- my $switches = shift;
- $self->{switches} = [@$switches]; # force a copy
- return $self;
-}
-
-##############################################################################
-
-=head3 C<get_stream>
-
- my $stream = $source->get_stream($parser);
-
-Returns a stream of the output generated by executing C<source>. Must be
-passed an object that implements a C<make_iterator> method. Typically
-this is a TAP::Parser instance.
-
-=cut
-
-sub get_stream {
- my ( $self, $factory ) = @_;
-
- my @switches = $self->_switches;
- my $path_sep = $Config{path_sep};
- my $path_pat = qr{$path_sep};
-
- # Filter out any -I switches to be handled as libs later.
- #
- # Nasty kludge. It might be nicer if we got the libs separately
- # although at least this way we find any -I switches that were
- # supplied other then as explicit libs.
- #
- # We filter out any names containing colons because they will break
- # PERL5LIB
- my @libs;
- my @filtered_switches;
- for (@switches) {
- if ( !/$path_pat/ && / ^ ['"]? -I ['"]? (.*?) ['"]? $ /x ) {
- push @libs, $1;
- }
- else {
- push @filtered_switches, $_;
- }
- }
- @switches = @filtered_switches;
-
- my $setup = sub {
- if (@libs) {
- $ENV{PERL5LIB}
- = join( $path_sep, grep {defined} @libs, $ENV{PERL5LIB} );
- }
- };
-
- # Cargo culted from comments seen elsewhere about VMS / environment
- # variables. I don't know if this is actually necessary.
- my $previous = $ENV{PERL5LIB};
- my $teardown = sub {
- if ( defined $previous ) {
- $ENV{PERL5LIB} = $previous;
- }
- else {
- delete $ENV{PERL5LIB};
- }
- };
-
- # 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 ) {
- push @switches, $self->_libs2switches(@libs);
- push @switches, split_shell( $ENV{PERL5OPT} );
- }
-
- my @command = $self->_get_command_for_switches(@switches)
- or $self->_croak("No command found!");
-
- return $factory->make_iterator(
- { command => \@command,
- merge => $self->merge,
- setup => $setup,
- teardown => $teardown,
- }
- );
-}
-
-sub _get_command_for_switches {
- my $self = shift;
- my @switches = @_;
- my ( $file, @args ) = @{ $self->source };
- my $command = $self->_get_perl;
-
-# XXX we never need to quote if we treat the parts as atoms (except maybe vms)
-#$file = qq["$file"] if ( $file =~ /\s/ ) && ( $file !~ /^".*"$/ );
- my @command = ( $command, @switches, $file, @args );
- return @command;
-}
-
-sub _get_command {
- my $self = shift;
- return $self->_get_command_for_switches( $self->_switches );
-}
-
-sub _libs2switches {
- my $self = shift;
- return map {"-I$_"} grep {$_} @_;
-}
-
-=head3 C<shebang>
-
-Get the shebang line for a script file.
-
- my $shebang = TAP::Parser::Source::Perl->shebang( $some_script );
-
-May be called as a class method
-
-=cut
-
-{
-
- # Global shebang cache.
- my %shebang_for;
-
- sub _read_shebang {
- my $file = shift;
- local *TEST;
- my $shebang;
- if ( open( TEST, $file ) ) {
- $shebang = <TEST>;
- close(TEST) or print "Can't close $file. $!\n";
- }
- else {
- print "Can't open $file. $!\n";
- }
- return $shebang;
- }
-
- sub shebang {
- my ( $class, $file ) = @_;
- unless ( exists $shebang_for{$file} ) {
- $shebang_for{$file} = _read_shebang($file);
- }
- return $shebang_for{$file};
- }
-}
-
-=head3 C<get_taint>
-
-Decode any taint switches from a Perl shebang line.
-
- # $taint will be 't'
- my $taint = TAP::Parser::Source::Perl->get_taint( '#!/usr/bin/perl -t' );
-
- # $untaint will be undefined
- my $untaint = TAP::Parser::Source::Perl->get_taint( '#!/usr/bin/perl' );
-
-=cut
-
-sub get_taint {
- my ( $class, $shebang ) = @_;
- return
- unless defined $shebang
- && $shebang =~ /^#!.*\bperl.*\s-\w*([Tt]+)/;
- return $1;
-}
-
-sub _switches {
- my $self = shift;
- my ( $file, @args ) = @{ $self->source };
- my @switches = (
- $self->switches,
- );
-
- my $shebang = $self->shebang($file);
- return unless defined $shebang;
-
- my $taint = $self->get_taint($shebang);
- push @switches, "-$taint" if defined $taint;
-
- # Quote the argument if we're VMS, since VMS will downcase anything
- # not quoted.
- if (IS_VMS) {
- for (@switches) {
- $_ = qq["$_"];
- }
- }
-
- return @switches;
-}
-
-sub _get_perl {
- my $self = shift;
- return $ENV{HARNESS_PERL} if defined $ENV{HARNESS_PERL};
- return Win32::GetShortPathName($^X) if IS_WIN32;
- return $^X;
-}
-
-1;
-
-=head1 SUBCLASSING
-
-Please see L<TAP::Parser/SUBCLASSING> for a subclassing overview.
-
-=head2 Example
-
- package MyPerlSource;
-
- use strict;
- use vars '@ISA';
-
- use Carp qw( croak );
- use TAP::Parser::Source::Perl;
-
- @ISA = qw( TAP::Parser::Source::Perl );
-
- sub source {
- my ($self, $args) = @_;
- if ($args) {
- $self->{file} = $args->[0];
- return $self->SUPER::source($args);
- }
- return $self->SUPER::source;
- }
-
- # use the version of perl from the shebang line in the test file
- sub _get_perl {
- my $self = shift;
- if (my $shebang = $self->shebang( $self->{file} )) {
- $shebang =~ /^#!(.*\bperl.*?)(?:(?:\s)|(?:$))/;
- return $1 if $1;
- }
- return $self->SUPER::_get_perl(@_);
- }
-
-=head1 SEE ALSO
-
-L<TAP::Object>,
-L<TAP::Parser>,
-L<TAP::Parser::Source>,
-
-=cut
diff --git a/Master/tlpkg/tlperl/lib/TAP/Parser/SourceHandler.pm b/Master/tlpkg/tlperl/lib/TAP/Parser/SourceHandler.pm
new file mode 100644
index 00000000000..acacb0b417e
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/TAP/Parser/SourceHandler.pm
@@ -0,0 +1,194 @@
+package TAP::Parser::SourceHandler;
+
+use strict;
+use vars qw($VERSION @ISA);
+
+use TAP::Object ();
+use TAP::Parser::Iterator ();
+
+@ISA = qw(TAP::Object);
+
+=head1 NAME
+
+TAP::Parser::SourceHandler - Base class for different TAP source handlers
+
+=head1 VERSION
+
+Version 3.23
+
+=cut
+
+$VERSION = '3.23';
+
+=head1 SYNOPSIS
+
+ # abstract class - don't use directly!
+ # see TAP::Parser::IteratorFactory for general usage
+
+ # must be sub-classed for use
+ package MySourceHandler;
+ use base qw( TAP::Parser::SourceHandler );
+ sub can_handle { return $confidence_level }
+ sub make_iterator { return $iterator }
+
+ # see example below for more details
+
+=head1 DESCRIPTION
+
+This is an abstract base class for L<TAP::Parser::Source> handlers / handlers.
+
+A C<TAP::Parser::SourceHandler> does whatever is necessary to produce & capture
+a stream of TAP from the I<raw> source, and package it up in a
+L<TAP::Parser::Iterator> for the parser to consume.
+
+C<SourceHandlers> must implement the I<source detection & handling> interface
+used by L<TAP::Parser::IteratorFactory>. At 2 methods, the interface is pretty
+simple: L</can_handle> and L</make_source>.
+
+Unless you're writing a new L<TAP::Parser::SourceHandler>, a plugin, or
+subclassing L<TAP::Parser>, you probably won't need to use this module directly.
+
+=head1 METHODS
+
+=head2 Class Methods
+
+=head3 C<can_handle>
+
+I<Abstract method>.
+
+ my $vote = $class->can_handle( $source );
+
+C<$source> is a L<TAP::Parser::Source>.
+
+Returns a number between C<0> & C<1> reflecting how confidently the raw source
+can be handled. For example, C<0> means the source cannot handle it, C<0.5>
+means it may be able to, and C<1> means it definitely can. See
+L<TAP::Parser::IteratorFactory/detect_source> for details on how this is used.
+
+=cut
+
+sub can_handle {
+ my ( $class, $args ) = @_;
+ $class->_croak(
+ "Abstract method 'can_handle' not implemented for $class!");
+ return;
+}
+
+=head3 C<make_iterator>
+
+I<Abstract method>.
+
+ my $iterator = $class->make_iterator( $source );
+
+C<$source> is a L<TAP::Parser::Source>.
+
+Returns a new L<TAP::Parser::Iterator> object for use by the L<TAP::Parser>.
+C<croak>s on error.
+
+=cut
+
+sub make_iterator {
+ my ( $class, $args ) = @_;
+ $class->_croak(
+ "Abstract method 'make_iterator' not implemented for $class!");
+ return;
+}
+1;
+
+__END__
+
+=head1 SUBCLASSING
+
+Please see L<TAP::Parser/SUBCLASSING> for a subclassing overview, and any
+of the subclasses that ship with this module as an example. What follows is
+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.
+
+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.
+If you're using L<prove> you can write an L<App::Prove> plugin. If you're
+using L<TAP::Parser> or L<TAP::Harness> directly (e.g. through a custom script,
+L<ExtUtils::MakeMaker>, or L<Module::Build>) you can use the C<config> option
+which will cause L<TAP::Parser::IteratorFactory/load_sources> to load your
+subclass).
+
+Don't forget to register your class with
+L<TAP::Parser::IteratorFactory/register_handler>.
+
+=head2 Example
+
+ 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 );
+
+ TAP::Parser::IteratorFactory->register_handler( __PACKAGE__ );
+
+ sub can_handle {
+ my ( $class, $src ) = @_;
+ my $meta = $src->meta;
+ my $config = $src->config_for( $class );
+
+ if ($config->{accept_all}) {
+ return 1.0;
+ } elsif (my $file = $meta->{file}) {
+ return 0.0 unless $file->{exists};
+ return 1.0 if $file->{lc_ext} eq '.tap';
+ return 0.9 if $file->{shebang} && $file->{shebang} =~ /^#!.+tap/;
+ return 0.5 if $file->{text};
+ return 0.1 if $file->{binary};
+ } elsif ($meta->{scalar}) {
+ return 0.8 if $$raw_source_ref =~ /\d\.\.\d/;
+ return 0.6 if $meta->{has_newlines};
+ } elsif ($meta->{array}) {
+ return 0.8 if $meta->{size} < 5;
+ return 0.6 if $raw_source_ref->[0] =~ /foo/;
+ return 0.5;
+ } elsif ($meta->{hash}) {
+ return 0.6 if $raw_source_ref->{foo};
+ return 0.2;
+ }
+
+ return 0;
+ }
+
+ sub make_iterator {
+ my ($class, $source) = @_;
+ # this is where you manipulate the source and
+ # capture the stream of TAP in an iterator
+ # either pick a TAP::Parser::Iterator::* or write your own...
+ my $iterator = TAP::Parser::Iterator::Array->new([ 'foo', 'bar' ]);
+ return $iterator;
+ }
+
+ 1;
+
+=head1 AUTHORS
+
+TAPx Developers.
+
+Source detection stuff added by Steve Purkis
+
+=head1 SEE ALSO
+
+L<TAP::Object>,
+L<TAP::Parser>,
+L<TAP::Parser::Source>,
+L<TAP::Parser::Iterator>,
+L<TAP::Parser::IteratorFactory>,
+L<TAP::Parser::SourceHandler::Executable>,
+L<TAP::Parser::SourceHandler::Perl>,
+L<TAP::Parser::SourceHandler::File>,
+L<TAP::Parser::SourceHandler::Handle>,
+L<TAP::Parser::SourceHandler::RawTAP>
+
+=cut
+
diff --git a/Master/tlpkg/tlperl/lib/TAP/Parser/SourceHandler/Executable.pm b/Master/tlpkg/tlperl/lib/TAP/Parser/SourceHandler/Executable.pm
new file mode 100644
index 00000000000..8537ba18bf5
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/TAP/Parser/SourceHandler/Executable.pm
@@ -0,0 +1,186 @@
+package TAP::Parser::SourceHandler::Executable;
+
+use strict;
+use vars qw($VERSION @ISA);
+
+use TAP::Parser::SourceHandler ();
+use TAP::Parser::IteratorFactory ();
+use TAP::Parser::Iterator::Process ();
+
+@ISA = qw(TAP::Parser::SourceHandler);
+
+TAP::Parser::IteratorFactory->register_handler(__PACKAGE__);
+
+=head1 NAME
+
+TAP::Parser::SourceHandler::Executable - Stream output from an executable TAP source
+
+=head1 VERSION
+
+Version 3.23
+
+=cut
+
+$VERSION = '3.23';
+
+=head1 SYNOPSIS
+
+ use TAP::Parser::Source;
+ use TAP::Parser::SourceHandler::Executable;
+
+ my $source = TAP::Parser::Source->new->raw(['/usr/bin/ruby', 'mytest.rb']);
+ $source->assemble_meta;
+
+ my $class = 'TAP::Parser::SourceHandler::Executable';
+ my $vote = $class->can_handle( $source );
+ my $iter = $class->make_iterator( $source );
+
+=head1 DESCRIPTION
+
+This is an I<executable> L<TAP::Parser::SourceHandler> - it has 2 jobs:
+
+1. Figure out if the L<TAP::Parser::Source> it's given is an executable
+ command (L</can_handle>).
+
+2. Creates an iterator for executable commands (L</make_iterator>).
+
+Unless you're writing a plugin or subclassing L<TAP::Parser>, you
+probably won't need to use this module directly.
+
+=head1 METHODS
+
+=head2 Class Methods
+
+=head3 C<can_handle>
+
+ my $vote = $class->can_handle( $source );
+
+Only votes if $source looks like an executable file. Casts the
+following votes:
+
+ 0.9 if it's a hash with an 'exec' key
+ 0.8 if it's a .bat file
+ 0.75 if it's got an execute bit set
+
+=cut
+
+sub can_handle {
+ my ( $class, $src ) = @_;
+ my $meta = $src->meta;
+
+ if ( $meta->{is_file} ) {
+ my $file = $meta->{file};
+
+ return 0.85 if $file->{execute} && $file->{binary};
+ return 0.8 if $file->{lc_ext} eq '.bat';
+ return 0.25 if $file->{execute};
+ }
+ elsif ( $meta->{is_hash} ) {
+ return 0.9 if $src->raw->{exec};
+ }
+
+ return 0;
+}
+
+=head3 C<make_iterator>
+
+ my $iterator = $class->make_iterator( $source );
+
+Returns a new L<TAP::Parser::Iterator::Process> for the source.
+C<$source-E<gt>raw> must be in one of the following forms:
+
+ { exec => [ @exec ] }
+
+ [ @exec ]
+
+ $file
+
+C<croak>s on error.
+
+=cut
+
+sub make_iterator {
+ my ( $class, $source ) = @_;
+ my $meta = $source->meta;
+
+ my @command;
+ if ( $meta->{is_hash} ) {
+ @command = @{ $source->raw->{exec} || [] };
+ }
+ elsif ( $meta->{is_scalar} ) {
+ @command = ${ $source->raw };
+ }
+ elsif ( $meta->{is_array} ) {
+ @command = @{ $source->raw };
+ }
+
+ $class->_croak('No command found in $source->raw!') unless @command;
+
+ $class->_autoflush( \*STDOUT );
+ $class->_autoflush( \*STDERR );
+
+ push @command, @{ $source->test_args || [] };
+
+ return $class->iterator_class->new(
+ { command => \@command,
+ merge => $source->merge
+ }
+ );
+}
+
+=head3 C<iterator_class>
+
+The class of iterator to use, override if you're sub-classing. Defaults
+to L<TAP::Parser::Iterator::Process>.
+
+=cut
+
+use constant iterator_class => 'TAP::Parser::Iterator::Process';
+
+# Turns on autoflush for the handle passed
+sub _autoflush {
+ my ( $class, $flushed ) = @_;
+ my $old_fh = select $flushed;
+ $| = 1;
+ select $old_fh;
+}
+
+1;
+
+=head1 SUBCLASSING
+
+Please see L<TAP::Parser/SUBCLASSING> for a subclassing overview.
+
+=head2 Example
+
+ package MyRubySourceHandler;
+
+ use strict;
+ use vars '@ISA';
+
+ use Carp qw( croak );
+ use TAP::Parser::SourceHandler::Executable;
+
+ @ISA = qw( TAP::Parser::SourceHandler::Executable );
+
+ # expect $handler->(['mytest.rb', 'cmdline', 'args']);
+ sub make_iterator {
+ my ($self, $source) = @_;
+ my @test_args = @{ $source->test_args };
+ my $rb_file = $test_args[0];
+ croak("error: Ruby file '$rb_file' not found!") unless (-f $rb_file);
+ return $self->SUPER::raw_source(['/usr/bin/ruby', @test_args]);
+ }
+
+=head1 SEE ALSO
+
+L<TAP::Object>,
+L<TAP::Parser>,
+L<TAP::Parser::IteratorFactory>,
+L<TAP::Parser::SourceHandler>,
+L<TAP::Parser::SourceHandler::Perl>,
+L<TAP::Parser::SourceHandler::File>,
+L<TAP::Parser::SourceHandler::Handle>,
+L<TAP::Parser::SourceHandler::RawTAP>
+
+=cut
diff --git a/Master/tlpkg/tlperl/lib/TAP/Parser/SourceHandler/File.pm b/Master/tlpkg/tlperl/lib/TAP/Parser/SourceHandler/File.pm
new file mode 100644
index 00000000000..ab08eb2922f
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/TAP/Parser/SourceHandler/File.pm
@@ -0,0 +1,136 @@
+package TAP::Parser::SourceHandler::File;
+
+use strict;
+use vars qw($VERSION @ISA);
+
+use TAP::Parser::SourceHandler ();
+use TAP::Parser::IteratorFactory ();
+use TAP::Parser::Iterator::Stream ();
+
+@ISA = qw(TAP::Parser::SourceHandler);
+
+TAP::Parser::IteratorFactory->register_handler(__PACKAGE__);
+
+=head1 NAME
+
+TAP::Parser::SourceHandler::File - Stream TAP from a text file.
+
+=head1 VERSION
+
+Version 3.23
+
+=cut
+
+$VERSION = '3.23';
+
+=head1 SYNOPSIS
+
+ use TAP::Parser::Source;
+ use TAP::Parser::SourceHandler::File;
+
+ my $source = TAP::Parser::Source->new->raw( \'file.tap' );
+ $source->assemble_meta;
+
+ my $class = 'TAP::Parser::SourceHandler::File';
+ my $vote = $class->can_handle( $source );
+ my $iter = $class->make_iterator( $source );
+
+=head1 DESCRIPTION
+
+This is a I<raw TAP stored in a file> L<TAP::Parser::SourceHandler> - it has 2 jobs:
+
+1. Figure out if the I<raw> source it's given is a file containing raw TAP
+output. See L<TAP::Parser::IteratorFactory> for more details.
+
+2. Takes raw TAP from the text file given, and converts into an iterator.
+
+Unless you're writing a plugin or subclassing L<TAP::Parser>, you probably
+won't need to use this module directly.
+
+=head1 METHODS
+
+=head2 Class Methods
+
+=head3 C<can_handle>
+
+ my $vote = $class->can_handle( $source );
+
+Only votes if $source looks like a regular file. Casts the following votes:
+
+ 0.9 if it's a .tap file
+ 0.9 if it has an extension matching any given in user config.
+
+=cut
+
+sub can_handle {
+ my ( $class, $src ) = @_;
+ my $meta = $src->meta;
+ my $config = $src->config_for($class);
+
+ return 0 unless $meta->{is_file};
+ my $file = $meta->{file};
+ return 0.9 if $file->{lc_ext} eq '.tap';
+
+ if ( my $exts = $config->{extensions} ) {
+ return 0.9 if grep { lc($_) eq $file->{lc_ext} } @$exts;
+ }
+
+ return 0;
+}
+
+=head3 C<make_iterator>
+
+ my $iterator = $class->make_iterator( $source );
+
+Returns a new L<TAP::Parser::Iterator::Stream> for the source. C<croak>s
+on error.
+
+=cut
+
+sub make_iterator {
+ my ( $class, $source ) = @_;
+
+ $class->_croak('$source->raw must be a scalar ref')
+ unless $source->meta->{is_scalar};
+
+ my $file = ${ $source->raw };
+ my $fh;
+ open( $fh, '<', $file )
+ or $class->_croak("error opening TAP source file '$file': $!");
+ return $class->iterator_class->new($fh);
+}
+
+=head3 C<iterator_class>
+
+The class of iterator to use, override if you're sub-classing. Defaults
+to L<TAP::Parser::Iterator::Stream>.
+
+=cut
+
+use constant iterator_class => 'TAP::Parser::Iterator::Stream';
+
+1;
+
+__END__
+
+=head1 CONFIGURATION
+
+ {
+ extensions => [ @case_insensitive_exts_to_match ]
+ }
+
+=head1 SUBCLASSING
+
+Please see L<TAP::Parser/SUBCLASSING> for a subclassing overview.
+
+=head1 SEE ALSO
+
+L<TAP::Object>,
+L<TAP::Parser>,
+L<TAP::Parser::SourceHandler>,
+L<TAP::Parser::SourceHandler::Executable>,
+L<TAP::Parser::SourceHandler::Perl>,
+L<TAP::Parser::SourceHandler::Handle>,
+L<TAP::Parser::SourceHandler::RawTAP>
+
+=cut
diff --git a/Master/tlpkg/tlperl/lib/TAP/Parser/SourceHandler/Handle.pm b/Master/tlpkg/tlperl/lib/TAP/Parser/SourceHandler/Handle.pm
new file mode 100644
index 00000000000..fc2e65461ca
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/TAP/Parser/SourceHandler/Handle.pm
@@ -0,0 +1,125 @@
+package TAP::Parser::SourceHandler::Handle;
+
+use strict;
+use vars qw($VERSION @ISA);
+
+use TAP::Parser::SourceHandler ();
+use TAP::Parser::IteratorFactory ();
+use TAP::Parser::Iterator::Stream ();
+
+@ISA = qw(TAP::Parser::SourceHandler);
+
+TAP::Parser::IteratorFactory->register_handler(__PACKAGE__);
+
+=head1 NAME
+
+TAP::Parser::SourceHandler::Handle - Stream TAP from an IO::Handle or a GLOB.
+
+=head1 VERSION
+
+Version 3.23
+
+=cut
+
+$VERSION = '3.23';
+
+=head1 SYNOPSIS
+
+ use TAP::Parser::Source;
+ use TAP::Parser::SourceHandler::Executable;
+
+ my $source = TAP::Parser::Source->new->raw( \*TAP_FILE );
+ $source->assemble_meta;
+
+ my $class = 'TAP::Parser::SourceHandler::Handle';
+ my $vote = $class->can_handle( $source );
+ my $iter = $class->make_iterator( $source );
+
+=head1 DESCRIPTION
+
+This is a I<raw TAP stored in an IO Handle> L<TAP::Parser::SourceHandler> class. It
+has 2 jobs:
+
+1. Figure out if the L<TAP::Parser::Source> it's given is an L<IO::Handle> or
+GLOB containing raw TAP output (L</can_handle>).
+
+2. Creates an iterator for IO::Handle's & globs (L</make_iterator>).
+
+Unless you're writing a plugin or subclassing L<TAP::Parser>, you probably
+won't need to use this module directly.
+
+=head1 METHODS
+
+=head2 Class Methods
+
+=head3 C<can_handle>
+
+ my $vote = $class->can_handle( $source );
+
+Casts the following votes:
+
+ 0.9 if $source is an IO::Handle
+ 0.8 if $source is a glob
+
+=cut
+
+sub can_handle {
+ my ( $class, $src ) = @_;
+ my $meta = $src->meta;
+
+ return 0.9
+ if $meta->{is_object}
+ && UNIVERSAL::isa( $src->raw, 'IO::Handle' );
+
+ return 0.8 if $meta->{is_glob};
+
+ return 0;
+}
+
+=head3 C<make_iterator>
+
+ my $iterator = $class->make_iterator( $source );
+
+Returns a new L<TAP::Parser::Iterator::Stream> for the source.
+
+=cut
+
+sub make_iterator {
+ my ( $class, $source ) = @_;
+
+ $class->_croak('$source->raw must be a glob ref or an IO::Handle')
+ unless $source->meta->{is_glob}
+ || UNIVERSAL::isa( $source->raw, 'IO::Handle' );
+
+ return $class->iterator_class->new( $source->raw );
+}
+
+=head3 C<iterator_class>
+
+The class of iterator to use, override if you're sub-classing. Defaults
+to L<TAP::Parser::Iterator::Stream>.
+
+=cut
+
+use constant iterator_class => 'TAP::Parser::Iterator::Stream';
+
+1;
+
+=head1 SUBCLASSING
+
+Please see L<TAP::Parser/SUBCLASSING> for a subclassing overview.
+
+=head1 SEE ALSO
+
+L<TAP::Object>,
+L<TAP::Parser>,
+L<TAP::Parser::Iterator>,
+L<TAP::Parser::Iterator::Stream>,
+L<TAP::Parser::IteratorFactory>,
+L<TAP::Parser::SourceHandler>,
+L<TAP::Parser::SourceHandler::Executable>,
+L<TAP::Parser::SourceHandler::Perl>,
+L<TAP::Parser::SourceHandler::File>,
+L<TAP::Parser::SourceHandler::RawTAP>
+
+=cut
diff --git a/Master/tlpkg/tlperl/lib/TAP/Parser/SourceHandler/Perl.pm b/Master/tlpkg/tlperl/lib/TAP/Parser/SourceHandler/Perl.pm
new file mode 100644
index 00000000000..9721acf9f11
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/TAP/Parser/SourceHandler/Perl.pm
@@ -0,0 +1,362 @@
+package TAP::Parser::SourceHandler::Perl;
+
+use strict;
+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 );
+
+@ISA = 'TAP::Parser::SourceHandler::Executable';
+
+TAP::Parser::IteratorFactory->register_handler(__PACKAGE__);
+
+=head1 NAME
+
+TAP::Parser::SourceHandler::Perl - Stream TAP from a Perl executable
+
+=head1 VERSION
+
+Version 3.23
+
+=cut
+
+$VERSION = '3.23';
+
+=head1 SYNOPSIS
+
+ use TAP::Parser::Source;
+ use TAP::Parser::SourceHandler::Perl;
+
+ my $source = TAP::Parser::Source->new->raw( \'script.pl' );
+ $source->assemble_meta;
+
+ my $class = 'TAP::Parser::SourceHandler::Perl';
+ my $vote = $class->can_handle( $source );
+ my $iter = $class->make_iterator( $source );
+
+=head1 DESCRIPTION
+
+This is a I<Perl> L<TAP::Parser::SourceHandler> - it has 2 jobs:
+
+1. Figure out if the L<TAP::Parser::Source> it's given is actually a Perl
+script (L</can_handle>).
+
+2. Creates an iterator for Perl sources (L</make_iterator>).
+
+Unless you're writing a plugin or subclassing L<TAP::Parser>, you probably
+won't need to use this module directly.
+
+=head1 METHODS
+
+=head2 Class Methods
+
+=head3 C<can_handle>
+
+ my $vote = $class->can_handle( $source );
+
+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.8 if it's a .t file
+ 0.9 if it's a .pl file
+ 0.75 if it's in a 't' directory
+ 0.25 by default (backwards compat)
+
+=cut
+
+sub can_handle {
+ my ( $class, $source ) = @_;
+ my $meta = $source->meta;
+
+ return 0 unless $meta->{is_file};
+ my $file = $meta->{file};
+
+ if ( my $shebang = $file->{shebang} ) {
+ return 0.9 if $shebang =~ /^#!.*\bperl/;
+ # We favour Perl as the interpreter for any shebang to preserve
+ # previous semantics: we used to execute everything via Perl and
+ # relied on it to pass the shebang off to the appropriate
+ # interpreter.
+ return 0.3;
+ }
+
+ return 0.8 if $file->{lc_ext} eq '.t'; # vote higher than Executable
+ return 0.9 if $file->{lc_ext} eq '.pl';
+
+ return 0.75 if $file->{dir} =~ /^t\b/; # vote higher than Executable
+
+ # backwards compat, always vote:
+ return 0.25;
+}
+
+=head3 C<make_iterator>
+
+ my $iterator = $class->make_iterator( $source );
+
+Constructs & returns a new L<TAP::Parser::Iterator::Process> for the source.
+Assumes C<$source-E<gt>raw> contains a reference to the perl script. C<croak>s
+if the file could not be found.
+
+The command to run is built as follows:
+
+ $perl @switches $perl_script @test_args
+
+The perl command to use is determined by L</get_perl>. The command generated
+is guaranteed to preserve:
+
+ PERL5LIB
+ PERL5OPT
+ Taint Mode, if set in the script's shebang
+
+I<Note:> the command generated will I<not> respect any shebang line defined in
+your Perl script. This is only a problem if you have compiled a custom version
+of Perl or if you want to use a specific version of Perl for one test and a
+different version for another, for example:
+
+ #!/path/to/a/custom_perl --some --args
+ #!/usr/local/perl-5.6/bin/perl -w
+
+Currently you need to write a plugin to get around this.
+
+=cut
+
+sub _autoflush_stdhandles {
+ my ($class) = @_;
+
+ $class->_autoflush( \*STDOUT );
+ $class->_autoflush( \*STDERR );
+}
+
+sub make_iterator {
+ my ( $class, $source ) = @_;
+ my $meta = $source->meta;
+ my $perl_script = ${ $source->raw };
+
+ $class->_croak("Cannot find ($perl_script)") unless $meta->{is_file};
+
+ # TODO: does this really need to be done here?
+ $class->_autoflush_stdhandles;
+
+ my ( $libs, $switches )
+ = $class->_mangle_switches(
+ $class->_filter_libs( $class->_switches($source) ) );
+
+ $class->_run( $source, $libs, $switches );
+}
+
+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} ) {
+ return (
+ $libs,
+ [ @{$switches},
+ $class->_libs2switches($libs),
+ split_shell( $ENV{PERL5OPT} )
+ ],
+ );
+ }
+
+ return ( $libs, $switches );
+}
+
+sub _filter_libs {
+ my ( $class, @switches ) = @_;
+
+ my $path_sep = $Config{path_sep};
+ my $path_re = qr{$path_sep};
+
+ # Filter out any -I switches to be handled as libs later.
+ #
+ # Nasty kludge. It might be nicer if we got the libs separately
+ # although at least this way we find any -I switches that were
+ # supplied other then as explicit libs.
+ #
+ # We filter out any names containing colons because they will break
+ # PERL5LIB
+ my @libs;
+ my @filtered_switches;
+ for (@switches) {
+ if ( !/$path_re/ && m/ ^ ['"]? -I ['"]? (.*?) ['"]? $ /x ) {
+ push @libs, $1;
+ }
+ else {
+ push @filtered_switches, $_;
+ }
+ }
+
+ return \@libs, \@filtered_switches;
+}
+
+sub _iterator_hooks {
+ my ( $class, $source, $libs ) = @_;
+
+ my $setup = sub {
+ if ( @{$libs} ) {
+ $ENV{PERL5LIB} = join(
+ $Config{path_sep}, grep {defined} @{$libs},
+ $ENV{PERL5LIB}
+ );
+ }
+ };
+
+ # Cargo culted from comments seen elsewhere about VMS / environment
+ # variables. I don't know if this is actually necessary.
+ my $previous = $ENV{PERL5LIB};
+ my $teardown = sub {
+ if ( defined $previous ) {
+ $ENV{PERL5LIB} = $previous;
+ }
+ else {
+ delete $ENV{PERL5LIB};
+ }
+ };
+
+ return ( $setup, $teardown );
+}
+
+sub _run {
+ my ( $class, $source, $libs, $switches ) = @_;
+
+ my @command = $class->_get_command_for_switches( $source, $switches )
+ or $class->_croak("No command found!");
+
+ my ( $setup, $teardown ) = $class->_iterator_hooks( $source, $libs );
+
+ return $class->_create_iterator( $source, \@command, $setup, $teardown );
+}
+
+sub _create_iterator {
+ my ( $class, $source, $command, $setup, $teardown ) = @_;
+
+ return TAP::Parser::Iterator::Process->new(
+ { command => $command,
+ merge => $source->merge,
+ setup => $setup,
+ teardown => $teardown,
+ }
+ );
+}
+
+sub _get_command_for_switches {
+ my ( $class, $source, $switches ) = @_;
+ my $file = ${ $source->raw };
+ my @args = @{ $source->test_args || [] };
+ my $command = $class->get_perl;
+
+ # XXX don't need to quote if we treat the parts as atoms (except maybe vms)
+ #$file = qq["$file"] if ( $file =~ /\s/ ) && ( $file !~ /^".*"$/ );
+ my @command = ( $command, @{$switches}, $file, @args );
+ return @command;
+}
+
+sub _libs2switches {
+ my $class = shift;
+ return map {"-I$_"} grep {$_} @{ $_[0] };
+}
+
+=head3 C<get_taint>
+
+Decode any taint switches from a Perl shebang line.
+
+ # $taint will be 't'
+ my $taint = TAP::Parser::SourceHandler::Perl->get_taint( '#!/usr/bin/perl -t' );
+
+ # $untaint will be undefined
+ my $untaint = TAP::Parser::SourceHandler::Perl->get_taint( '#!/usr/bin/perl' );
+
+=cut
+
+sub get_taint {
+ my ( $class, $shebang ) = @_;
+ return
+ unless defined $shebang
+ && $shebang =~ /^#!.*\bperl.*\s-\w*([Tt]+)/;
+ return $1;
+}
+
+sub _switches {
+ my ( $class, $source ) = @_;
+ my $file = ${ $source->raw };
+ my @switches = @{ $source->switches || [] };
+ my $shebang = $source->meta->{file}->{shebang};
+ return unless defined $shebang;
+
+ my $taint = $class->get_taint($shebang);
+ push @switches, "-$taint" if defined $taint;
+
+ # Quote the argument if we're VMS, since VMS will downcase anything
+ # not quoted.
+ if (IS_VMS) {
+ for (@switches) {
+ $_ = qq["$_"];
+ }
+ }
+
+ return @switches;
+}
+
+=head3 C<get_perl>
+
+Gets the version of Perl currently running the test suite.
+
+=cut
+
+sub get_perl {
+ my $class = shift;
+ return $ENV{HARNESS_PERL} if defined $ENV{HARNESS_PERL};
+ return Win32::GetShortPathName($^X) if IS_WIN32;
+ return $^X;
+}
+
+1;
+
+__END__
+
+=head1 SUBCLASSING
+
+Please see L<TAP::Parser/SUBCLASSING> for a subclassing overview.
+
+=head2 Example
+
+ package MyPerlSourceHandler;
+
+ use strict;
+ use vars '@ISA';
+
+ use TAP::Parser::SourceHandler::Perl;
+
+ @ISA = qw( TAP::Parser::SourceHandler::Perl );
+
+ # use the version of perl from the shebang line in the test file
+ sub get_perl {
+ my $self = shift;
+ if (my $shebang = $self->shebang( $self->{file} )) {
+ $shebang =~ /^#!(.*\bperl.*?)(?:(?:\s)|(?:$))/;
+ return $1 if $1;
+ }
+ return $self->SUPER::get_perl(@_);
+ }
+
+=head1 SEE ALSO
+
+L<TAP::Object>,
+L<TAP::Parser>,
+L<TAP::Parser::IteratorFactory>,
+L<TAP::Parser::SourceHandler>,
+L<TAP::Parser::SourceHandler::Executable>,
+L<TAP::Parser::SourceHandler::File>,
+L<TAP::Parser::SourceHandler::Handle>,
+L<TAP::Parser::SourceHandler::RawTAP>
+
+=cut
diff --git a/Master/tlpkg/tlperl/lib/TAP/Parser/SourceHandler/RawTAP.pm b/Master/tlpkg/tlperl/lib/TAP/Parser/SourceHandler/RawTAP.pm
new file mode 100644
index 00000000000..0d7a4851ee8
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/TAP/Parser/SourceHandler/RawTAP.pm
@@ -0,0 +1,131 @@
+package TAP::Parser::SourceHandler::RawTAP;
+
+use strict;
+use vars qw($VERSION @ISA);
+
+use TAP::Parser::SourceHandler ();
+use TAP::Parser::IteratorFactory ();
+use TAP::Parser::Iterator::Array ();
+
+@ISA = qw(TAP::Parser::SourceHandler);
+
+TAP::Parser::IteratorFactory->register_handler(__PACKAGE__);
+
+=head1 NAME
+
+TAP::Parser::SourceHandler::RawTAP - Stream output from raw TAP in a scalar/array ref.
+
+=head1 VERSION
+
+Version 3.23
+
+=cut
+
+$VERSION = '3.23';
+
+=head1 SYNOPSIS
+
+ use TAP::Parser::Source;
+ use TAP::Parser::SourceHandler::RawTAP;
+
+ my $source = TAP::Parser::Source->new->raw( \"1..1\nok 1\n" );
+ $source->assemble_meta;
+
+ my $class = 'TAP::Parser::SourceHandler::RawTAP';
+ my $vote = $class->can_handle( $source );
+ my $iter = $class->make_iterator( $source );
+
+=head1 DESCRIPTION
+
+This is a I<raw TAP output> L<TAP::Parser::SourceHandler> - it has 2 jobs:
+
+1. Figure out if the L<TAP::Parser::Source> it's given is raw TAP output
+(L</can_handle>).
+
+2. Creates an iterator for raw TAP output (L</make_iterator>).
+
+Unless you're writing a plugin or subclassing L<TAP::Parser>, you probably
+won't need to use this module directly.
+
+=head1 METHODS
+
+=head2 Class Methods
+
+=head3 C<can_handle>
+
+ my $vote = $class->can_handle( $source );
+
+Only votes if $source is an array, or a scalar with newlines. Casts the
+following votes:
+
+ 0.9 if it's a scalar with '..' in it
+ 0.7 if it's a scalar with 'ok' in it
+ 0.3 if it's just a scalar with newlines
+ 0.5 if it's an array
+
+=cut
+
+sub can_handle {
+ my ( $class, $src ) = @_;
+ my $meta = $src->meta;
+
+ return 0 if $meta->{file};
+ if ( $meta->{is_scalar} ) {
+ return 0 unless $meta->{has_newlines};
+ return 0.9 if ${ $src->raw } =~ /\d\.\.\d/;
+ return 0.7 if ${ $src->raw } =~ /ok/;
+ return 0.3;
+ }
+ elsif ( $meta->{is_array} ) {
+ return 0.5;
+ }
+ return 0;
+}
+
+=head3 C<make_iterator>
+
+ my $iterator = $class->make_iterator( $source );
+
+Returns a new L<TAP::Parser::Iterator::Array> for the source.
+C<$source-E<gt>raw> must be an array ref, or a scalar ref.
+
+C<croak>s on error.
+
+=cut
+
+sub make_iterator {
+ my ( $class, $src ) = @_;
+ my $meta = $src->meta;
+
+ my $tap_array;
+ if ( $meta->{is_scalar} ) {
+ $tap_array = [ split "\n" => ${ $src->raw } ];
+ }
+ elsif ( $meta->{is_array} ) {
+ $tap_array = $src->raw;
+ }
+
+ $class->_croak('No raw TAP found in $source->raw')
+ unless scalar $tap_array;
+
+ return TAP::Parser::Iterator::Array->new($tap_array);
+}
+
+1;
+
+=head1 SUBCLASSING
+
+Please see L<TAP::Parser/SUBCLASSING> for a subclassing overview.
+
+=head1 SEE ALSO
+
+L<TAP::Object>,
+L<TAP::Parser>,
+L<TAP::Parser::IteratorFactory>,
+L<TAP::Parser::SourceHandler>,
+L<TAP::Parser::SourceHandler::Executable>,
+L<TAP::Parser::SourceHandler::Perl>,
+L<TAP::Parser::SourceHandler::File>,
+L<TAP::Parser::SourceHandler::Handle>
+
+=cut
diff --git a/Master/tlpkg/tlperl/lib/TAP/Parser/Utils.pm b/Master/tlpkg/tlperl/lib/TAP/Parser/Utils.pm
index a3d2dd1ea98..49a457a3783 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Parser/Utils.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Parser/Utils.pm
@@ -13,11 +13,11 @@ TAP::Parser::Utils - Internal TAP::Parser utilities
=head1 VERSION
-Version 3.17
+Version 3.23
=cut
-$VERSION = '3.17';
+$VERSION = '3.23';
=head1 SYNOPSIS
diff --git a/Master/tlpkg/tlperl/lib/TAP/Parser/YAMLish/Reader.pm b/Master/tlpkg/tlperl/lib/TAP/Parser/YAMLish/Reader.pm
index 524d7dca8df..82968b42b1d 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Parser/YAMLish/Reader.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Parser/YAMLish/Reader.pm
@@ -6,7 +6,7 @@ use vars qw($VERSION @ISA);
use TAP::Object ();
@ISA = 'TAP::Object';
-$VERSION = '3.17';
+$VERSION = '3.23';
# TODO:
# Handle blessed object syntax
@@ -270,7 +270,7 @@ TAP::Parser::YAMLish::Reader - Read YAMLish data from iterator
=head1 VERSION
-Version 3.17
+Version 3.23
=head1 SYNOPSIS
@@ -294,7 +294,7 @@ C<TAP::Parser::YAMLish::Reader> object.
=head3 C<read>
- my $got = $reader->read($stream);
+ my $got = $reader->read($iterator);
Read YAMLish from a L<TAP::Parser::Iterator> and return the data structure it
represents.
@@ -319,7 +319,7 @@ L<http://use.perl.org/~Alias/journal/29427>
=head1 COPYRIGHT
-Copyright 2007-2008 Andy Armstrong.
+Copyright 2007-2011 Andy Armstrong.
Portions copyright 2006-2008 Adam Kennedy.
diff --git a/Master/tlpkg/tlperl/lib/TAP/Parser/YAMLish/Writer.pm b/Master/tlpkg/tlperl/lib/TAP/Parser/YAMLish/Writer.pm
index ed81f6d8191..dda5f1873eb 100644
--- a/Master/tlpkg/tlperl/lib/TAP/Parser/YAMLish/Writer.pm
+++ b/Master/tlpkg/tlperl/lib/TAP/Parser/YAMLish/Writer.pm
@@ -6,7 +6,7 @@ use vars qw($VERSION @ISA);
use TAP::Object ();
@ISA = 'TAP::Object';
-$VERSION = '3.17';
+$VERSION = '3.23';
my $ESCAPE_CHAR = qr{ [ \x00-\x1f \" ] }x;
my $ESCAPE_KEY = qr{ (?: ^\W ) | $ESCAPE_CHAR }x;
@@ -147,7 +147,7 @@ TAP::Parser::YAMLish::Writer - Write YAMLish data
=head1 VERSION
-Version 3.17
+Version 3.23
=head1 SYNOPSIS
@@ -243,7 +243,7 @@ L<http://use.perl.org/~Alias/journal/29427>
=head1 COPYRIGHT
-Copyright 2007-2008 Andy Armstrong.
+Copyright 2007-2011 Andy Armstrong.
This program is free software; you can redistribute
it and/or modify it under the same terms as Perl itself.