From: Steve Peters Date: Fri, 29 Feb 2008 04:10:17 +0000 (+0000) Subject: Upgrade to Test-Harness-3.10 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=2a7f4b9b0713cc512aacba1593d634a47060e42e;p=p5sagit%2Fp5-mst-13.2.git Upgrade to Test-Harness-3.10 p4raw-id: //depot/perl@33393 --- diff --git a/MANIFEST b/MANIFEST index 2813550..55db224 100644 --- a/MANIFEST +++ b/MANIFEST @@ -2616,6 +2616,7 @@ lib/TAP/Parser/Result.pm A parser for Test Anything Protocol lib/TAP/Parser/Result/Bailout.pm A parser for Test Anything Protocol lib/TAP/Parser/Result/Comment.pm A parser for Test Anything Protocol lib/TAP/Parser/Result/Plan.pm A parser for Test Anything Protocol +lib/TAP/Parser/Result/Pragma.pm A parser for Test Anything Protocol lib/TAP/Parser/Result/Test.pm A parser for Test Anything Protocol lib/TAP/Parser/Result/Unknown.pm A parser for Test Anything Protocol lib/TAP/Parser/Result/Version.pm A parser for Test Anything Protocol @@ -3639,6 +3640,7 @@ t/lib/sample-tests/skipall_nomsg Test data for Test::Harness t/lib/sample-tests/skipall_v13 Test data for Test::Harness t/lib/sample-tests/space_after_plan Test data for Test::Harness t/lib/sample-tests/stdout_stderr Test data for Test::Harness +t/lib/sample-tests/strict Test data for Test::Harness t/lib/sample-tests/switches Test data for Test::Harness t/lib/sample-tests/taint Test data for Test::Harness t/lib/sample-tests/taint_warn Test data for Test::Harness diff --git a/lib/App/Prove.pm b/lib/App/Prove.pm index 627ffc3..a4ea539 100644 --- a/lib/App/Prove.pm +++ b/lib/App/Prove.pm @@ -16,11 +16,11 @@ App::Prove - Implements the C command. =head1 VERSION -Version 3.09 +Version 3.10 =cut -$VERSION = '3.09'; +$VERSION = '3.10'; =head1 DESCRIPTION diff --git a/lib/App/Prove/State.pm b/lib/App/Prove/State.pm index c04870a..dbc73f4 100644 --- a/lib/App/Prove/State.pm +++ b/lib/App/Prove/State.pm @@ -20,11 +20,11 @@ App::Prove::State - State storage for the C command. =head1 VERSION -Version 3.09 +Version 3.10 =cut -$VERSION = '3.09'; +$VERSION = '3.10'; =head1 DESCRIPTION diff --git a/lib/TAP/Base.pm b/lib/TAP/Base.pm index a15383a..fc541c3 100644 --- a/lib/TAP/Base.pm +++ b/lib/TAP/Base.pm @@ -9,11 +9,11 @@ TAP::Base - Base class that provides common functionality to L and =head1 VERSION -Version 3.09 +Version 3.10 =cut -$VERSION = '3.09'; +$VERSION = '3.10'; my $GOT_TIME_HIRES; diff --git a/lib/TAP/Formatter/Color.pm b/lib/TAP/Formatter/Color.pm index 3d6d196..a1fbf1c 100644 --- a/lib/TAP/Formatter/Color.pm +++ b/lib/TAP/Formatter/Color.pm @@ -70,11 +70,11 @@ TAP::Formatter::Color - Run Perl test scripts with color =head1 VERSION -Version 3.09 +Version 3.10 =cut -$VERSION = '3.09'; +$VERSION = '3.10'; =head1 DESCRIPTION diff --git a/lib/TAP/Formatter/Console.pm b/lib/TAP/Formatter/Console.pm index 6033fe8..fd54af2 100644 --- a/lib/TAP/Formatter/Console.pm +++ b/lib/TAP/Formatter/Console.pm @@ -52,11 +52,11 @@ TAP::Formatter::Console - Harness output delegate for default console output =head1 VERSION -Version 3.09 +Version 3.10 =cut -$VERSION = '3.09'; +$VERSION = '3.10'; =head1 DESCRIPTION diff --git a/lib/TAP/Formatter/Console/ParallelSession.pm b/lib/TAP/Formatter/Console/ParallelSession.pm index 163f7fc..32a3fb6 100644 --- a/lib/TAP/Formatter/Console/ParallelSession.pm +++ b/lib/TAP/Formatter/Console/ParallelSession.pm @@ -48,11 +48,11 @@ TAP::Formatter::Console::ParallelSession - Harness output delegate for parallel =head1 VERSION -Version 3.09 +Version 3.10 =cut -$VERSION = '3.09'; +$VERSION = '3.10'; =head1 DESCRIPTION diff --git a/lib/TAP/Formatter/Console/Session.pm b/lib/TAP/Formatter/Console/Session.pm index 7e9e4de..6bed3c0 100644 --- a/lib/TAP/Formatter/Console/Session.pm +++ b/lib/TAP/Formatter/Console/Session.pm @@ -36,11 +36,11 @@ TAP::Formatter::Console::Session - Harness output delegate for default console o =head1 VERSION -Version 3.09 +Version 3.10 =cut -$VERSION = '3.09'; +$VERSION = '3.10'; =head1 DESCRIPTION diff --git a/lib/TAP/Harness.pm b/lib/TAP/Harness.pm index fddb9e0..28e6d3a 100644 --- a/lib/TAP/Harness.pm +++ b/lib/TAP/Harness.pm @@ -22,11 +22,11 @@ TAP::Harness - Run test scripts with statistics =head1 VERSION -Version 3.09 +Version 3.10 =cut -$VERSION = '3.09'; +$VERSION = '3.10'; $ENV{HARNESS_ACTIVE} = 1; $ENV{HARNESS_VERSION} = $VERSION; diff --git a/lib/TAP/Parser.pm b/lib/TAP/Parser.pm index 4c8dc3d..2c59741 100644 --- a/lib/TAP/Parser.pm +++ b/lib/TAP/Parser.pm @@ -9,7 +9,8 @@ use TAP::Parser::Result (); use TAP::Parser::Source (); use TAP::Parser::Source::Perl (); use TAP::Parser::Iterator (); -use Carp (); + +use Carp qw( confess ); @ISA = qw(TAP::Base); @@ -19,11 +20,11 @@ TAP::Parser - Parse L output =head1 VERSION -Version 3.09 +Version 3.10 =cut -$VERSION = '3.09'; +$VERSION = '3.10'; my $DEFAULT_TAP_VERSION = 12; my $MAX_TAP_VERSION = 13; @@ -411,6 +412,10 @@ examples of each, are as follows: 1..42 +=item * Pragma + + pragma +strict + =item * Test ok 3 - We should start with some foobar! @@ -521,6 +526,18 @@ If a SKIP directive is included with the plan, this method will return it. 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 ) { ... } @@ -782,6 +799,47 @@ This method lets you know which (or how many) tests had SKIP directives. 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 @@ -965,14 +1023,33 @@ sub _make_state_table { my %state_globals = ( comment => {}, bailout => {}, + yaml => {}, version => { act => sub { - my ($version) = @_; $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 @@ -1039,9 +1116,7 @@ sub _make_state_table { } => $number; }, }, - yaml => { - act => sub { }, - }, + yaml => { act => sub { }, }, ); # Each state contains a hash the keys of which match a token type. For @@ -1125,7 +1200,7 @@ sub _make_state_table { ); # Apply globals and defaults to state table - for my $name ( sort keys %states ) { + for my $name ( keys %states ) { # Merge with globals my $st = { %state_globals, %{ $states{$name} } }; @@ -1167,7 +1242,6 @@ sub _iter { my $next_state = sub { my $token = shift; my $type = $token->type; - my $count = 1; TRANS: { my $state_spec = $state_table->{$state} or die "Illegal state: $state"; @@ -1184,6 +1258,9 @@ sub _iter { $state = $goto; } } + else { + confess("Unhandled token type: $type\n"); + } } return $token; }; diff --git a/lib/TAP/Parser/Aggregator.pm b/lib/TAP/Parser/Aggregator.pm index e47bd00..c3fc726 100644 --- a/lib/TAP/Parser/Aggregator.pm +++ b/lib/TAP/Parser/Aggregator.pm @@ -10,11 +10,11 @@ TAP::Parser::Aggregator - Aggregate TAP::Parser results =head1 VERSION -Version 3.09 +Version 3.10 =cut -$VERSION = '3.09'; +$VERSION = '3.10'; =head1 SYNOPSIS diff --git a/lib/TAP/Parser/Grammar.pm b/lib/TAP/Parser/Grammar.pm index 3af5d74..4478ddc 100644 --- a/lib/TAP/Parser/Grammar.pm +++ b/lib/TAP/Parser/Grammar.pm @@ -12,11 +12,11 @@ TAP::Parser::Grammar - A grammar for the Test Anything Protocol. =head1 VERSION -Version 3.09 +Version 3.10 =cut -$VERSION = '3.09'; +$VERSION = '3.10'; =head1 DESCRIPTION @@ -184,6 +184,15 @@ my %language_for; return $self->_make_yaml_token( $pad, $marker ); }, }, + pragma => { + syntax => + qr/^ pragma \s+ ( [-+] \w+ \s* (?: , \s* [-+] \w+ \s* )* ) $/x, + handler => sub { + my ( $self, $line ) = @_; + my $pragmas = $1; + return $self->_make_pragma_token( $line, $pragmas ); + }, + }, ); %language_for = ( @@ -372,7 +381,7 @@ sub _make_test_token { ok => $ok, test_num => $num, description => _trim($desc), - directive => uc($dir || ""), + directive => uc( defined $dir ? $dir : '' ), explanation => _trim($explanation), raw => $line, type => 'test', @@ -439,6 +448,15 @@ sub _make_yaml_token { }; } +sub _make_pragma_token { + my ( $self, $line, $pragmas ) = @_; + return { + type => 'pragma', + raw => $line, + pragmas => [ split /\s*,\s*/, _trim($pragmas) ], + }; +} + sub _trim { my $data = shift; diff --git a/lib/TAP/Parser/Iterator.pm b/lib/TAP/Parser/Iterator.pm index 6e082e2..d01b843 100644 --- a/lib/TAP/Parser/Iterator.pm +++ b/lib/TAP/Parser/Iterator.pm @@ -13,11 +13,11 @@ TAP::Parser::Iterator - Internal TAP::Parser Iterator =head1 VERSION -Version 3.09 +Version 3.10 =cut -$VERSION = '3.09'; +$VERSION = '3.10'; =head1 SYNOPSIS diff --git a/lib/TAP/Parser/Iterator/Array.pm b/lib/TAP/Parser/Iterator/Array.pm index bf1ae77..e6412c6 100644 --- a/lib/TAP/Parser/Iterator/Array.pm +++ b/lib/TAP/Parser/Iterator/Array.pm @@ -11,11 +11,11 @@ TAP::Parser::Iterator::Array - Internal TAP::Parser Iterator =head1 VERSION -Version 3.09 +Version 3.10 =cut -$VERSION = '3.09'; +$VERSION = '3.10'; =head1 SYNOPSIS diff --git a/lib/TAP/Parser/Iterator/Process.pm b/lib/TAP/Parser/Iterator/Process.pm index 2e7d47c..345e214 100644 --- a/lib/TAP/Parser/Iterator/Process.pm +++ b/lib/TAP/Parser/Iterator/Process.pm @@ -19,11 +19,11 @@ TAP::Parser::Iterator::Process - Internal TAP::Parser Iterator =head1 VERSION -Version 3.09 +Version 3.10 =cut -$VERSION = '3.09'; +$VERSION = '3.10'; =head1 SYNOPSIS diff --git a/lib/TAP/Parser/Iterator/Stream.pm b/lib/TAP/Parser/Iterator/Stream.pm index 4ade218..ab3d602 100644 --- a/lib/TAP/Parser/Iterator/Stream.pm +++ b/lib/TAP/Parser/Iterator/Stream.pm @@ -11,11 +11,11 @@ TAP::Parser::Iterator::Stream - Internal TAP::Parser Iterator =head1 VERSION -Version 3.09 +Version 3.10 =cut -$VERSION = '3.09'; +$VERSION = '3.10'; =head1 SYNOPSIS diff --git a/lib/TAP/Parser/Multiplexer.pm b/lib/TAP/Parser/Multiplexer.pm index aa158b5..b05c0b3 100644 --- a/lib/TAP/Parser/Multiplexer.pm +++ b/lib/TAP/Parser/Multiplexer.pm @@ -14,11 +14,11 @@ TAP::Parser::Multiplexer - Multiplex multiple TAP::Parsers =head1 VERSION -Version 3.09 +Version 3.10 =cut -$VERSION = '3.09'; +$VERSION = '3.10'; =head1 SYNOPSIS diff --git a/lib/TAP/Parser/Result.pm b/lib/TAP/Parser/Result.pm index 569a28b..686e8f1 100644 --- a/lib/TAP/Parser/Result.pm +++ b/lib/TAP/Parser/Result.pm @@ -6,14 +6,30 @@ use vars qw($VERSION); use TAP::Parser::Result::Bailout (); use TAP::Parser::Result::Comment (); use TAP::Parser::Result::Plan (); +use TAP::Parser::Result::Pragma (); use TAP::Parser::Result::Test (); use TAP::Parser::Result::Unknown (); use TAP::Parser::Result::Version (); use TAP::Parser::Result::YAML (); +# note that this is bad. Makes it very difficult to subclass, but then, it +# would be a lot of work to subclass this system. +my %class_for; + BEGIN { + %class_for = ( + plan => 'TAP::Parser::Result::Plan', + pragma => 'TAP::Parser::Result::Pragma', + test => 'TAP::Parser::Result::Test', + comment => 'TAP::Parser::Result::Comment', + bailout => 'TAP::Parser::Result::Bailout', + version => 'TAP::Parser::Result::Version', + unknown => 'TAP::Parser::Result::Unknown', + yaml => 'TAP::Parser::Result::YAML', + ); + no strict 'refs'; - foreach my $token (qw( plan comment test bailout version unknown yaml )) { + for my $token ( keys %class_for ) { my $method = "is_$token"; *$method = sub { return $token eq shift->type }; } @@ -27,11 +43,11 @@ TAP::Parser::Result - TAP::Parser output =head1 VERSION -Version 3.09 +Version 3.10 =cut -$VERSION = '3.09'; +$VERSION = '3.10'; =head2 DESCRIPTION @@ -41,18 +57,6 @@ only and should not be relied upon. =cut -# note that this is bad. Makes it very difficult to subclass, but then, it -# would be a lot of work to subclass this system. -my %class_for = ( - plan => 'TAP::Parser::Result::Plan', - test => 'TAP::Parser::Result::Test', - comment => 'TAP::Parser::Result::Comment', - bailout => 'TAP::Parser::Result::Bailout', - version => 'TAP::Parser::Result::Version', - unknown => 'TAP::Parser::Result::Unknown', - yaml => 'TAP::Parser::Result::YAML', -); - ############################################################################## =head2 METHODS @@ -89,11 +93,17 @@ Indicates whether or not this is the test plan line. 1..3 +=item * C + +Indicates whether or not this is a pragma line. + + pragma +strict + =item * C Indicates whether or not this is a test line. - is $foo, $bar, $description; + ok 1 Is OK! =item * C diff --git a/lib/TAP/Parser/Result/Bailout.pm b/lib/TAP/Parser/Result/Bailout.pm index 1263611..28bc073 100644 --- a/lib/TAP/Parser/Result/Bailout.pm +++ b/lib/TAP/Parser/Result/Bailout.pm @@ -12,11 +12,11 @@ TAP::Parser::Result::Bailout - Bailout result token. =head1 VERSION -Version 3.09 +Version 3.10 =cut -$VERSION = '3.09'; +$VERSION = '3.10'; =head1 DESCRIPTION diff --git a/lib/TAP/Parser/Result/Comment.pm b/lib/TAP/Parser/Result/Comment.pm index 21fcd74..0f1f5f7 100644 --- a/lib/TAP/Parser/Result/Comment.pm +++ b/lib/TAP/Parser/Result/Comment.pm @@ -12,11 +12,11 @@ TAP::Parser::Result::Comment - Comment result token. =head1 VERSION -Version 3.09 +Version 3.10 =cut -$VERSION = '3.09'; +$VERSION = '3.10'; =head1 DESCRIPTION diff --git a/lib/TAP/Parser/Result/Plan.pm b/lib/TAP/Parser/Result/Plan.pm index e700033..9f636fd 100644 --- a/lib/TAP/Parser/Result/Plan.pm +++ b/lib/TAP/Parser/Result/Plan.pm @@ -12,11 +12,11 @@ TAP::Parser::Result::Plan - Plan result token. =head1 VERSION -Version 3.09 +Version 3.10 =cut -$VERSION = '3.09'; +$VERSION = '3.10'; =head1 DESCRIPTION diff --git a/lib/TAP/Parser/Result/Pragma.pm b/lib/TAP/Parser/Result/Pragma.pm new file mode 100644 index 0000000..9f8bcad --- /dev/null +++ b/lib/TAP/Parser/Result/Pragma.pm @@ -0,0 +1,63 @@ +package TAP::Parser::Result::Pragma; + +use strict; + +use vars qw($VERSION @ISA); +use TAP::Parser::Result; +@ISA = 'TAP::Parser::Result'; + +=head1 NAME + +TAP::Parser::Result::Pragma - TAP pragma token. + +=head1 VERSION + +Version 3.10 + +=cut + +$VERSION = '3.10'; + +=head1 DESCRIPTION + +This is a subclass of L. A token of this class will be +returned if a pragma is encountered. + + TAP version 13 + pragma +strict, -foo + +Pragmas are only supported from TAP version 13 onwards. + +=head1 OVERRIDDEN METHODS + +Mainly listed here to shut up the pitiful screams of the pod coverage tests. +They keep me awake at night. + +=over 4 + +=item * C + +=item * C + +=back + +=cut + +############################################################################## + +=head2 Instance Methods + +=head3 C + +if ( $result->is_pragma ) { + @pragmas = $result->pragmas; +} + +=cut + +sub pragmas { + my @pragmas = @{ shift->{pragmas} }; + return wantarray ? @pragmas : \@pragmas; +} + +1; diff --git a/lib/TAP/Parser/Result/Test.pm b/lib/TAP/Parser/Result/Test.pm index 0212447..784e6a1 100644 --- a/lib/TAP/Parser/Result/Test.pm +++ b/lib/TAP/Parser/Result/Test.pm @@ -14,11 +14,11 @@ TAP::Parser::Result::Test - Test result token. =head1 VERSION -Version 3.09 +Version 3.10 =cut -$VERSION = '3.09'; +$VERSION = '3.10'; =head1 DESCRIPTION diff --git a/lib/TAP/Parser/Result/Unknown.pm b/lib/TAP/Parser/Result/Unknown.pm index 5663558..a6b7313 100644 --- a/lib/TAP/Parser/Result/Unknown.pm +++ b/lib/TAP/Parser/Result/Unknown.pm @@ -14,11 +14,11 @@ TAP::Parser::Result::Unknown - Unknown result token. =head1 VERSION -Version 3.09 +Version 3.10 =cut -$VERSION = '3.09'; +$VERSION = '3.10'; =head1 DESCRIPTION diff --git a/lib/TAP/Parser/Result/Version.pm b/lib/TAP/Parser/Result/Version.pm index 1162d53..9d9718a 100644 --- a/lib/TAP/Parser/Result/Version.pm +++ b/lib/TAP/Parser/Result/Version.pm @@ -8,26 +8,26 @@ use TAP::Parser::Result; =head1 NAME -TAP::Parser::Result::Version - TAP version result token. +TAP::Parser::Result::Version - TAP syntax version token. =head1 VERSION -Version 3.09 +Version 3.10 =cut -$VERSION = '3.09'; +$VERSION = '3.10'; =head1 DESCRIPTION This is a subclass of L. A token of this class will be returned if a version line is encountered. - TAP version 4 + TAP version 13 ok 1 not ok 2 -The first version of TAP to include an explicit version number is 4. +The first version of TAP to include an explicit version number is 13. =head1 OVERRIDDEN METHODS diff --git a/lib/TAP/Parser/Result/YAML.pm b/lib/TAP/Parser/Result/YAML.pm index 2670d6e..74b3a47 100644 --- a/lib/TAP/Parser/Result/YAML.pm +++ b/lib/TAP/Parser/Result/YAML.pm @@ -12,11 +12,11 @@ TAP::Parser::Result::YAML - YAML result token. =head1 VERSION -Version 3.09 +Version 3.10 =cut -$VERSION = '3.09'; +$VERSION = '3.10'; =head1 DESCRIPTION diff --git a/lib/TAP/Parser/Source.pm b/lib/TAP/Parser/Source.pm index 386cd9f..a78a583 100644 --- a/lib/TAP/Parser/Source.pm +++ b/lib/TAP/Parser/Source.pm @@ -14,11 +14,11 @@ TAP::Parser::Source - Stream output from some source =head1 VERSION -Version 3.09 +Version 3.10 =cut -$VERSION = '3.09'; +$VERSION = '3.10'; =head1 DESCRIPTION diff --git a/lib/TAP/Parser/Source/Perl.pm b/lib/TAP/Parser/Source/Perl.pm index 02db5bc..7e5036d 100644 --- a/lib/TAP/Parser/Source/Perl.pm +++ b/lib/TAP/Parser/Source/Perl.pm @@ -16,11 +16,11 @@ TAP::Parser::Source::Perl - Stream Perl output =head1 VERSION -Version 3.09 +Version 3.10 =cut -$VERSION = '3.09'; +$VERSION = '3.10'; =head1 DESCRIPTION diff --git a/lib/TAP/Parser/Utils.pm b/lib/TAP/Parser/Utils.pm index dbdc5a3..c716e01 100644 --- a/lib/TAP/Parser/Utils.pm +++ b/lib/TAP/Parser/Utils.pm @@ -13,11 +13,11 @@ TAP::Parser::Utils - Internal TAP::Parser utilities =head1 VERSION -Version 3.09 +Version 3.10 =cut -$VERSION = '3.09'; +$VERSION = '3.10'; =head1 SYNOPSIS diff --git a/lib/TAP/Parser/YAMLish/Reader.pm b/lib/TAP/Parser/YAMLish/Reader.pm index 2fa032e..126f7b5 100644 --- a/lib/TAP/Parser/YAMLish/Reader.pm +++ b/lib/TAP/Parser/YAMLish/Reader.pm @@ -4,7 +4,7 @@ use strict; use vars qw{$VERSION}; -$VERSION = '3.09'; +$VERSION = '3.10'; # TODO: # Handle blessed object syntax @@ -277,7 +277,7 @@ TAP::Parser::YAMLish::Reader - Read YAMLish data from iterator =head1 VERSION -Version 3.09 +Version 3.10 =head1 SYNOPSIS diff --git a/lib/TAP/Parser/YAMLish/Writer.pm b/lib/TAP/Parser/YAMLish/Writer.pm index 8875ca4..214be52 100644 --- a/lib/TAP/Parser/YAMLish/Writer.pm +++ b/lib/TAP/Parser/YAMLish/Writer.pm @@ -4,7 +4,7 @@ use strict; use vars qw{$VERSION}; -$VERSION = '3.09'; +$VERSION = '3.10'; my $ESCAPE_CHAR = qr{ [ \x00-\x1f \" ] }x; my $ESCAPE_KEY = qr{ (?: ^\W ) | $ESCAPE_CHAR }x; @@ -149,7 +149,7 @@ TAP::Parser::YAMLish::Writer - Write YAMLish data =head1 VERSION -Version 3.09 +Version 3.10 =head1 SYNOPSIS diff --git a/lib/Test/Harness.pm b/lib/Test/Harness.pm index 14af275..17e8916 100644 --- a/lib/Test/Harness.pm +++ b/lib/Test/Harness.pm @@ -43,11 +43,11 @@ Test::Harness - Run Perl standard test scripts with statistics =head1 VERSION -Version 3.09 +Version 3.10 =cut -$VERSION = '3.09'; +$VERSION = '3.10'; # Backwards compatibility for exportable variable names. *verbose = *Verbose; diff --git a/lib/Test/Harness/t/000-load.t b/lib/Test/Harness/t/000-load.t index 5e4554a..5c952a7 100644 --- a/lib/Test/Harness/t/000-load.t +++ b/lib/Test/Harness/t/000-load.t @@ -3,7 +3,7 @@ use strict; use lib 't/lib'; -use Test::More tests => 60; +use Test::More tests => 62; BEGIN { @@ -28,6 +28,7 @@ BEGIN { TAP::Parser::Result::Bailout TAP::Parser::Result::Comment TAP::Parser::Result::Plan + TAP::Parser::Result::Pragma TAP::Parser::Result::Test TAP::Parser::Result::Unknown TAP::Parser::Result::Version diff --git a/lib/Test/Harness/t/grammar.t b/lib/Test/Harness/t/grammar.t index 107cd77..6d572f9 100644 --- a/lib/Test/Harness/t/grammar.t +++ b/lib/Test/Harness/t/grammar.t @@ -3,7 +3,7 @@ use strict; use lib 't/lib'; -use Test::More tests => 81; +use Test::More tests => 94; use TAP::Parser::Grammar; use TAP::Parser::Iterator::Array; @@ -41,8 +41,8 @@ isa_ok $grammar, $GRAMMAR, '... and the object it returns'; # why. We'll still use the instance because that should be forward # compatible. -my @V12 = qw(bailout comment plan simple_test test version); -my @V13 = ( @V12, 'yaml' ); +my @V12 = sort qw(bailout comment plan simple_test test version); +my @V13 = sort ( @V12, 'pragma', 'yaml' ); can_ok $grammar, 'token_types'; ok my @types = sort( $grammar->token_types ), @@ -268,6 +268,56 @@ $expected = { is_deeply $token, $expected, '... and the token should contain the correct data'; +# pragmas + +my $pragma = 'pragma +strict'; +like $pragma, $syntax_for{'pragma'}, 'Pragmas should match the pragma syntax'; + +$stream->put($pragma); +ok $token = $grammar->tokenize, + '... and calling it with data should return a token'; + +$expected = { + 'type' => 'pragma', + 'raw' => $pragma, + 'pragmas' => ['+strict'], +}; + +is_deeply $token, $expected, + '... and the token should contain the correct data'; + +$pragma = 'pragma +strict,-foo'; +like $pragma, $syntax_for{'pragma'}, 'Pragmas should match the pragma syntax'; + +$stream->put($pragma); +ok $token = $grammar->tokenize, + '... and calling it with data should return a token'; + +$expected = { + 'type' => 'pragma', + 'raw' => $pragma, + 'pragmas' => [ '+strict', '-foo' ], +}; + +is_deeply $token, $expected, + '... and the token should contain the correct data'; + +$pragma = 'pragma +strict , -foo '; +like $pragma, $syntax_for{'pragma'}, 'Pragmas should match the pragma syntax'; + +$stream->put($pragma); +ok $token = $grammar->tokenize, + '... and calling it with data should return a token'; + +$expected = { + 'type' => 'pragma', + 'raw' => $pragma, + 'pragmas' => [ '+strict', '-foo' ], +}; + +is_deeply $token, $expected, + '... and the token should contain the correct data'; + # coverage tests # set_version @@ -281,7 +331,7 @@ is_deeply $token, $expected, $grammar->set_version('no_such_version'); }; - unless (is @die, 1, 'set_version with bad version') { + unless ( is @die, 1, 'set_version with bad version' ) { diag " >>> $_ <<<\n" for @die; } diff --git a/lib/Test/Harness/t/parse.t b/lib/Test/Harness/t/parse.t index 6e5c585..a53ad3a 100755 --- a/lib/Test/Harness/t/parse.t +++ b/lib/Test/Harness/t/parse.t @@ -3,16 +3,16 @@ use strict; BEGIN { - if( $ENV{PERL_CORE} ) { + if ( $ENV{PERL_CORE} ) { chdir 't'; - @INC = ('../lib', 'lib'); + @INC = ( '../lib', 'lib' ); } else { - use lib 't/lib'; + use lib 't/lib'; } } -use Test::More tests => 260; +use Test::More tests => 268; use IO::c55Capture; use File::Spec; @@ -29,9 +29,10 @@ sub _get_results { return @results; } -my ( $PARSER, $PLAN, $TEST, $COMMENT, $BAILOUT, $UNKNOWN, $YAML, $VERSION ) = qw( +my ( $PARSER, $PLAN, $PRAGMA, $TEST, $COMMENT, $BAILOUT, $UNKNOWN, $YAML, $VERSION ) = qw( TAP::Parser TAP::Parser::Result::Plan + TAP::Parser::Result::Pragma TAP::Parser::Result::Test TAP::Parser::Result::Comment TAP::Parser::Result::Bailout @@ -624,8 +625,10 @@ END_TAP # coverage test of perl source with switches my $parser = TAP::Parser->new( - { source => File::Spec->catfile( ($ENV{PERL_CORE} ? 'lib' : 't'), - 'sample-tests', 'simple' ), + { source => File::Spec->catfile( + ( $ENV{PERL_CORE} ? 'lib' : 't' ), + 'sample-tests', 'simple' + ), } ); @@ -988,3 +991,30 @@ END_TAP qr/Panic: planned test count [(]1001[)] did not equal sum of passed [(]0[)] and failed [(]2[)] tests!/, '...and the message is as we expect'; } + +{ + + # Sanity check on state table + + my $parser = TAP::Parser->new( { tap => "1..1\nok 1\n" } ); + my $state_table = $parser->_make_state_table; + my @states = sort keys %$state_table; + my @expect = sort qw( + bailout comment plan pragma test unknown version yaml + ); + + my %reachable = ( INIT => 1 ); + + for my $name (@states) { + my $state = $state_table->{$name}; + my @can_handle = sort keys %$state; + is_deeply \@can_handle, \@expect, "token types handled in $name"; + for my $type (@can_handle) { + $reachable{$_}++ + for grep {defined} + map { $state->{$type}->{$_} } qw(goto continue); + } + } + + is_deeply [ sort keys %reachable ], [@states], "all states reachable"; +} diff --git a/lib/Test/Harness/t/regression.t b/lib/Test/Harness/t/regression.t index 80902df..5398580 100644 --- a/lib/Test/Harness/t/regression.t +++ b/lib/Test/Harness/t/regression.t @@ -2245,6 +2245,48 @@ my %samples = ( wait => 0, version => 13, }, + strict => { + results => [ + { is_version => TRUE, + raw => 'TAP version 13', + }, + { is_plan => TRUE, + raw => '1..1', + }, + { is_pragma => TRUE, + raw => 'pragma +strict', + pragmas => ['+strict'], + }, + { is_unknown => TRUE, raw => 'Nonsense!', + }, + { is_pragma => TRUE, + raw => 'pragma -strict', + pragmas => ['-strict'], + }, + { is_unknown => TRUE, + raw => "Doesn't matter.", + }, + { is_test => TRUE, + raw => 'ok 1 All OK', + } + ], + plan => '1..1', + passed => [1], + actual_passed => [1], + failed => [], + actual_failed => [], + todo => [], + todo_passed => [], + skipped => [], + good_plan => TRUE, + is_good_plan => TRUE, + tests_planned => 1, + tests_run => 1, + parse_errors => ['Unknown TAP token: "Nonsense!"'], + 'exit' => 0, # TODO: Is this right??? + wait => 0, + version => 13, + }, skipall_nomsg => { results => [ { is_plan => TRUE, @@ -2803,7 +2845,7 @@ my %samples = ( tests_planned => 5, tests_run => 5, parse_errors => - [ 'Explicit TAP version must be at least 13. Got version 12' ], + ['Explicit TAP version must be at least 13. Got version 12'], 'exit' => 0, wait => 0, version => 12, @@ -2883,7 +2925,7 @@ my %samples = ( tests_planned => 5, tests_run => 5, parse_errors => - [ 'If TAP version is present it must be the first line of output' ], + ['If TAP version is present it must be the first line of output'], 'exit' => 0, wait => 0, version => 12, @@ -3121,7 +3163,7 @@ sub analyze_test { "... and $method should return a reasonable value ($test/$count)"; } elsif ( ref $answer ) { - is_deeply $result->$method(), $answer, + is_deeply scalar( $result->$method() ), $answer, "... and $method should return the correct structure ($test/$count)"; } else { diff --git a/t/lib/sample-tests/strict b/t/lib/sample-tests/strict new file mode 100644 index 0000000..b89138d --- /dev/null +++ b/t/lib/sample-tests/strict @@ -0,0 +1,9 @@ +print <