Upgrade to Test-Harness-3.09
Steve Peters [Mon, 11 Feb 2008 16:58:15 +0000 (16:58 +0000)]
p4raw-id: //depot/perl@33281

34 files changed:
MANIFEST
lib/App/Prove.pm
lib/App/Prove/State.pm
lib/TAP/Base.pm
lib/TAP/Formatter/Color.pm
lib/TAP/Formatter/Console.pm
lib/TAP/Formatter/Console/ParallelSession.pm
lib/TAP/Formatter/Console/Session.pm
lib/TAP/Harness.pm
lib/TAP/Parser.pm
lib/TAP/Parser/Aggregator.pm
lib/TAP/Parser/Grammar.pm
lib/TAP/Parser/Iterator.pm
lib/TAP/Parser/Iterator/Array.pm
lib/TAP/Parser/Iterator/Process.pm
lib/TAP/Parser/Iterator/Stream.pm
lib/TAP/Parser/Multiplexer.pm
lib/TAP/Parser/Result.pm
lib/TAP/Parser/Result/Bailout.pm
lib/TAP/Parser/Result/Comment.pm
lib/TAP/Parser/Result/Plan.pm
lib/TAP/Parser/Result/Test.pm
lib/TAP/Parser/Result/Unknown.pm
lib/TAP/Parser/Result/Version.pm
lib/TAP/Parser/Result/YAML.pm
lib/TAP/Parser/Source.pm
lib/TAP/Parser/Source/Perl.pm
lib/TAP/Parser/Utils.pm [new file with mode: 0644]
lib/TAP/Parser/YAMLish/Reader.pm
lib/TAP/Parser/YAMLish/Writer.pm
lib/Test/Harness.pm
lib/Test/Harness/bin/prove
lib/Test/Harness/t/000-load.t
lib/Test/Harness/t/utils.t [new file with mode: 0644]

index be38939..740c740 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -2622,6 +2622,7 @@ lib/TAP/Parser/Result/Version.pm  A parser for Test Anything Protocol
 lib/TAP/Parser/Result/YAML.pm          A parser for Test Anything Protocol
 lib/TAP/Parser/Source.pm               A parser for Test Anything Protocol
 lib/TAP/Parser/Source/Perl.pm          A parser for Test Anything Protocol
+lib/TAP/Parser/Utils.pm                        A parser for Test Anything Protocol
 lib/TAP/Parser/YAMLish/Reader.pm       A parser for Test Anything Protocol
 lib/TAP/Parser/YAMLish/Writer.pm       A parser for Test Anything Protocol
 lib/Term/ANSIColor/ChangeLog   Term::ANSIColor
@@ -2683,6 +2684,7 @@ lib/Test/Harness/t/streams.t              Test::Harness test
 lib/Test/Harness/t/taint.t             Test::Harness test
 lib/Test/Harness/t/testargs.t          Test::Harness test
 lib/Test/Harness/t/unicode.t           Test::Harness test
+lib/Test/Harness/t/utils.t             Test::Harness test
 lib/Test/Harness/t/yamlish-output.t    Test::Harness test
 lib/Test/Harness/t/yamlish-writer.t    Test::Harness test
 lib/Test/Harness/t/yamlish.t           Test::Harness test
index 275d52e..627ffc3 100644 (file)
@@ -2,6 +2,7 @@ package App::Prove;
 
 use strict;
 use TAP::Harness;
+use TAP::Parser::Utils qw( split_shell );
 use File::Spec;
 use Getopt::Long;
 use App::Prove::State;
@@ -15,11 +16,11 @@ App::Prove - Implements the C<prove> command.
 
 =head1 VERSION
 
-Version 3.08
+Version 3.09
 
 =cut
 
-$VERSION = '3.08';
+$VERSION = '3.09';
 
 =head1 DESCRIPTION
 
@@ -462,9 +463,7 @@ sub _get_switches {
         push @switches, '-w';
     }
 
-    if ( defined( my $hps = $ENV{HARNESS_PERL_SWITCHES} ) ) {
-        push @switches, $hps;
-    }
+    push @switches, split_shell( $ENV{HARNESS_PERL_SWITCHES} );
 
     return @switches ? \@switches : ();
 }
