perl 5.14.2 from siep

git-svn-id: svn://tug.org/texlive/trunk@26525 c570f23f-e606-0410-a88d-b1316a301751

4 files changed, 137 insertions, 75 deletions

diff --git a/Master/tlpkg/tlperl/lib/App/Prove.pm b/Master/tlpkg/tlperl/lib/App/Prove.pm
index fd431ed2f05..0e74fb4cacb 100644
--- a/Master/tlpkg/tlperl/lib/App/Prove.pm
+++ b/Master/tlpkg/tlperl/lib/App/Prove.pm
@@ -17,11 +17,11 @@ App::Prove - Implements the C<prove> command.
 
 =head1 VERSION
 
-Version 3.17
+Version 3.23
 
 =cut
 
-$VERSION = '3.17';
+$VERSION = '3.23';
 
 =head1 DESCRIPTION
 
@@ -58,8 +58,8 @@ BEGIN {
       formatter harness includes modules plugins jobs lib merge parse quiet
       really_quiet recurse backwards shuffle taint_fail taint_warn timer
       verbose warnings_fail warnings_warn show_help show_man show_version
-      state_class test_args state dry extension ignore_exit rules state_manager
-      normalize
+      state_class test_args state dry extensions ignore_exit rules state_manager
+      normalize sources tapversion trap
     );
     __PACKAGE__->mk_methods(@ATTR);
 }
