Update Test-Harness to CPAN version 3.22

  [DELTA]

  3.22    2010-08-14
        - Allow TAP::Parser to recognize a nested BAIL_OUT directive.
        - Add brief HOWTO for creating and running pgTAP tests to
          TAP::Parser::SourceHandler::pgTAP.
        - Fix trailing plan + embedded YAML + TAP 13 case. Thanks to
          Steffen Schwigon. #54518.
        - Numerous spelling fixes. Thanks to Ville Skytt<C3><A4>.
        - Add new option --tapversion for prove to set the default
          assumed TAP version. Thanks to Steffen Schwigon.
        - Fixed tests to run successfully under Devel::Cover. Thanks to
          Phillipe Bruhat.
        - Fixed injection of test args to work with general executables
          as well as Perl scripts (#59186).
        - Allow multiple --ext=.foo arguments to prove, to allow running
          different types of tests in the same prove run.
        - App::Prove::extension() is now App::Prove::extensions(), and
          returns an arrayref of extensions, rather than a single scalar.
          The same change has been made to App::Prove::State::extension().
        - Preserve old semantics for test scripts with a shebang line
          by favouring Perl as the intepreter for any file with a
          shebang (#59457).
        - Add --trap (summary on Ctrl-C) option to prove (#59427).
        - Removed TAP::Parser::SourceHandler::pgTAP. Find it in its own
          distribution on CPAN.
        - Source options to prove can now be specified so as to be passed to
          the source as a hash reference, eg:

              prove --source XYZ --xyz-option pset=foo=bar

          Ths "pset" option will be passed as a hash reference with the key
          "foo" and the value "bar".

1 files changed, 33 insertions, 23 deletions

diff --git a/cpan/Test-Harness/t/source.t b/cpan/Test-Harness/t/source.t
index 3950143e0d..77f61845bb 100644
--- a/cpan/Test-Harness/t/source.t
+++ b/cpan/Test-Harness/t/source.t
@@ -1,7 +1,7 @@
 #!/usr/bin/perl -w
 
 BEGIN {
-  unshift @INC, 't/lib';
+    unshift @INC, 't/lib';
 }
 
 use strict;
@@ -16,6 +16,15 @@ my $dir = File::Spec->catdir(
 
 use_ok('TAP::Parser::Source');
 
+sub ct($) {
+    my $hash = shift;
+    if ( $ENV{PERL_CORE} ) {
+        delete $hash->{is_symlink};
+        delete $hash->{lstat};
+    }
+    return $hash;
+}
+
 # Basic tests
 {
     my $source = TAP::Parser::Source->new;
@@ -131,8 +140,8 @@ use_ok('TAP::Parser::Source');
     # separate meta->file to break up the test
     my $file = delete $meta->{file};
     is_deeply(
-        $meta,
-        {   is_scalar    => 1,
+        ct $meta,
+        ct {is_scalar    => 1,
             has_newlines => 0,
             length       => length($test),
             is_object    => 0,
@@ -152,8 +161,8 @@ use_ok('TAP::Parser::Source');
     isnt( delete $file->{write},   undef, '... file->write set' );
     isnt( delete $file->{execute}, undef, '... file->execute set' );
     is_deeply(
-        $file,
-        {   basename   => 'source.t',
+        ct $file,
+        ct {basename   => 'source.t',
             ext        => '.t',
             lc_ext     => '.t',
             shebang    => '#!/usr/bin/perl',
@@ -164,9 +173,10 @@ use_ok('TAP::Parser::Source');
             is_dir     => 0,
             is_file    => 1,
             is_symlink => 0,
-            sticky     => 0,
-            setgid     => 0,
-            setuid     => 0,
+            # Fix for bizarre -k bug in Strawberry Perl
+            sticky     => ( -k $test )[-1] ? 1 : 0,
+            setgid     => -g $test ? 1 : 0,
+            setuid     => -u $test ? 1 : 0,
         },
         '... file->* set'
     );
@@ -174,7 +184,7 @@ use_ok('TAP::Parser::Source');
 
 # dir test
 {
-    my $test   = File::Spec->catfile($dir);
+    my $test   = $dir;
     my $source = TAP::Parser::Source->new;
 
     $source->raw( \$test );
@@ -183,8 +193,8 @@ use_ok('TAP::Parser::Source');
     # separate meta->file to break up the test
     my $file = delete $meta->{file};
     is_deeply(
-        $meta,
-        {   is_scalar    => 1,
+        ct $meta,
+        ct {is_scalar    => 1,
             has_newlines => 0,
             length       => length($test),
             is_object    => 0,
@@ -206,8 +216,8 @@ use_ok('TAP::Parser::Source');
     isnt( delete $file->{write},   undef, '... file->write set' );
     isnt( delete $file->{execute}, undef, '... file->execute set' );
     is_deeply(
-        $file,
-        {   basename   => 'source_tests',
+        ct $file,
+        ct {basename   => 'source_tests',
             ext        => '',
             lc_ext     => '',
             text       => 0,
@@ -215,9 +225,9 @@ use_ok('TAP::Parser::Source');
             is_dir     => 1,
             is_file    => 0,
             is_symlink => 0,
-            sticky     => 0,
-            setgid     => 0,
-            setuid     => 0,
+            sticky     => ( -k $test )[-1] ? 1 : 0,
+            setgid     => -g $test ? 1 : 0,
+            setuid     => -u $test ? 1 : 0,
         },
         '... file->* set'
     );
@@ -244,8 +254,8 @@ SKIP: {
     # separate meta->file to break up the test
     my $file = delete $meta->{file};
     is_deeply(
-        $meta,
-        {   is_scalar    => 1,
+        ct $meta,
+        ct {is_scalar    => 1,
             has_newlines => 0,
             length       => length($symlink),
             is_object    => 0,
@@ -267,8 +277,8 @@ SKIP: {
     isnt( delete $file->{write},   undef, '... file->write set' );
     isnt( delete $file->{execute}, undef, '... file->execute set' );
     is_deeply(
-        $file,
-        {   basename   => 'source_link.T',
+        ct $file,
+        ct {basename   => 'source_link.T',
             ext        => '.T',
             lc_ext     => '.t',
             shebang    => '#!/usr/bin/perl',
@@ -279,9 +289,9 @@ SKIP: {
             is_dir     => 0,
             is_file    => 1,
             is_symlink => 1,
-            sticky     => 0,
-            setgid     => 0,
-            setuid     => 0,
+            sticky     => ( -k $symlink )[-1] ? 1 : 0,
+            setgid     => -g $symlink ? 1 : 0,
+            setuid     => -u $symlink ? 1 : 0,
         },
         '... file->* set'
     );