index b689265..c04870a 100644 (file)
@@ -20,11 +20,11 @@ App::Prove::State - State storage for the C<prove> command.
 
 =head1 VERSION
 
-Version 3.08
+Version 3.09
 
 =cut
 
-$VERSION = '3.08';
+$VERSION = '3.09';
 
 =head1 DESCRIPTION
 
index 0aa7e95..a15383a 100644 (file)
@@ -9,11 +9,11 @@ TAP::Base - Base class that provides common functionality to L<TAP::Parser> and
 
 =head1 VERSION
 
-Version 3.08
+Version 3.09
 
 =cut
 
-$VERSION = '3.08';
+$VERSION = '3.09';
 
 my $GOT_TIME_HIRES;
 
index b38ea8f..3d6d196 100644 (file)
@@ -70,11 +70,11 @@ TAP::Formatter::Color - Run Perl test scripts with color
 
 =head1 VERSION
 
-Version 3.08
+Version 3.09
 
 =cut
 
-$VERSION = '3.08';
+$VERSION = '3.09';
 
 =head1 DESCRIPTION
 
index e5e9ce3..6033fe8 100644 (file)
@@ -52,11 +52,11 @@ TAP::Formatter::Console - Harness output delegate for default console output
 
 =head1 VERSION
 
-Version 3.08
+Version 3.09
 
 =cut
 
-$VERSION = '3.08';
+$VERSION = '3.09';
 
 =head1 DESCRIPTION
 
index 2bd9e91..163f7fc 100644 (file)
@@ -48,11 +48,11 @@ TAP::Formatter::Console::ParallelSession - Harness output delegate for parallel
 
 =head1 VERSION
 
-Version 3.08
+Version 3.09
 
 =cut
 
-$VERSION = '3.08';
+$VERSION = '3.09';
 
 =head1 DESCRIPTION
 
index a4bc4bd..7e9e4de 100644 (file)
@@ -36,11 +36,11 @@ TAP::Formatter::Console::Session - Harness output delegate for default console o
 
 =head1 VERSION
 
-Version 3.08
+Version 3.09
 
 =cut
 
-$VERSION = '3.08';
+$VERSION = '3.09';
 
 =head1 DESCRIPTION
 
index 2aa3ad4..fddb9e0 100644 (file)
@@ -22,11 +22,11 @@ TAP::Harness - Run test scripts with statistics
 
 =head1 VERSION
 
-Version 3.08
+Version 3.09
 
 =cut
 
-$VERSION = '3.08';
+$VERSION = '3.09';
 
 $ENV{HARNESS_ACTIVE}  = 1;
 $ENV{HARNESS_VERSION} = $VERSION;
@@ -484,7 +484,7 @@ Each elements of the @tests array is either
 When you supply a separate display name it becomes possible to run a
 test more than once; the display name is effectively the alias by which
 the test is known inside the harness. The harness doesn't care if it
-runs the same script more than once along as each invocation uses a
+runs the same script more than once when each invocation uses a
 different name.
 
 =cut