@@ -81,8 +81,12 @@ sub _initialize {
     my $self = shift;
     my $args = shift || {};
 
+    my @is_array = qw(
+      argv rc_opts includes modules state plugins rules sources
+    );
+
     # setup defaults:
-    for my $key (qw( argv rc_opts includes modules state plugins rules )) {
+    for my $key (@is_array) {
         $self->{$key} = [];
     }
     $self->{harness_class} = 'TAP::Harness';
@@ -197,49 +201,57 @@ sub process_args {
 
     {
         local @ARGV = @args;
-        Getopt::Long::Configure( 'no_ignore_case', 'bundling' );
+        Getopt::Long::Configure(qw(no_ignore_case bundling pass_through));
 
         # Don't add coderefs to GetOptions
         GetOptions(
-            'v|verbose'   => \$self->{verbose},
-            'f|failures'  => \$self->{failures},
-            'o|comments'  => \$self->{comments},
-            'l|lib'       => \$self->{lib},
-            'b|blib'      => \$self->{blib},
-            's|shuffle'   => \$self->{shuffle},
-            'color!'      => \$self->{color},
-            'colour!'     => \$self->{color},
-            'count!'      => \$self->{show_count},
-            'c'           => \$self->{color},
-            'D|dry'       => \$self->{dry},
-            'ext=s'       => \$self->{extension},
-            'harness=s'   => \$self->{harness},
-            'ignore-exit' => \$self->{ignore_exit},
-            'formatter=s' => \$self->{formatter},
-            'r|recurse'   => \$self->{recurse},
-            'reverse'     => \$self->{backwards},
-            'p|parse'     => \$self->{parse},
-            'q|quiet'     => \$self->{quiet},
-            'Q|QUIET'     => \$self->{really_quiet},
-            'e|exec=s'    => \$self->{exec},
-            'm|merge'     => \$self->{merge},
-            'I=s@'        => $self->{includes},
-            'M=s@'        => $self->{modules},
-            'P=s@'        => $self->{plugins},
-            'state=s@'    => $self->{state},
-            'directives'  => \$self->{directives},
-            'h|help|?'    => \$self->{show_help},
-            'H|man'       => \$self->{show_man},
-            'V|version'   => \$self->{show_version},
-            'a|archive=s' => \$self->{archive},
-            'j|jobs=i'    => \$self->{jobs},
-            'timer'       => \$self->{timer},
-            'T'           => \$self->{taint_fail},
-            't'           => \$self->{taint_warn},
-            'W'           => \$self->{warnings_fail},
-            'w'           => \$self->{warnings_warn},
-            'normalize'   => \$self->{normalize},
-            'rules=s@'    => $self->{rules},
+            'v|verbose'  => \$self->{verbose},
+            'f|failures' => \$self->{failures},
+            'o|comments' => \$self->{comments},
+            'l|lib'      => \$self->{lib},
+            'b|blib'     => \$self->{blib},
+            's|shuffle'  => \$self->{shuffle},
+            'color!'     => \$self->{color},
+            'colour!'    => \$self->{color},
+            'count!'     => \$self->{show_count},
+            'c'          => \$self->{color},
+            'D|dry'      => \$self->{dry},
+            'ext=s@'     => sub {
+                my ( $opt, $val ) = @_;
+                # Workaround for Getopt::Long 2.25 handling of
+                # multivalue options
+                push @{ $self->{extensions} ||= [] }, $val;
+            },
+            'harness=s'    => \$self->{harness},
+            'ignore-exit'  => \$self->{ignore_exit},
+            'source=s@'    => $self->{sources},
+            'formatter=s'  => \$self->{formatter},
+            'r|recurse'    => \$self->{recurse},
+            'reverse'      => \$self->{backwards},
+            'p|parse'      => \$self->{parse},
+            'q|quiet'      => \$self->{quiet},
+            'Q|QUIET'      => \$self->{really_quiet},
+            'e|exec=s'     => \$self->{exec},
+            'm|merge'      => \$self->{merge},
+            'I=s@'         => $self->{includes},
+            'M=s@'         => $self->{modules},
+            'P=s@'         => $self->{plugins},
+            'state=s@'     => $self->{state},
+            'directives'   => \$self->{directives},
+            'h|help|?'     => \$self->{show_help},
+            'H|man'        => \$self->{show_man},
+            'V|version'    => \$self->{show_version},
+            'a|archive=s'  => \$self->{archive},
+            'j|jobs=i'     => \$self->{jobs},
+            'timer'        => \$self->{timer},
+            'T'            => \$self->{taint_fail},
+            't'            => \$self->{taint_warn},
+            'W'            => \$self->{warnings_fail},
+            'w'            => \$self->{warnings_warn},
+            'normalize'    => \$self->{normalize},
+            'rules=s@'     => $self->{rules},
+            'tapversion=s' => \$self->{tapversion},
+            'trap'         => \$self->{trap},
         ) or croak('Unable to continue');
 
         # Stash the remainder of argv for later
@@ -283,6 +295,8 @@ sub _get_args {
 
     my %args;
 
+    $args{trap} = 1 if $self->trap;
+
     if ( defined $self->color ? $self->color : $self->_color_default ) {
         $args{color} = 1;
     }
@@ -310,6 +324,11 @@ sub _get_args {
         $args{formatter_class} = $formatter;
     }
 
+    for my $handler ( @{ $self->sources } ) {
+        my ( $name, $config ) = $self->_parse_source($handler);
+        $args{sources}->{$name} = $config;
+    }
+
     if ( $self->ignore_exit ) {
         $args{ignore_exit} = 1;
     }
@@ -349,6 +368,8 @@ sub _get_args {
     $args{exec} = [ split( /\s+/, $self->exec ) ]
       if ( defined( $self->exec ) );
 
+    $args{version} = $self->tapversion if defined( $self->tapversion );
+
     if ( defined( my $test_args = $self->test_args ) ) {
         $args{test_args} = $test_args;
     }
@@ -411,6 +432,42 @@ sub _load_extensions {
     $self->_load_extension( $_, @search ) for @$ext;
 }
 
+sub _parse_source {
+    my ( $self, $handler ) = @_;
+
+    # Load any options.
+    ( my $opt_name = lc $handler ) =~ s/::/-/g;
+    local @ARGV = @{ $self->{argv} };
+    my %config;
+    Getopt::Long::GetOptions(
+        "$opt_name-option=s%" => sub {
+            my ( $name, $k, $v ) = @_;
+            if ( $v =~ /(?<!\\)=/ ) {
+
+                # It's a hash option.
+                croak "Option $name must be consistently used as a hash"
+                  if exists $config{$k} && ref $config{$k} ne 'HASH';
+                $config{$k} ||= {};
+                my ( $hk, $hv ) = split /(?<!\\)=/, $v, 2;
+                $config{$k}{$hk} = $hv;
+            }
+            else {
+                $v =~ s/\\=/=/g;
+                if ( exists $config{$k} ) {
+                    $config{$k} = [ $config{$k} ]
+                      unless ref $config{$k} eq 'ARRAY';
+                    push @{ $config{$k} } => $v;
+                }
+                else {
+                    $config{$k} = $v;
+                }
+            }
+        }
+    );
+    $self->{argv} = \@ARGV;
+    return ( $handler, \%config );
+}
+
 =head3 C<run>
 
 Perform whatever actions the command line args specified. The C<prove>
@@ -461,8 +518,8 @@ sub _get_tests {
     my $self = shift;
 
     my $state = $self->state_manager;
-    my $ext   = $self->extension;
-    $state->extension($ext) if defined $ext;
+    my $ext   = $self->extensions;
+    $state->extensions($ext) if defined $ext;
     if ( defined( my $state_switch = $self->state ) ) {
         $state->apply_switch(@$state_switch);
     }
@@ -624,7 +681,7 @@ calling C<run>.
 
 =item C<exec>
 
-=item C<extension>
+=item C<extensions>
 
 =item C<failures>
 
@@ -686,6 +743,10 @@ calling C<run>.
 
 =item C<warnings_warn>
 
+=item C<tapversion>
+
+=item C<trap>
+
 =back
 
 =head1 PLUGINS
diff --git a/Master/tlpkg/tlperl/lib/App/Prove/State.pm b/Master/tlpkg/tlperl/lib/App/Prove/State.pm
index 202f7aadd3b..91275b0cddd 100644
--- a/Master/tlpkg/tlperl/lib/App/Prove/State.pm
+++ b/Master/tlpkg/tlperl/lib/App/Prove/State.pm
@@ -26,11 +26,11 @@ App::Prove::State - State storage for the C<prove> command.
 
 =head1 VERSION
 
-Version 3.17
+Version 3.23
 
 =cut
 
-$VERSION = '3.17';
+$VERSION = '3.23';
 
 =head1 DESCRIPTION
 
@@ -59,9 +59,9 @@ Accepts a hashref with the following key/value pairs:
 
 The filename of the data store holding the data that App::Prove::State reads.
 
-=item * C<extension> (optional)
+=item * C<extensions> (optional)
 
-The test name extension.  Defaults to C<.t>.
+The test name extensions.  Defaults to C<.t>.
 
 =item * C<result_class> (optional)
 
@@ -77,12 +77,11 @@ sub new {
     my %args = %{ shift || {} };
 
     my $self = bless {
-        select    => [],
-        seq       => 1,
-        store     => delete $args{store},
-        extension => ( delete $args{extension} || '.t' ),
-        result_class =>
-          ( delete $args{result_class} || 'App::Prove::State::Result' ),
+        select       => [],
+        seq          => 1,
+        store        => delete $args{store},
+        extensions   => ( delete $args{extensions} || ['.t'] ),
+        result_class => ( delete $args{result_class} || 'App::Prove::State::Result' ),
     }, $class;
 
     $self->{_} = $self->result_class->new(
@@ -105,17 +104,17 @@ identical interface.
 
 =cut
 
-=head2 C<extension>
+=head2 C<extensions>
 
-Get or set the extension files must have in order to be considered
-tests. Defaults to '.t'.
+Get or set the list of extensions that files must have in order to be
+considered tests. Defaults to ['.t'].
 
 =cut
 
-sub extension {
+sub extensions {
     my $self = shift;
-    $self->{extension} = shift if @_;
-    return $self->{extension};
+    $self->{extensions} = shift if @_;
+    return $self->{extensions};
 }
 
 =head2 C<results>
@@ -356,7 +355,7 @@ sub _get_raw_tests {
 
     # Do globbing on Win32.
     @argv = map { glob "$_" } @argv if NEED_GLOB;
-    my $extension = $self->{extension};
+    my $extensions = $self->{extensions};
 
     for my $arg (@argv) {
         if ( '-' eq $arg ) {
@@ -368,23 +367,25 @@ sub _get_raw_tests {
         push @tests,
             sort -d $arg
           ? $recurse
-              ? $self->_expand_dir_recursive( $arg, $extension )
-              : glob( File::Spec->catfile( $arg, "*$extension" ) )
+              ? $self->_expand_dir_recursive( $arg, $extensions )
+              : map { glob( File::Spec->catfile( $arg, "*$_" ) ) } @{$extensions}
           : $arg;
     }
     return @tests;
 }
 
 sub _expand_dir_recursive {
-    my ( $self, $dir, $extension ) = @_;
+    my ( $self, $dir, $extensions ) = @_;
 
     my @tests;
+    my $ext_string = join( '|', map { quotemeta } @{$extensions} );
+
     find(
         {   follow      => 1,      #21938
             follow_skip => 2,
             wanted      => sub {
-                -f 
-                  && /\Q$extension\E$/
+                -f
+                  && /(?:$ext_string)$/
                   && push @tests => $File::Find::name;
               }
         },
diff --git a/Master/tlpkg/tlperl/lib/App/Prove/State/Result.pm b/Master/tlpkg/tlperl/lib/App/Prove/State/Result.pm
index 274676a62f9..6fb3aa8a094 100644
--- a/Master/tlpkg/tlperl/lib/App/Prove/State/Result.pm
+++ b/Master/tlpkg/tlperl/lib/App/Prove/State/Result.pm
@@ -14,11 +14,11 @@ App::Prove::State::Result - Individual test suite results.
 
 =head1 VERSION
 
-Version 3.17
+Version 3.23
 
 =cut
 
-$VERSION = '3.17';
+$VERSION = '3.23';
 
 =head1 DESCRIPTION
 
@@ -223,7 +223,7 @@ sub raw {
     my %raw  = %$self;
 
     my %tests;
-    foreach my $test ( $self->tests ) {
+    for my $test ( $self->tests ) {
         $tests{ $test->name } = $test->raw;
     }
     $raw{tests} = \%tests;
diff --git a/Master/tlpkg/tlperl/lib/App/Prove/State/Result/Test.pm b/Master/tlpkg/tlperl/lib/App/Prove/State/Result/Test.pm
index 231f78919e2..9aa3153a360 100644
--- a/Master/tlpkg/tlperl/lib/App/Prove/State/Result/Test.pm
+++ b/Master/tlpkg/tlperl/lib/App/Prove/State/Result/Test.pm
@@ -10,11 +10,11 @@ App::Prove::State::Result::Test - Individual test results.
 
 =head1 VERSION
 
-Version 3.17
+Version 3.23
 
 =cut
 
-$VERSION = '3.17';
+$VERSION = '3.23';
 
 =head1 DESCRIPTION