NG4R3P

Linux 4gvps.4gvps.com 3.10.0-1127.18.2.vz7.163.46 #1 SMP Fri Nov 20 21:47:55 MSK 2020 x86_64
SOFT : Apache PHP : 7.4.33
/proc/self/root/usr/share/perl5/vendor_perl/TAP/

38.135.39.45

[ NAME ]	[ SIZE ]	[ PERM ]	[ DATE ]	[ ACT ]
+FILE +DIR
Formatter	dir	drwxr-xr-x	2016-08-05 21:27	R D
Harness	dir	drwxr-xr-x	2016-08-05 21:27	R D
Parser	dir	drwxr-xr-x	2016-08-05 21:27	R D
Base.pm	2.176 KB	-rw-r--r--	2013-05-02 19:14	R E G D
Harness.pm	26.536 KB	-rw-r--r--	2013-05-02 19:14	R E G D
Object.pm	2.678 KB	-rw-r--r--	2013-05-02 19:14	R E G D
Parser.pm	50.616 KB	-rw-r--r--	2013-05-02 19:14	R E G D
REQUEST EXIT

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::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 ); =head1 NAME TAP::Parser - Parse L output =head1 VERSION Version 3.28 =cut $VERSION = '3.28'; my $DEFAULT_TAP_VERSION = 12; my $MAX_TAP_VERSION = 13; $ENV{TAP_VERSION} = $MAX_TAP_VERSION; END { # For VMS. delete $ENV{TAP_VERSION}; } BEGIN { # making accessors @ISA = qw(TAP::Base); __PACKAGE__->mk_methods( qw( _iterator _spool exec exit is_good_plan plan tests_planned tests_run wait version in_todo start_time end_time skip_all grammar_class result_factory_class iterator_factory_class ) ); sub _stream { # deprecated my $self = shift; $self->_iterator(@_); } } # done making accessors =head1 SYNOPSIS use TAP::Parser; my $parser = TAP::Parser->new( { source => $source } ); while ( my $result = $parser->next ) { print $result->as_string; } =head1 DESCRIPTION C is designed to produce a proper parse of TAP output. For an example of how to run tests through this module, see the simple harnesses C. There's a wiki dedicated to the Test Anything Protocol: L It includes the TAP::Parser Cookbook: L =head1 METHODS =head2 Class Methods =head3 C my $parser = TAP::Parser->new(\%args); Returns a new C object. The arguments should be a hashref with I of the following keys: =over 4 =item * C I This is the preferred method of passing input to the constructor. The C is used to create a L that is passed to the L which in turn figures out how to handle the source and creates a for it. The iterator is used by the parser to read in the TAP stream. To configure the I use the C parameter below. Note that C, C and C are I. =item * C I The value should be the complete TAP output. The I is used to create a L that is passed to the L which in turn figures out how to handle the source and creates a for it. The iterator is used by the parser to read in the TAP stream. To configure the I use the C parameter below. Note that C, C and C are I. =item * C Must be passed an array reference. The I array ref is used to create a L that is passed to the L which in turn figures out how to handle the source and creates a for it. The iterator is used by the parser to read in the TAP stream. By default the L class will create a L object to handle the source. This passes the array reference strings as command arguments to L: exec => [ '/usr/bin/ruby', 't/my_test.rb' ] If any C are given they will be appended to the end of the command argument list. To configure the I use the C parameter below. Note that C, C and C are I. =back The following keys are optional. =over 4 =item * C I. If set, C must be a hashref containing the names of the Ls to load and/or configure. The values are a hash of configuration that will be accessible to to the source handlers via L. For example: sources => { Perl => { exec => '/path/to/custom/perl' }, File => { extensions => [ '.tap', '.txt' ] }, MyCustom => { some => 'config' }, } This will cause C to pass custom configuration to two of the built- in source handlers - L, L - and attempt to load the C class. See L for more detail. The C parameter affects how C, C and C parameters are handled. See L, L and subclasses for more details. =item * C If present, each callback corresponding to a given result type will be called with the result as the argument if the C method is used: my %callbacks = ( test => \&test_callback, plan => \&plan_callback, comment => \&comment_callback, bailout => \&bailout_callback, unknown => \&unknown_callback, ); my $aggregator = TAP::Parser::Aggregator->new; for my $file ( @test_files ) { my $parser = TAP::Parser->new( { source => $file, callbacks => \%callbacks, } ); $parser->run; $aggregator->add( $file, $parser ); } =item * C If using a Perl file as a source, optional switches may be passed which will be used when invoking the perl executable. my $parser = TAP::Parser->new( { source => $test_file, switches => [ '-Ilib' ], } ); =item * C Used in conjunction with the C and C option to supply a reference to an C<@ARGV> style array of arguments to pass to the test program. =item * C If passed a filehandle will write a copy of all parsed TAP to that handle. =item * C If false, STDERR is not captured (though it is 'relayed' to keep it somewhat synchronized with STDOUT.) If true, STDERR and STDOUT are the same filehandle. This may cause breakage if STDERR contains anything resembling TAP format, but does allow exact synchronization. Subtleties of this behavior may be platform-dependent and may change in the future. =item * C This option was introduced to let you easily customize which I class the parser should use. It defaults to L. See also L. =item * C This option was introduced to let you easily customize which I factory class the parser should use. It defaults to L. See also L. =item * C I This option was introduced to let you easily customize which I factory class the parser should use. It defaults to L. =back =cut # new() implementation supplied by TAP::Base # This should make overriding behaviour of the Parser in subclasses easier: sub _default_grammar_class {'TAP::Parser::Grammar'} sub _default_result_factory_class {'TAP::Parser::ResultFactory'} sub _default_iterator_factory_class {'TAP::Parser::IteratorFactory'} ############################################################################## =head2 Instance Methods =head3 C my $parser = TAP::Parser->new( { source => $file } ); while ( my $result = $parser->next ) { print $result->as_string, "\n"; } This method returns the results of the parsing, one result at a time. Note that it is destructive. You can't rewind and examine previous results. If callbacks are used, they will be issued before this call returns. Each result returned is a subclass of L. See that module and related classes for more information on how to use them. =cut sub next { my $self = shift; return ( $self->{_iter} ||= $self->_iter )->(); } ############################################################################## =head3 C $parser->run; This method merely runs the parser and parses all of the TAP. =cut sub run { my $self = shift; while ( defined( my $result = $self->next ) ) { # do nothing } } ############################################################################## =head3 C Make a new L object and return it. Passes through any arguments given. The C can be customized, as described in L. =head3 C Make a new L object using the parser's L, and return it. Passes through any arguments given. The C can be customized, as described in L. =head3 C I. Make a new L object and return it. Passes through any arguments given. C can be customized, as described in L. =cut # This should make overriding behaviour of the Parser in subclasses easier: 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(@_); } { # of the following, anything beginning with an underscore is strictly # internal and should not be exposed. my %initialize = ( version => $DEFAULT_TAP_VERSION, plan => '', # the test plan (e.g., 1..3) tests_run => 0, # actual current test numbers skipped => [], # todo => [], # passed => [], # failed => [], # actual_failed => [], # how many tests really failed actual_passed => [], # how many tests really passed todo_passed => [], # tests which unexpectedly succeed parse_errors => [], # perfect TAP should have none ); # We seem to have this list hanging around all over the place. We could # probably get it from somewhere else to avoid the repetition. my @legal_callback = qw( test version plan comment bailout unknown yaml ALL ELSE EOF ); my @class_overrides = qw( grammar_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 # TAP::Parser::Iterator. # Shallow copy my %args = %{ $arg_for || {} }; $self->SUPER::_initialize( \%args, \@legal_callback ); # get any class overrides out first: for my $key (@class_overrides) { my $default_method = "_default_$key"; my $val = delete $args{$key} || $self->$default_method(); $self->$key($val); } my $iterator = delete $args{iterator}; $iterator ||= delete $args{stream}; # deprecated my $tap = delete $args{tap}; 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} || []; if ( 1 < grep {defined} $iterator, $tap, $raw_source, $exec ) { $self->_croak( "You may only choose one of 'exec', 'tap', 'source' or 'iterator'" ); } if ( my @excess = sort keys %args ) { $self->_croak("Unknown options: @excess"); } # convert $tap & $exec to $raw_source equiv. my $type = ''; my $source = TAP::Parser::Source->new; if ($tap) { $type = 'raw TAP'; $source->raw( \$tap ); } elsif ($exec) { $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); } 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 ($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->version($version) if $version; $self->_iterator($iterator); $self->_spool($spool); $self->ignore_exit($ignore_exit); return $self; } } =head1 INDIVIDUAL RESULTS If you've read this far in the docs, you've seen this: while ( my $result = $parser->next ) { print $result->as_string; } Each result returned is a L subclass, referred to as I. =head2 Result types Basically, you fetch individual results from the TAP. The six types, with examples of each, are as follows: =over 4 =item * Version TAP version 12 =item * Plan 1..42 =item * Pragma pragma +strict =item * Test ok 3 - We should start with some foobar! =item * Comment # Hope we don't use up the foobar. =item * Bailout Bail out! We ran out of foobar! =item * Unknown ... yo, this ain't TAP! ... =back Each result fetched is a result object of a different type. There are common methods to each result object and different types may have methods unique to their type. Sometimes a type method may be overridden in a subclass, but its use is guaranteed to be identical. =head2 Common type methods =head3 C Returns the type of result, such as C or C. =head3 C Prints a string representation of the token. This might not be the exact output, however. Tests will have test numbers added if not present, TODO and SKIP directives will be capitalized and, in general, things will be cleaned up. If you need the original text for the token, see the C method. =head3 C Returns the original line of text which was parsed. =head3 C Indicates whether or not this is the test plan line. =head3 C Indicates whether or not this is a test line. =head3 C Indicates whether or not this is a comment. Comments will generally only appear in the TAP stream if STDERR is merged to STDOUT. See the C option. =head3 C Indicates whether or not this is bailout line. =head3 C Indicates whether or not the current item is a YAML block. =head3 C Indicates whether or not the current line could be parsed. =head3 C if ( $result->is_ok ) { ... } Reports whether or not a given result has passed. Anything which is B a test result returns true. This is merely provided as a convenient shortcut which allows you to do this: my $parser = TAP::Parser->new( { source => $source } ); while ( my $result = $parser->next ) { # only print failing results print $result->as_string unless $result->is_ok; } =head2 C methods if ( $result->is_plan ) { ... } If the above evaluates as true, the following methods will be available on the C<$result> object. =head3 C if ( $result->is_plan ) { print $result->plan; } This is merely a synonym for C. =head3 C my $directive = $result->directive; If a SKIP directive is included with the plan, this method will return it. 1..0 # SKIP: why bother? =head3 C my $explanation = $result->explanation; If a SKIP directive was included with the plan, this method will return the explanation, if any. =head2 C methods if ( $result->is_pragma ) { ... } If the above evaluates as true, the following methods will be available on the C<$result> object. =head3 C Returns a list of pragmas each of which is a + or - followed by the pragma name. =head2 C methods if ( $result->is_comment ) { ... } If the above evaluates as true, the following methods will be available on the C<$result> object. =head3 C if ( $result->is_comment ) { my $comment = $result->comment; print "I have something to say: $comment"; } =head2 C methods if ( $result->is_bailout ) { ... } If the above evaluates as true, the following methods will be available on the C<$result> object. =head3 C if ( $result->is_bailout ) { my $explanation = $result->explanation; print "We bailed out because ($explanation)"; } If, and only if, a token is a bailout token, you can get an "explanation" via this method. The explanation is the text after the mystical "Bail out!" words which appear in the tap output. =head2 C methods if ( $result->is_unknown ) { ... } There are no unique methods for unknown results. =head2 C methods if ( $result->is_test ) { ... } If the above evaluates as true, the following methods will be available on the C<$result> object. =head3 C my $ok = $result->ok; Returns the literal text of the C or C status. =head3 C my $test_number = $result->number; Returns the number of the test, even if the original TAP output did not supply that number. =head3 C my $description = $result->description; Returns the description of the test, if any. This is the portion after the test number but before the directive. =head3 C my $directive = $result->directive; Returns either C or C if either directive was present for a test line. =head3 C my $explanation = $result->explanation; If a test had either a C or C directive, this method will return the accompanying explanation, if present. not ok 17 - 'Pigs can fly' # TODO not enough acid For the above line, the explanation is I. =head3 C if ( $result->is_ok ) { ... } Returns a boolean value indicating whether or not the test passed. Remember that for TODO tests, the test always passes. B this was formerly C. The latter method is deprecated and will issue a warning. =head3 C if ( $result->is_actual_ok ) { ... } Returns a boolean value indicating whether or not the test passed, regardless of its TODO status. B this was formerly C. The latter method is deprecated and will issue a warning. =head3 C if ( $test->is_unplanned ) { ... } If a test number is greater than the number of planned tests, this method will return true. Unplanned tests will I return false for C, regardless of whether or not the test C (see L for more information about this). =head3 C if ( $result->has_skip ) { ... } Returns a boolean value indicating whether or not this test had a SKIP directive. =head3 C if ( $result->has_todo ) { ... } Returns a boolean value indicating whether or not this test had a TODO directive. Note that TODO tests I pass. If you need to know whether or not they really passed, check the C method. =head3 C if ( $parser->in_todo ) { ... } True while the most recent result was a TODO. Becomes true before the TODO result is returned and stays true until just before the next non- TODO test is returned. =head1 TOTAL RESULTS After parsing the TAP, there are many methods available to let you dig through the results and determine what is meaningful to you. =head2 Individual Results These results refer to individual tests which are run. =head3 C my @passed = $parser->passed; # the test numbers which passed my $passed = $parser->passed; # the number of tests which passed This method lets you know which (or how many) tests passed. If a test failed but had a TODO directive, it will be counted as a passed test. =cut sub passed { return @{ $_[0]->{passed} } if ref $_[0]->{passed}; return wantarray ? 1 .. $_[0]->{passed} : $_[0]->{passed}; } =head3 C my @failed = $parser->failed; # the test numbers which failed my $failed = $parser->failed; # the number of tests which failed This method lets you know which (or how many) tests failed. If a test passed but had a TODO directive, it will B be counted as a failed test. =cut sub failed { @{ shift->{failed} } } =head3 C # the test numbers which actually passed my @actual_passed = $parser->actual_passed; # the number of tests which actually passed my $actual_passed = $parser->actual_passed; This method lets you know which (or how many) tests actually passed, regardless of whether or not a TODO directive was found. =cut sub actual_passed { return @{ $_[0]->{actual_passed} } if ref $_[0]->{actual_passed}; return wantarray ? 1 .. $_[0]->{actual_passed} : $_[0]->{actual_passed}; } *actual_ok = \&actual_passed; =head3 C This method is a synonym for C. =head3 C # the test numbers which actually failed my @actual_failed = $parser->actual_failed; # the number of tests which actually failed my $actual_failed = $parser->actual_failed; This method lets you know which (or how many) tests actually failed, regardless of whether or not a TODO directive was found. =cut sub actual_failed { @{ shift->{actual_failed} } } ############################################################################## =head3 C my @todo = $parser->todo; # the test numbers with todo directives my $todo = $parser->todo; # the number of tests with todo directives This method lets you know which (or how many) tests had TODO directives. =cut sub todo { @{ shift->{todo} } } =head3 C # the test numbers which unexpectedly succeeded my @todo_passed = $parser->todo_passed; # the number of tests which unexpectedly succeeded my $todo_passed = $parser->todo_passed; This method lets you know which (or how many) tests actually passed but were declared as "TODO" tests. =cut sub todo_passed { @{ shift->{todo_passed} } } ############################################################################## =head3 C # deprecated in favor of 'todo_passed'. This method was horribly misnamed. This was a badly misnamed method. It indicates which TODO tests unexpectedly succeeded. Will now issue a warning and call C. =cut sub todo_failed { warn '"todo_failed" is deprecated. Please use "todo_passed". See the docs.'; goto &todo_passed; } =head3 C my @skipped = $parser->skipped; # the test numbers with SKIP directives my $skipped = $parser->skipped; # the number of tests with SKIP directives This method lets you know which (or how many) tests had SKIP directives. =cut sub skipped { @{ shift->{skipped} } } =head2 Pragmas =head3 C Get or set a pragma. To get the state of a pragma: if ( $p->pragma('strict') ) { # be strict } To set the state of a pragma: $p->pragma('strict', 1); # enable strict mode =cut sub pragma { my ( $self, $pragma ) = splice @_, 0, 2; return $self->{pragma}->{$pragma} unless @_; if ( my $state = shift ) { $self->{pragma}->{$pragma} = 1; } else { delete $self->{pragma}->{$pragma}; } return; } =head3 C Get a list of all the currently enabled pragmas: my @pragmas_enabled = $p->pragmas; =cut sub pragmas { sort keys %{ shift->{pragma} || {} } } =head2 Summary Results These results are "meta" information about the total results of an individual test program. =head3 C my $plan = $parser->plan; Returns the test plan, if found. =head3 C Deprecated. Use C instead. =cut sub good_plan { warn 'good_plan() is deprecated. Please use "is_good_plan()"'; goto &is_good_plan; } ############################################################################## =head3 C if ( $parser->is_good_plan ) { ... } Returns a boolean value indicating whether or not the number of tests planned matches the number of tests run. B this was formerly C. The latter method is deprecated and will issue a warning. And since we're on that subject ... =head3 C print $parser->tests_planned; Returns the number of tests planned, according to the plan. For example, a plan of '1..17' will mean that 17 tests were planned. =head3 C print $parser->tests_run; Returns the number of tests which actually were run. Hopefully this will match the number of C<< $parser->tests_planned >>. =head3 C Returns a true value (actually the reason for skipping) if all tests were skipped. =head3 C Returns the time when the Parser was created. =head3 C Returns the time when the end of TAP input was seen. =head3 C if ( $parser->has_problems ) { ... } This is a 'catch-all' method which returns true if any tests have currently failed, any TODO tests unexpectedly succeeded, or any parse errors occurred. =cut sub has_problems { my $self = shift; return $self->failed || $self->parse_errors || ( !$self->ignore_exit && ( $self->wait || $self->exit ) ); } =head3 C $parser->version; Once the parser is done, this will return the version number for the parsed TAP. Version numbers were introduced with TAP version 13 so if no version number is found version 12 is assumed. =head3 C $parser->exit; Once the parser is done, this will return the exit status. If the parser ran an executable, it returns the exit status of the executable. =head3 C $parser->wait; 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 merely returns the C status. =head2 C $parser->ignore_exit(1); Tell the parser to ignore the exit status from the test when determining whether the test passed. Normally tests with non-zero exit status are considered to have failed even if all individual tests passed. In cases where it is not possible to control the exit value of the test script use this option to ignore it. =cut sub ignore_exit { shift->pragma( 'ignore_exit', @_ ) } =head3 C my @errors = $parser->parse_errors; # the parser errors my $errors = $parser->parse_errors; # the number of parser_errors Fortunately, all TAP output is perfect. In the event that it is not, this method will return parser errors. Note that a junk line which the parser does not recognize is C an error. This allows this parser to handle future versions of TAP. The following are all TAP errors reported by the parser: =over 4 =item * Misplaced plan The plan (for example, '1..5'), must only come at the beginning or end of the TAP output. =item * No plan Gotta have a plan! =item * More than one plan 1..3 ok 1 - input file opened not ok 2 - first line of the input valid # todo some data ok 3 read the rest of the file 1..3 Right. Very funny. Don't do that. =item * Test numbers out of sequence 1..3 ok 1 - input file opened not ok 2 - first line of the input valid # todo some data ok 2 read the rest of the file That last test line above should have the number '3' instead of '2'. Note that it's perfectly acceptable for some lines to have test numbers and others to not have them. However, when a test number is found, it must be in sequence. The following is also an error: 1..3 ok 1 - input file opened not ok - first line of the input valid # todo some data ok 2 read the rest of the file But this is not: 1..3 ok - input file opened not ok - first line of the input valid # todo some data ok 3 read the rest of the file =back =cut sub parse_errors { @{ shift->{parse_errors} } } sub _add_error { my ( $self, $error ) = @_; push @{ $self->{parse_errors} } => $error; return $self; } sub _make_state_table { my $self = shift; my %states; my %planned_todo = (); # These transitions are defaults for all states my %state_globals = ( comment => {}, bailout => {}, yaml => {}, version => { act => sub { $self->_add_error( 'If TAP version is present it must be the first line of output' ); }, }, unknown => { act => sub { my $unk = shift; if ( $self->pragma('strict') ) { $self->_add_error( 'Unknown TAP token: "' . $unk->raw . '"' ); } }, }, pragma => { act => sub { my ($pragma) = @_; for my $pr ( $pragma->pragmas ) { if ( $pr =~ /^ ([-+])(\w+) $/x ) { $self->pragma( $2, $1 eq '+' ); } } }, }, ); # Provides default elements for transitions my %state_defaults = ( plan => { act => sub { my ($plan) = @_; $self->tests_planned( $plan->tests_planned ); $self->plan( $plan->plan ); if ( $plan->has_skip ) { $self->skip_all( $plan->explanation || '(no reason given)' ); } $planned_todo{$_}++ for @{ $plan->todo_list }; }, }, test => { act => sub { my ($test) = @_; my ( $number, $tests_run ) = ( $test->number, ++$self->{tests_run} ); # Fake TODO state if ( defined $number && delete $planned_todo{$number} ) { $test->set_directive('TODO'); } my $has_todo = $test->has_todo; $self->in_todo($has_todo); if ( defined( my $tests_planned = $self->tests_planned ) ) { if ( $tests_run > $tests_planned ) { $test->is_unplanned(1); } } if ( defined $number ) { if ( $number != $tests_run ) { my $count = $tests_run; $self->_add_error( "Tests out of sequence. Found " . "($number) but expected ($count)" ); } } else { $test->_number( $number = $tests_run ); } push @{ $self->{todo} } => $number if $has_todo; push @{ $self->{todo_passed} } => $number if $test->todo_passed; push @{ $self->{skipped} } => $number if $test->has_skip; push @{ $self->{ $test->is_ok ? 'passed' : 'failed' } } => $number; push @{ $self->{ $test->is_actual_ok ? 'actual_passed' : 'actual_failed' } } => $number; }, }, yaml => { act => sub { }, }, ); # Each state contains a hash the keys of which match a token type. For # each token # type there may be: # act A coderef to run # goto The new state to move to. Stay in this state if # missing # continue Goto the new state and run the new state for the # current token %states = ( INIT => { version => { act => sub { my ($version) = @_; my $ver_num = $version->version; if ( $ver_num <= $DEFAULT_TAP_VERSION ) { my $ver_min = $DEFAULT_TAP_VERSION + 1; $self->_add_error( "Explicit TAP version must be at least " . "$ver_min. Got version $ver_num" ); $ver_num = $DEFAULT_TAP_VERSION; } if ( $ver_num > $MAX_TAP_VERSION ) { $self->_add_error( "TAP specified version $ver_num but " . "we don't know about versions later " . "than $MAX_TAP_VERSION" ); $ver_num = $MAX_TAP_VERSION; } $self->version($ver_num); $self->_grammar->set_version($ver_num); }, goto => 'PLAN' }, plan => { goto => 'PLANNED' }, test => { goto => 'UNPLANNED' }, }, PLAN => { plan => { goto => 'PLANNED' }, test => { goto => 'UNPLANNED' }, }, PLANNED => { test => { goto => 'PLANNED_AFTER_TEST' }, plan => { act => sub { my ($version) = @_; $self->_add_error( 'More than one plan found in TAP output'); }, }, }, PLANNED_AFTER_TEST => { test => { goto => 'PLANNED_AFTER_TEST' }, plan => { act => sub { }, continue => 'PLANNED' }, yaml => { goto => 'PLANNED' }, }, GOT_PLAN => { test => { act => sub { my ($plan) = @_; my $line = $self->plan; $self->_add_error( "Plan ($line) must be at the beginning " . "or end of the TAP output" ); $self->is_good_plan(0); }, continue => 'PLANNED' }, plan => { continue => 'PLANNED' }, }, UNPLANNED => { test => { goto => 'UNPLANNED_AFTER_TEST' }, plan => { goto => 'GOT_PLAN' }, }, UNPLANNED_AFTER_TEST => { test => { act => sub { }, continue => 'UNPLANNED' }, plan => { act => sub { }, continue => 'UNPLANNED' }, yaml => { goto => 'UNPLANNED' }, }, ); # Apply globals and defaults to state table for my $name ( keys %states ) { # Merge with globals my $st = { %state_globals, %{ $states{$name} } }; # Add defaults for my $next ( sort keys %{$st} ) { if ( my $default = $state_defaults{$next} ) { for my $def ( sort keys %{$default} ) { $st->{$next}->{$def} ||= $default->{$def}; } } } # Stuff back in table $states{$name} = $st; } return \%states; } =head3 C Get an a list of file handles which can be passed to C