@@ -496,6 +496,10 @@ sub aggregate_tests {
 
     my @expanded = map { 'ARRAY' eq ref $_ ? $_ : [ $_, $_ ] } @tests;
 
+    # #12458
+    local $ENV{HARNESS_IS_VERBOSE} = 1
+      if $self->formatter->verbosity > 0;
+
     # Formatter gets only names
     $self->formatter->prepare( map { $_->[1] } @expanded );
 
index a23151e..4c8dc3d 100644 (file)
@@ -19,11 +19,11 @@ TAP::Parser - Parse L<TAP|Test::Harness::TAP> output
 
 =head1 VERSION
 
-Version 3.08
+Version 3.09
 
 =cut
 
-$VERSION = '3.08';
+$VERSION = '3.09';
 
 my $DEFAULT_TAP_VERSION = 12;
 my $MAX_TAP_VERSION     = 13;
@@ -506,13 +506,6 @@ C<$result> object.
 
 This is merely a synonym for C<as_string>.
 
-=head3 C<tests_planned>
-
-  my $planned = $result->tests_planned;
-
-Returns the number of tests planned.  For example, a plan of C<1..17> will
-cause this method to return '17'.
-
 =head3 C<directive>
 
  my $directive = $result->directive;
index 479c0af..e47bd00 100644 (file)
@@ -10,11 +10,11 @@ TAP::Parser::Aggregator - Aggregate TAP::Parser results
 
 =head1 VERSION
 
-Version 3.08
+Version 3.09
 
 =cut
 
-$VERSION = '3.08';
+$VERSION = '3.09';
 
 =head1 SYNOPSIS
 
index 8acfedd..3af5d74 100644 (file)
@@ -12,11 +12,11 @@ TAP::Parser::Grammar - A grammar for the Test Anything Protocol.
 
 =head1 VERSION
 
-Version 3.08
+Version 3.09
 
 =cut
 
-$VERSION = '3.08';
+$VERSION = '3.09';
 
 =head1 DESCRIPTION
 
index a3ca7ff..6e082e2 100644 (file)
@@ -13,11 +13,11 @@ TAP::Parser::Iterator - Internal TAP::Parser Iterator
 
 =head1 VERSION
 
-Version 3.08
+Version 3.09
 
 =cut
 
-$VERSION = '3.08';
+$VERSION = '3.09';
 
 =head1 SYNOPSIS
 
index 9d067ef..bf1ae77 100644 (file)
@@ -11,11 +11,11 @@ TAP::Parser::Iterator::Array - Internal TAP::Parser Iterator
 
 =head1 VERSION
 
-Version 3.08
+Version 3.09
 
 =cut
 
-$VERSION = '3.08';
+$VERSION = '3.09';
 
 =head1 SYNOPSIS
 
index 664dc8a..2e7d47c 100644 (file)
@@ -19,11 +19,11 @@ TAP::Parser::Iterator::Process - Internal TAP::Parser Iterator
 
 =head1 VERSION
 
-Version 3.08
+Version 3.09
 
 =cut
 
-$VERSION = '3.08';
+$VERSION = '3.09';
 
 =head1 SYNOPSIS
 
index 14523e5..4ade218 100644 (file)
@@ -11,11 +11,11 @@ TAP::Parser::Iterator::Stream - Internal TAP::Parser Iterator
 
 =head1 VERSION
 
-Version 3.08
+Version 3.09
 
 =cut
 
-$VERSION = '3.08';
+$VERSION = '3.09';
 
 =head1 SYNOPSIS
 
index 6d516c6..aa158b5 100644 (file)
@@ -14,11 +14,11 @@ TAP::Parser::Multiplexer - Multiplex multiple TAP::Parsers
 
 =head1 VERSION
 
-Version 3.08
+Version 3.09
 
 =cut
 
-$VERSION = '3.08';
+$VERSION = '3.09';
 
 =head1 SYNOPSIS
 
index 9e81cc2..569a28b 100644 (file)
@@ -27,11 +27,11 @@ TAP::Parser::Result - TAP::Parser output
 
 =head1 VERSION
 
-Version 3.08
+Version 3.09
 
 =cut
 
-$VERSION = '3.08';
+$VERSION = '3.09';
 
 =head2 DESCRIPTION
 
index 2ac5450..1263611 100644 (file)
@@ -12,11 +12,11 @@ TAP::Parser::Result::Bailout - Bailout result token.
 
 =head1 VERSION
 
-Version 3.08
+Version 3.09
 
 =cut
 
-$VERSION = '3.08';
+$VERSION = '3.09';
 
 =head1 DESCRIPTION
 
index 8e7ddd5..21fcd74 100644 (file)
@@ -12,11 +12,11 @@ TAP::Parser::Result::Comment - Comment result token.
 
 =head1 VERSION
 
-Version 3.08
+Version 3.09
 
 =cut
 
-$VERSION = '3.08';
+$VERSION = '3.09';
 
 =head1 DESCRIPTION
 
index 3d8db50..e700033 100644 (file)
@@ -12,11 +12,11 @@ TAP::Parser::Result::Plan - Plan result token.
 
 =head1 VERSION
 
-Version 3.08
+Version 3.09
 
 =cut
 
-$VERSION = '3.08';
+$VERSION = '3.09';
 
 =head1 DESCRIPTION
 
index 43a3d9a..0212447 100644 (file)
@@ -14,11 +14,11 @@ TAP::Parser::Result::Test - Test result token.
 
 =head1 VERSION
 
-Version 3.08
+Version 3.09
 
 =cut
 
-$VERSION = '3.08';
+$VERSION = '3.09';
 
 =head1 DESCRIPTION
 
index 7aac777..5663558 100644 (file)
@@ -14,11 +14,11 @@ TAP::Parser::Result::Unknown - Unknown result token.
 
 =head1 VERSION
 
-Version 3.08
+Version 3.09
 
 =cut
 
-$VERSION = '3.08';
+$VERSION = '3.09';
 
 =head1 DESCRIPTION
 
index 7805997..1162d53 100644 (file)
@@ -12,11 +12,11 @@ TAP::Parser::Result::Version - TAP version result token.
 
 =head1 VERSION
 
-Version 3.08
+Version 3.09
 
 =cut
 
-$VERSION = '3.08';
+$VERSION = '3.09';
 
 =head1 DESCRIPTION
 
index 39602f7..2670d6e 100644 (file)
@@ -12,11 +12,11 @@ TAP::Parser::Result::YAML - YAML result token.
 
 =head1 VERSION
 
-Version 3.08
+Version 3.09
 
 =cut
 
-$VERSION = '3.08';
+$VERSION = '3.09';
 
 =head1 DESCRIPTION
 
index 6fa2c79..386cd9f 100644 (file)
@@ -14,11 +14,11 @@ TAP::Parser::Source - Stream output from some source
 
 =head1 VERSION
 
-Version 3.08
+Version 3.09
 
 =cut
 
-$VERSION = '3.08';
+$VERSION = '3.09';
 
 =head1 DESCRIPTION
 
index 2b55b6d..02db5bc 100644 (file)
@@ -16,11 +16,11 @@ TAP::Parser::Source::Perl - Stream Perl output
 
 =head1 VERSION
 
-Version 3.08
+Version 3.09
 
 =cut
 
-$VERSION = '3.08';
+$VERSION = '3.09';
 
 =head1 DESCRIPTION
 
@@ -262,11 +262,6 @@ sub _switches {
         $_ = qq["$_"] if ( ( /\s/ || IS_VMS ) && !/^".*"$/ );
     }
 
-    my %found_switch = map { $_ => 0 } @switches;
-
-    # remove duplicate switches
-    @switches
-      = grep { defined $_ && $_ ne '' && !$found_switch{$_}++ } @switches;
     return @switches;
 }
 
