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.
