Change 33967 by [EMAIL PROTECTED] on 2008/05/31 14:49:10 Integrate: [ 33393] Upgrade to Test-Harness-3.10
Affected files ... ... //depot/maint-5.10/perl/MANIFEST#35 integrate ... //depot/maint-5.10/perl/lib/App/Prove.pm#6 integrate ... //depot/maint-5.10/perl/lib/App/Prove/State.pm#6 integrate ... //depot/maint-5.10/perl/lib/TAP/Base.pm#6 integrate ... //depot/maint-5.10/perl/lib/TAP/Formatter/Color.pm#6 integrate ... //depot/maint-5.10/perl/lib/TAP/Formatter/Console.pm#6 integrate ... //depot/maint-5.10/perl/lib/TAP/Formatter/Console/ParallelSession.pm#6 integrate ... //depot/maint-5.10/perl/lib/TAP/Formatter/Console/Session.pm#6 integrate ... //depot/maint-5.10/perl/lib/TAP/Harness.pm#6 integrate ... //depot/maint-5.10/perl/lib/TAP/Parser.pm#6 integrate ... //depot/maint-5.10/perl/lib/TAP/Parser/Aggregator.pm#6 integrate ... //depot/maint-5.10/perl/lib/TAP/Parser/Grammar.pm#6 integrate ... //depot/maint-5.10/perl/lib/TAP/Parser/Iterator.pm#6 integrate ... //depot/maint-5.10/perl/lib/TAP/Parser/Iterator/Array.pm#6 integrate ... //depot/maint-5.10/perl/lib/TAP/Parser/Iterator/Process.pm#6 integrate ... //depot/maint-5.10/perl/lib/TAP/Parser/Iterator/Stream.pm#6 integrate ... //depot/maint-5.10/perl/lib/TAP/Parser/Multiplexer.pm#6 integrate ... //depot/maint-5.10/perl/lib/TAP/Parser/Result.pm#6 integrate ... //depot/maint-5.10/perl/lib/TAP/Parser/Result/Bailout.pm#6 integrate ... //depot/maint-5.10/perl/lib/TAP/Parser/Result/Comment.pm#6 integrate ... //depot/maint-5.10/perl/lib/TAP/Parser/Result/Plan.pm#6 integrate ... //depot/maint-5.10/perl/lib/TAP/Parser/Result/Pragma.pm#1 branch ... //depot/maint-5.10/perl/lib/TAP/Parser/Result/Test.pm#6 integrate ... //depot/maint-5.10/perl/lib/TAP/Parser/Result/Unknown.pm#6 integrate ... //depot/maint-5.10/perl/lib/TAP/Parser/Result/Version.pm#6 integrate ... //depot/maint-5.10/perl/lib/TAP/Parser/Result/YAML.pm#6 integrate ... //depot/maint-5.10/perl/lib/TAP/Parser/Source.pm#6 integrate ... //depot/maint-5.10/perl/lib/TAP/Parser/Source/Perl.pm#6 integrate ... //depot/maint-5.10/perl/lib/TAP/Parser/Utils.pm#2 integrate ... //depot/maint-5.10/perl/lib/TAP/Parser/YAMLish/Reader.pm#6 integrate ... //depot/maint-5.10/perl/lib/TAP/Parser/YAMLish/Writer.pm#6 integrate ... //depot/maint-5.10/perl/lib/Test/Harness.pm#7 integrate ... //depot/maint-5.10/perl/lib/Test/Harness/t/000-load.t#4 integrate ... //depot/maint-5.10/perl/lib/Test/Harness/t/grammar.t#2 integrate ... //depot/maint-5.10/perl/lib/Test/Harness/t/parse.t#2 integrate ... //depot/maint-5.10/perl/lib/Test/Harness/t/regression.t#4 integrate ... //depot/maint-5.10/perl/t/lib/sample-tests/strict#1 branch Differences ... ==== //depot/maint-5.10/perl/MANIFEST#35 (text) ==== Index: perl/MANIFEST --- perl/MANIFEST#34~33966~ 2008-05-31 07:44:46.000000000 -0700 +++ perl/MANIFEST 2008-05-31 07:49:10.000000000 -0700 @@ -2642,6 +2642,7 @@ 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 @@ -3663,6 +3664,7 @@ 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 ==== //depot/maint-5.10/perl/lib/App/Prove.pm#6 (text) ==== Index: perl/lib/App/Prove.pm --- perl/lib/App/Prove.pm#5~33966~ 2008-05-31 07:44:46.000000000 -0700 +++ perl/lib/App/Prove.pm 2008-05-31 07:49:10.000000000 -0700 @@ -16,11 +16,11 @@ =head1 VERSION -Version 3.09 +Version 3.10 =cut -$VERSION = '3.09'; +$VERSION = '3.10'; =head1 DESCRIPTION ==== //depot/maint-5.10/perl/lib/App/Prove/State.pm#6 (text) ==== Index: perl/lib/App/Prove/State.pm --- perl/lib/App/Prove/State.pm#5~33966~ 2008-05-31 07:44:46.000000000 -0700 +++ perl/lib/App/Prove/State.pm 2008-05-31 07:49:10.000000000 -0700 @@ -20,11 +20,11 @@ =head1 VERSION -Version 3.09 +Version 3.10 =cut -$VERSION = '3.09'; +$VERSION = '3.10'; =head1 DESCRIPTION ==== //depot/maint-5.10/perl/lib/TAP/Base.pm#6 (text) ==== Index: perl/lib/TAP/Base.pm --- perl/lib/TAP/Base.pm#5~33966~ 2008-05-31 07:44:46.000000000 -0700 +++ perl/lib/TAP/Base.pm 2008-05-31 07:49:10.000000000 -0700 @@ -9,11 +9,11 @@ =head1 VERSION -Version 3.09 +Version 3.10 =cut -$VERSION = '3.09'; +$VERSION = '3.10'; my $GOT_TIME_HIRES; ==== //depot/maint-5.10/perl/lib/TAP/Formatter/Color.pm#6 (text) ==== Index: perl/lib/TAP/Formatter/Color.pm --- perl/lib/TAP/Formatter/Color.pm#5~33966~ 2008-05-31 07:44:46.000000000 -0700 +++ perl/lib/TAP/Formatter/Color.pm 2008-05-31 07:49:10.000000000 -0700 @@ -70,11 +70,11 @@ =head1 VERSION -Version 3.09 +Version 3.10 =cut -$VERSION = '3.09'; +$VERSION = '3.10'; =head1 DESCRIPTION ==== //depot/maint-5.10/perl/lib/TAP/Formatter/Console.pm#6 (text) ==== Index: perl/lib/TAP/Formatter/Console.pm --- perl/lib/TAP/Formatter/Console.pm#5~33966~ 2008-05-31 07:44:46.000000000 -0700 +++ perl/lib/TAP/Formatter/Console.pm 2008-05-31 07:49:10.000000000 -0700 @@ -52,11 +52,11 @@ =head1 VERSION -Version 3.09 +Version 3.10 =cut -$VERSION = '3.09'; +$VERSION = '3.10'; =head1 DESCRIPTION ==== //depot/maint-5.10/perl/lib/TAP/Formatter/Console/ParallelSession.pm#6 (text) ==== Index: perl/lib/TAP/Formatter/Console/ParallelSession.pm --- perl/lib/TAP/Formatter/Console/ParallelSession.pm#5~33966~ 2008-05-31 07:44:46.000000000 -0700 +++ perl/lib/TAP/Formatter/Console/ParallelSession.pm 2008-05-31 07:49:10.000000000 -0700 @@ -48,11 +48,11 @@ =head1 VERSION -Version 3.09 +Version 3.10 =cut -$VERSION = '3.09'; +$VERSION = '3.10'; =head1 DESCRIPTION ==== //depot/maint-5.10/perl/lib/TAP/Formatter/Console/Session.pm#6 (text) ==== Index: perl/lib/TAP/Formatter/Console/Session.pm --- perl/lib/TAP/Formatter/Console/Session.pm#5~33966~ 2008-05-31 07:44:46.000000000 -0700 +++ perl/lib/TAP/Formatter/Console/Session.pm 2008-05-31 07:49:10.000000000 -0700 @@ -36,11 +36,11 @@ =head1 VERSION -Version 3.09 +Version 3.10 =cut -$VERSION = '3.09'; +$VERSION = '3.10'; =head1 DESCRIPTION ==== //depot/maint-5.10/perl/lib/TAP/Harness.pm#6 (text) ==== Index: perl/lib/TAP/Harness.pm --- perl/lib/TAP/Harness.pm#5~33966~ 2008-05-31 07:44:46.000000000 -0700 +++ perl/lib/TAP/Harness.pm 2008-05-31 07:49:10.000000000 -0700 @@ -22,11 +22,11 @@ =head1 VERSION -Version 3.09 +Version 3.10 =cut -$VERSION = '3.09'; +$VERSION = '3.10'; $ENV{HARNESS_ACTIVE} = 1; $ENV{HARNESS_VERSION} = $VERSION; ==== //depot/maint-5.10/perl/lib/TAP/Parser.pm#6 (text) ==== Index: perl/lib/TAP/Parser.pm --- perl/lib/TAP/Parser.pm#5~33966~ 2008-05-31 07:44:46.000000000 -0700 +++ perl/lib/TAP/Parser.pm 2008-05-31 07:49:10.000000000 -0700 @@ -9,7 +9,8 @@ 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 @@ =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 @@ 1..42 +=item * Pragma + + pragma +strict + =item * Test ok 3 - We should start with some foobar! @@ -521,6 +526,18 @@ If a SKIP directive was included with the plan, this method will return the explanation, if any. +=head2 C<pragma> methods + + if ( $result->is_pragma ) { ... } + +If the above evaluates as true, the following methods will be available on the +C<$result> object. + +=head3 C<pragmas> + +Returns a list of pragmas each of which is a + or - followed by the +pragma name. + =head2 C<commment> methods if ( $result->is_comment ) { ... } @@ -782,6 +799,47 @@ sub skipped { @{ shift->{skipped} } } +=head2 Pragmas + +=head3 C<pragma> + +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<pragmas> + +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 @@ 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 @@ } => $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 @@ ); # 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 @@ 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 @@ $state = $goto; } } + else { + confess("Unhandled token type: $type\n"); + } } return $token; }; ==== //depot/maint-5.10/perl/lib/TAP/Parser/Aggregator.pm#6 (text) ==== Index: perl/lib/TAP/Parser/Aggregator.pm --- perl/lib/TAP/Parser/Aggregator.pm#5~33966~ 2008-05-31 07:44:46.000000000 -0700 +++ perl/lib/TAP/Parser/Aggregator.pm 2008-05-31 07:49:10.000000000 -0700 @@ -10,11 +10,11 @@ =head1 VERSION -Version 3.09 +Version 3.10 =cut -$VERSION = '3.09'; +$VERSION = '3.10'; =head1 SYNOPSIS ==== //depot/maint-5.10/perl/lib/TAP/Parser/Grammar.pm#6 (text) ==== Index: perl/lib/TAP/Parser/Grammar.pm --- perl/lib/TAP/Parser/Grammar.pm#5~33966~ 2008-05-31 07:44:46.000000000 -0700 +++ perl/lib/TAP/Parser/Grammar.pm 2008-05-31 07:49:10.000000000 -0700 @@ -12,11 +12,11 @@ =head1 VERSION -Version 3.09 +Version 3.10 =cut -$VERSION = '3.09'; +$VERSION = '3.10'; =head1 DESCRIPTION @@ -184,6 +184,15 @@ 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 @@ 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_pragma_token { + my ( $self, $line, $pragmas ) = @_; + return { + type => 'pragma', + raw => $line, + pragmas => [ split /\s*,\s*/, _trim($pragmas) ], + }; +} + sub _trim { my $data = shift; ==== //depot/maint-5.10/perl/lib/TAP/Parser/Iterator.pm#6 (text) ==== Index: perl/lib/TAP/Parser/Iterator.pm --- perl/lib/TAP/Parser/Iterator.pm#5~33966~ 2008-05-31 07:44:46.000000000 -0700 +++ perl/lib/TAP/Parser/Iterator.pm 2008-05-31 07:49:10.000000000 -0700 @@ -13,11 +13,11 @@ =head1 VERSION -Version 3.09 +Version 3.10 =cut -$VERSION = '3.09'; +$VERSION = '3.10'; =head1 SYNOPSIS ==== //depot/maint-5.10/perl/lib/TAP/Parser/Iterator/Array.pm#6 (text) ==== Index: perl/lib/TAP/Parser/Iterator/Array.pm --- perl/lib/TAP/Parser/Iterator/Array.pm#5~33966~ 2008-05-31 07:44:46.000000000 -0700 +++ perl/lib/TAP/Parser/Iterator/Array.pm 2008-05-31 07:49:10.000000000 -0700 @@ -11,11 +11,11 @@ =head1 VERSION -Version 3.09 +Version 3.10 =cut -$VERSION = '3.09'; +$VERSION = '3.10'; =head1 SYNOPSIS ==== //depot/maint-5.10/perl/lib/TAP/Parser/Iterator/Process.pm#6 (text) ==== Index: perl/lib/TAP/Parser/Iterator/Process.pm --- perl/lib/TAP/Parser/Iterator/Process.pm#5~33966~ 2008-05-31 07:44:46.000000000 -0700 +++ perl/lib/TAP/Parser/Iterator/Process.pm 2008-05-31 07:49:10.000000000 -0700 @@ -19,11 +19,11 @@ =head1 VERSION -Version 3.09 +Version 3.10 =cut -$VERSION = '3.09'; +$VERSION = '3.10'; =head1 SYNOPSIS ==== //depot/maint-5.10/perl/lib/TAP/Parser/Iterator/Stream.pm#6 (text) ==== Index: perl/lib/TAP/Parser/Iterator/Stream.pm --- perl/lib/TAP/Parser/Iterator/Stream.pm#5~33966~ 2008-05-31 07:44:46.000000000 -0700 +++ perl/lib/TAP/Parser/Iterator/Stream.pm 2008-05-31 07:49:10.000000000 -0700 @@ -11,11 +11,11 @@ =head1 VERSION -Version 3.09 +Version 3.10 =cut -$VERSION = '3.09'; +$VERSION = '3.10'; =head1 SYNOPSIS ==== //depot/maint-5.10/perl/lib/TAP/Parser/Multiplexer.pm#6 (text) ==== Index: perl/lib/TAP/Parser/Multiplexer.pm --- perl/lib/TAP/Parser/Multiplexer.pm#5~33966~ 2008-05-31 07:44:46.000000000 -0700 +++ perl/lib/TAP/Parser/Multiplexer.pm 2008-05-31 07:49:10.000000000 -0700 @@ -14,11 +14,11 @@ =head1 VERSION -Version 3.09 +Version 3.10 =cut -$VERSION = '3.09'; +$VERSION = '3.10'; =head1 SYNOPSIS ==== //depot/maint-5.10/perl/lib/TAP/Parser/Result.pm#6 (text) ==== Index: perl/lib/TAP/Parser/Result.pm --- perl/lib/TAP/Parser/Result.pm#5~33966~ 2008-05-31 07:44:46.000000000 -0700 +++ perl/lib/TAP/Parser/Result.pm 2008-05-31 07:49:10.000000000 -0700 @@ -6,14 +6,30 @@ 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 @@ =head1 VERSION -Version 3.09 +Version 3.10 =cut -$VERSION = '3.09'; +$VERSION = '3.10'; =head2 DESCRIPTION @@ -41,18 +57,6 @@ =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 @@ 1..3 +=item * C<is_pragma> + +Indicates whether or not this is a pragma line. + + pragma +strict + =item * C<is_test> Indicates whether or not this is a test line. - is $foo, $bar, $description; + ok 1 Is OK! =item * C<is_comment> ==== //depot/maint-5.10/perl/lib/TAP/Parser/Result/Bailout.pm#6 (text) ==== Index: perl/lib/TAP/Parser/Result/Bailout.pm --- perl/lib/TAP/Parser/Result/Bailout.pm#5~33966~ 2008-05-31 07:44:46.000000000 -0700 +++ perl/lib/TAP/Parser/Result/Bailout.pm 2008-05-31 07:49:10.000000000 -0700 @@ -12,11 +12,11 @@ =head1 VERSION -Version 3.09 +Version 3.10 =cut -$VERSION = '3.09'; +$VERSION = '3.10'; =head1 DESCRIPTION ==== //depot/maint-5.10/perl/lib/TAP/Parser/Result/Comment.pm#6 (text) ==== Index: perl/lib/TAP/Parser/Result/Comment.pm --- perl/lib/TAP/Parser/Result/Comment.pm#5~33966~ 2008-05-31 07:44:46.000000000 -0700 +++ perl/lib/TAP/Parser/Result/Comment.pm 2008-05-31 07:49:10.000000000 -0700 @@ -12,11 +12,11 @@ =head1 VERSION -Version 3.09 +Version 3.10 =cut -$VERSION = '3.09'; +$VERSION = '3.10'; =head1 DESCRIPTION ==== //depot/maint-5.10/perl/lib/TAP/Parser/Result/Plan.pm#6 (text) ==== Index: perl/lib/TAP/Parser/Result/Plan.pm --- perl/lib/TAP/Parser/Result/Plan.pm#5~33966~ 2008-05-31 07:44:46.000000000 -0700 +++ perl/lib/TAP/Parser/Result/Plan.pm 2008-05-31 07:49:10.000000000 -0700 @@ -12,11 +12,11 @@ =head1 VERSION -Version 3.09 +Version 3.10 =cut -$VERSION = '3.09'; +$VERSION = '3.10'; =head1 DESCRIPTION ==== //depot/maint-5.10/perl/lib/TAP/Parser/Result/Pragma.pm#1 (text) ==== Index: perl/lib/TAP/Parser/Result/Pragma.pm --- /dev/null 2008-05-07 15:08:24.549929899 -0700 +++ perl/lib/TAP/Parser/Result/Pragma.pm 2008-05-31 07:49:10.000000000 -0700 @@ -0,0 +1,63 @@ +package TAP::Parser::Result::Pragma; + +use strict; + +use vars qw($VERSION @ISA); +use TAP::Parser::Result; [EMAIL PROTECTED] = '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<TAP::Parser::Result>. 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<as_string> + +=item * C<raw> + +=back + +=cut + +############################################################################## + +=head2 Instance Methods + +=head3 C<pragmas> + +if ( $result->is_pragma ) { + @pragmas = $result->pragmas; +} + +=cut + +sub pragmas { + my @pragmas = @{ shift->{pragmas} }; + return wantarray ? @pragmas : [EMAIL PROTECTED]; +} + +1; ==== //depot/maint-5.10/perl/lib/TAP/Parser/Result/Test.pm#6 (text) ==== Index: perl/lib/TAP/Parser/Result/Test.pm --- perl/lib/TAP/Parser/Result/Test.pm#5~33966~ 2008-05-31 07:44:46.000000000 -0700 +++ perl/lib/TAP/Parser/Result/Test.pm 2008-05-31 07:49:10.000000000 -0700 @@ -14,11 +14,11 @@ =head1 VERSION -Version 3.09 +Version 3.10 =cut -$VERSION = '3.09'; +$VERSION = '3.10'; =head1 DESCRIPTION ==== //depot/maint-5.10/perl/lib/TAP/Parser/Result/Unknown.pm#6 (text) ==== Index: perl/lib/TAP/Parser/Result/Unknown.pm --- perl/lib/TAP/Parser/Result/Unknown.pm#5~33966~ 2008-05-31 07:44:46.000000000 -0700 +++ perl/lib/TAP/Parser/Result/Unknown.pm 2008-05-31 07:49:10.000000000 -0700 @@ -14,11 +14,11 @@ =head1 VERSION -Version 3.09 +Version 3.10 =cut -$VERSION = '3.09'; +$VERSION = '3.10'; =head1 DESCRIPTION ==== //depot/maint-5.10/perl/lib/TAP/Parser/Result/Version.pm#6 (text) ==== Index: perl/lib/TAP/Parser/Result/Version.pm --- perl/lib/TAP/Parser/Result/Version.pm#5~33966~ 2008-05-31 07:44:46.000000000 -0700 +++ perl/lib/TAP/Parser/Result/Version.pm 2008-05-31 07:49:10.000000000 -0700 @@ -8,26 +8,26 @@ =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<TAP::Parser::Result>. 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 ==== //depot/maint-5.10/perl/lib/TAP/Parser/Result/YAML.pm#6 (text) ==== Index: perl/lib/TAP/Parser/Result/YAML.pm --- perl/lib/TAP/Parser/Result/YAML.pm#5~33966~ 2008-05-31 07:44:46.000000000 -0700 +++ perl/lib/TAP/Parser/Result/YAML.pm 2008-05-31 07:49:10.000000000 -0700 @@ -12,11 +12,11 @@ =head1 VERSION -Version 3.09 +Version 3.10 =cut -$VERSION = '3.09'; +$VERSION = '3.10'; =head1 DESCRIPTION ==== //depot/maint-5.10/perl/lib/TAP/Parser/Source.pm#6 (text) ==== Index: perl/lib/TAP/Parser/Source.pm --- perl/lib/TAP/Parser/Source.pm#5~33966~ 2008-05-31 07:44:46.000000000 -0700 +++ perl/lib/TAP/Parser/Source.pm 2008-05-31 07:49:10.000000000 -0700 @@ -14,11 +14,11 @@ =head1 VERSION -Version 3.09 +Version 3.10 =cut -$VERSION = '3.09'; +$VERSION = '3.10'; =head1 DESCRIPTION ==== //depot/maint-5.10/perl/lib/TAP/Parser/Source/Perl.pm#6 (text) ==== Index: perl/lib/TAP/Parser/Source/Perl.pm --- perl/lib/TAP/Parser/Source/Perl.pm#5~33966~ 2008-05-31 07:44:46.000000000 -0700 +++ perl/lib/TAP/Parser/Source/Perl.pm 2008-05-31 07:49:10.000000000 -0700 @@ -16,11 +16,11 @@ =head1 VERSION -Version 3.09 +Version 3.10 =cut -$VERSION = '3.09'; +$VERSION = '3.10'; =head1 DESCRIPTION ==== //depot/maint-5.10/perl/lib/TAP/Parser/Utils.pm#2 (text) ==== Index: perl/lib/TAP/Parser/Utils.pm --- perl/lib/TAP/Parser/Utils.pm#1~33966~ 2008-05-31 07:44:46.000000000 -0700 +++ perl/lib/TAP/Parser/Utils.pm 2008-05-31 07:49:10.000000000 -0700 @@ -13,11 +13,11 @@ =head1 VERSION -Version 3.09 +Version 3.10 =cut -$VERSION = '3.09'; +$VERSION = '3.10'; =head1 SYNOPSIS ==== //depot/maint-5.10/perl/lib/TAP/Parser/YAMLish/Reader.pm#6 (text) ==== Index: perl/lib/TAP/Parser/YAMLish/Reader.pm --- perl/lib/TAP/Parser/YAMLish/Reader.pm#5~33966~ 2008-05-31 07:44:46.000000000 -0700 +++ perl/lib/TAP/Parser/YAMLish/Reader.pm 2008-05-31 07:49:10.000000000 -0700 @@ -4,7 +4,7 @@ use vars qw{$VERSION}; -$VERSION = '3.09'; +$VERSION = '3.10'; # TODO: # Handle blessed object syntax @@ -277,7 +277,7 @@ =head1 VERSION -Version 3.09 +Version 3.10 =head1 SYNOPSIS ==== //depot/maint-5.10/perl/lib/TAP/Parser/YAMLish/Writer.pm#6 (text) ==== Index: perl/lib/TAP/Parser/YAMLish/Writer.pm --- perl/lib/TAP/Parser/YAMLish/Writer.pm#5~33966~ 2008-05-31 07:44:46.000000000 -0700 +++ perl/lib/TAP/Parser/YAMLish/Writer.pm 2008-05-31 07:49:10.000000000 -0700 @@ -4,7 +4,7 @@ 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 @@ =head1 VERSION -Version 3.09 +Version 3.10 =head1 SYNOPSIS ==== //depot/maint-5.10/perl/lib/Test/Harness.pm#7 (text) ==== Index: perl/lib/Test/Harness.pm --- perl/lib/Test/Harness.pm#6~33966~ 2008-05-31 07:44:46.000000000 -0700 +++ perl/lib/Test/Harness.pm 2008-05-31 07:49:10.000000000 -0700 @@ -43,11 +43,11 @@ =head1 VERSION -Version 3.09 +Version 3.10 =cut -$VERSION = '3.09'; +$VERSION = '3.10'; # Backwards compatibility for exportable variable names. *verbose = *Verbose; ==== //depot/maint-5.10/perl/lib/Test/Harness/t/000-load.t#4 (text) ==== Index: perl/lib/Test/Harness/t/000-load.t --- perl/lib/Test/Harness/t/000-load.t#3~33966~ 2008-05-31 07:44:46.000000000 -0700 +++ perl/lib/Test/Harness/t/000-load.t 2008-05-31 07:49:10.000000000 -0700 @@ -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 @@ 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 ==== //depot/maint-5.10/perl/lib/Test/Harness/t/grammar.t#2 (text) ==== Index: perl/lib/Test/Harness/t/grammar.t --- perl/lib/Test/Harness/t/grammar.t#1~33961~ 2008-05-31 07:30:09.000000000 -0700 +++ perl/lib/Test/Harness/t/grammar.t 2008-05-31 07:49:10.000000000 -0700 @@ -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 @@ # 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 @@ 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 @@ $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; } ==== //depot/maint-5.10/perl/lib/Test/Harness/t/parse.t#2 (xtext) ==== Index: perl/lib/Test/Harness/t/parse.t --- perl/lib/Test/Harness/t/parse.t#1~33961~ 2008-05-31 07:30:09.000000000 -0700 +++ perl/lib/Test/Harness/t/parse.t 2008-05-31 07:49:10.000000000 -0700 @@ -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 @@ 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 @@ # 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 @@ 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 [EMAIL PROTECTED], [EMAIL PROTECTED], "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 ], [EMAIL PROTECTED], "all states reachable"; +} ==== //depot/maint-5.10/perl/lib/Test/Harness/t/regression.t#4 (text) ==== Index: perl/lib/Test/Harness/t/regression.t --- perl/lib/Test/Harness/t/regression.t#3~33963~ 2008-05-31 07:37:05.000000000 -0700 +++ perl/lib/Test/Harness/t/regression.t 2008-05-31 07:49:10.000000000 -0700 @@ -2245,6 +2245,48 @@ 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 @@ 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 @@ 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 @@ "... 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 { ==== //depot/maint-5.10/perl/t/lib/sample-tests/strict#1 (text) ==== Index: perl/t/lib/sample-tests/strict --- /dev/null 2008-05-07 15:08:24.549929899 -0700 +++ perl/t/lib/sample-tests/strict 2008-05-31 07:49:10.000000000 -0700 @@ -0,0 +1,9 @@ +print <<DUMMY_TEST; +TAP version 13 +1..1 +pragma +strict +Nonsense! +pragma -strict +Doesn't matter. +ok 1 All OK +DUMMY_TEST End of Patch.