diff --git a/lib/TAP/Parser/Utils.pm b/lib/TAP/Parser/Utils.pm
new file mode 100644 (file)
index 0000000..dbdc5a3
--- /dev/null
@@ -0,0 +1,72 @@
+package TAP::Parser::Utils;
+
+use strict;
+use Exporter;
+use vars qw($VERSION @ISA @EXPORT_OK);
+
+@ISA       = qw( Exporter );
+@EXPORT_OK = qw( split_shell );
+
+=head1 NAME
+
+TAP::Parser::Utils - Internal TAP::Parser utilities
+
+=head1 VERSION
+
+Version 3.09
+
+=cut
+
+$VERSION = '3.09';
+
+=head1 SYNOPSIS
+
+  use TAP::Parser::Utils qw( split_shell )
+  my @switches = split_shell( $arg );
+
+=head1 DESCRIPTION
+
+B<FOR INTERNAL USE ONLY!>
+
+=head2 INTERFACE
+
+=head3 C<split_shell>
+
+Shell style argument parsing. Handles backslash escaping, single and
+double quoted strings but not shell substitutions.
+
+Pass one or more strings containing shell escaped arguments. The return
+value is an array of arguments parsed from the input strings according
+to (approximate) shell parsing rules. It's legal to pass C<undef> in
+which case an empty array will be returned. That makes it possible to
+
+    my @args = split_shell( $ENV{SOME_ENV_VAR} );
+
+without worrying about whether the environment variable exists.
+
+This is used to split HARNESS_PERL_ARGS into individual switches.
+
+=cut
+
+sub split_shell {
+    my @parts = ();
+
+    for my $switch ( grep defined && length, @_ ) {
+        push @parts, $1 while $switch =~ /
+        ( 
+            (?:   [^\\"'\s]+
+                | \\. 
+                | " (?: \\. | [^"] )* "
+                | ' (?: \\. | [^'] )* ' 
+            )+
+        ) /xg;
+    }
+
+    for (@parts) {
+        s/ \\(.) | ['"] /defined $1 ? $1 : ''/exg;
+    }
+
+    return @parts;
+}
+
+1;
index d5ab5fc..2fa032e 100644 (file)
@@ -4,7 +4,7 @@ use strict;
 
 use vars qw{$VERSION};
 
