Upgrade to Test-Harness-3.10

p4raw-id: //depot/perl@33393

5 files changed, 140 insertions, 17 deletions

diff --git a/lib/Test/Harness.pm b/lib/Test/Harness.pm
index 14af275db3..17e891653b 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 5e4554aa22..5c952a7f27 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 107cd77aca..6d572f9082 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 6e5c585273..a53ad3a746 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 80902df361..5398580c7b 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 {