-$VERSION = '3.08';
+$VERSION = '3.09';
 
 # TODO:
 #   Handle blessed object syntax
@@ -277,7 +277,7 @@ TAP::Parser::YAMLish::Reader - Read YAMLish data from iterator
 
 =head1 VERSION
 
-Version 3.08
+Version 3.09
 
 =head1 SYNOPSIS
 
index b71352a..8875ca4 100644 (file)
@@ -4,7 +4,7 @@ use strict;
 
 use vars qw{$VERSION};
 
-$VERSION = '3.08';
+$VERSION = '3.09';
 
 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.08
+Version 3.09
 
 =head1 SYNOPSIS
 
index 77814e4..14af275 100644 (file)
@@ -11,6 +11,8 @@ use TAP::Harness              ();
 use TAP::Parser::Aggregator   ();
 use TAP::Parser::Source::Perl ();
 
+use TAP::Parser::Utils qw( split_shell );
+
 use Config;
 use Exporter;
 
@@ -41,11 +43,11 @@ Test::Harness - Run Perl standard test scripts with statistics
 
 =head1 VERSION
 
-Version 3.08
+Version 3.09
 
 =cut
 
-$VERSION = '3.08';
+$VERSION = '3.09';
 
 # Backwards compatibility for exportable variable names.
 *verbose  = *Verbose;
@@ -93,7 +95,8 @@ pluggable 'Straps' interface that previous versions of L<Test::Harness>
 supported is not reproduced here. Straps is now available as a stand
 alone module: L<Test::Harness::Straps>.
 
-See L<TAP::Parser> for the main documentation for this distribution.
+See L<TAP::Parser>, L<TAP::Harness> for the main documentation for this
+distribution.
 
 =head1 FUNCTIONS
 
@@ -221,14 +224,10 @@ sub _canon {
 sub _new_harness {
     my $sub_args = shift || {};
 
-    if ( defined( my $env_sw = $ENV{HARNESS_PERL_SWITCHES} ) ) {
-        $Switches .= ' ' . $env_sw if ( length($env_sw) );
-    }
-
-    # This is a bit crufty. The switches have all been joined into a
-    # single string so we have to try and recover them.
     my ( @lib, @switches );
-    for my $opt ( split( /\s+(?=-)/, $Switches ) ) {
+    for my $opt (
+        split_shell( $Switches, $ENV{HARNESS_PERL_SWITCHES} ) )
+    {
         if ( $opt =~ /^ -I (.*) $ /x ) {
             push @lib, $1;
         }
@@ -556,6 +555,17 @@ Multiple options may be separated by colons:
 
 =back
 
+=head1 Taint Mode
+
+Normally when a Perl program is run in taint mode the contents of the
+C<PERL5LIB> environment variable do not appear in C<@INC>.
+
+Because C<PERL5LIB> is often used during testing to add build
+directories to C<@INC> C<Test::Harness> (actually
+L<TAP::Parser::Source::Perl>) passes the names of any directories found
+in C<PERL5LIB> as -I switches. The net effect of this is that
+C<PERL5LIB> is honoured even in taint mode.
+
 =head1 SEE ALSO
 
 L<TAP::Harness>
@@ -572,7 +582,8 @@ as I make changes.
 
 Andy Armstrong  C<< <andy@hexten.net> >>
 
-L<Test::Harness> (on which this module is based) has this attribution:
+L<Test::Harness> 2.64 (maintained by Andy Lester and on which this
+module is based) has this attribution:
 
     Either Tim Bunce or Andreas Koenig, we don't know. What we know for
     sure is, that it was inspired by Larry Wall's F<TEST> script that came
index 336229d..acd845a 100644 (file)
@@ -240,6 +240,17 @@ The C<--state> switch may be used more than once.
 
     $ prove -b --state=hot --state=all,save
 
+=head2 Taint Mode
+
+Normally when a Perl program is run in taint mode the contents of the
+C<PERL5LIB> environment variable do not appear in C<@INC>.
+
+Because C<PERL5LIB> is often used during testing to add build directories
+to C<@INC> prove (actually L<TAP::Parser::Source::Perl>) passes the
+names of any directories found in C<PERL5LIB> as -I switches. The net
+effect of this is that C<PERL5LIB> is honoured even when prove is run in
+taint mode.
+
 =cut
 
 # vim:ts=4:sw=4:et:sta
index 1cd870d..5e4554a 100644 (file)
@@ -3,7 +3,7 @@
 use strict;
 use lib 't/lib';
 
-use Test::More tests => 58;
+use Test::More tests => 60;
 
 BEGIN {
 
@@ -37,6 +37,7 @@ BEGIN {
       TAP::Parser::Source
       TAP::Parser::YAMLish::Reader
       TAP::Parser::YAMLish::Writer
+      TAP::Parser::Utils
       Test::Harness
     );
 
diff --git a/lib/Test/Harness/t/utils.t b/lib/Test/Harness/t/utils.t
new file mode 100644 (file)
index 0000000..d60c8a2
--- /dev/null
@@ -0,0 +1,65 @@
+#!/usr/bin/perl -w
+
+BEGIN {
+    chdir 't' and @INC = '../lib' if $ENV{PERL_CORE};
+}
+
+use strict;
+use lib 't/lib';
+
+use TAP::Parser::Utils qw( split_shell );
+use Test::More;
+
+my @schedule = (
+    {   name => 'Bare words',
+        in   => 'bare words are here',
+        out  => [ 'bare', 'words', 'are', 'here' ],
+    },
+    {   name => 'Single quotes',
+        in   => "'bare' 'words' 'are' 'here'",
+        out  => [ 'bare', 'words', 'are', 'here' ],
+    },
+    {   name => 'Double quotes',
+        in   => '"bare" "words" "are" "here"',
+        out  => [ 'bare', 'words', 'are', 'here' ],
+    },
+    {   name => 'Escapes',
+        in   => '\  "ba\"re" \'wo\\\'rds\' \\\\"are" "here"',
+        out  => [ ' ', 'ba"re', "wo'rds", '\\are', 'here' ],
+    },
+    {   name => 'Flag',
+        in   => '-e "system(shift)"',
+        out  => [ '-e', 'system(shift)' ],
+    },
+    {   name => 'Nada',
+        in   => undef,
+        out  => [],
+    },
+    {   name => 'Nada II',
+        in   => '',
+        out  => [],
+    },
+    {   name => 'Zero',
+        in   => 0,
+        out  => ['0'],
+    },
+    {   name => 'Empty',
+        in   => '""',
+        out  => [''],
+    },
+    {   name => 'Empty II',
+        in   => "''",
+        out  => [''],
+    },
+);
+
+plan tests => 1 * @schedule;
+
+for my $test (@schedule) {
+    my $name = $test->{name};
+    my @got  = split_shell( $test->{in} );
+    unless ( is_deeply \@got, $test->{out}, "$name: parse OK" ) {
+        use Data::Dumper;
+        diag( Dumper( { want => $test->{out}, got => \@got } ) );
+    }
+}