Upgrade Scalar-List-Utils from version 1.41 to 1.42

7 files changed, 254 insertions, 136 deletions

diff --git a/cpan/Scalar-List-Utils/ListUtil.xs b/cpan/Scalar-List-Utils/ListUtil.xs
index 515677f162..a7cd20caab 100644
--- a/cpan/Scalar-List-Utils/ListUtil.xs
+++ b/cpan/Scalar-List-Utils/ListUtil.xs
@@ -483,6 +483,123 @@ PPCODE:
 }
 
 void
+pairs(...)
+PROTOTYPE: @
+PPCODE:
+{
+    int argi = 0;
+    int reti = 0;
+    HV *pairstash = get_hv("List::Util::_Pair::", GV_ADD);
+
+    if(items % 2 && ckWARN(WARN_MISC))
+        warn("Odd number of elements in pairs");
+
+    {
+        for(; argi < items; argi += 2) {
+            SV *a = ST(argi);
+            SV *b = argi < items-1 ? ST(argi+1) : &PL_sv_undef;
+
+            AV *av = newAV();
+            av_push(av, newSVsv(a));
+            av_push(av, newSVsv(b));
+
+            ST(reti) = sv_2mortal(newRV_noinc((SV *)av));
+            sv_bless(ST(reti), pairstash);
+            reti++;
+        }
+    }
+
+    XSRETURN(reti);
+}
+
+void
+unpairs(...)
+PROTOTYPE: @
+PPCODE:
+{
+    /* Unlike pairs(), we're going to trash the input values on the stack
+     * almost as soon as we start generating output. So clone them first
+     */
+    int i;
+    SV **args_copy;
+    Newx(args_copy, items, SV *);
+    SAVEFREEPV(args_copy);
+
+    Copy(&ST(0), args_copy, items, SV *);
+
+    for(i = 0; i < items; i++) {
+        SV *pair = args_copy[i];
+        SvGETMAGIC(pair);
+
+        if(SvTYPE(pair) != SVt_RV)
+            croak("Not a reference at List::Util::unpack() argument %d", i);
+        if(SvTYPE(SvRV(pair)) != SVt_PVAV)
+            croak("Not an ARRAY reference at List::Util::unpack() argument %d", i);
+
+        // TODO: assert pair is an ARRAY ref
+        AV *pairav = (AV *)SvRV(pair);
+
+        EXTEND(SP, 2);
+
+        if(AvFILL(pairav) >= 0)
+            mPUSHs(newSVsv(AvARRAY(pairav)[0]));
+        else
+            PUSHs(&PL_sv_undef);
+
+        if(AvFILL(pairav) >= 1)
+            mPUSHs(newSVsv(AvARRAY(pairav)[1]));
+        else
+            PUSHs(&PL_sv_undef);
+    }
+
+    XSRETURN(items * 2);
+}
+
+void
+pairkeys(...)
+PROTOTYPE: @
+PPCODE:
+{
+    int argi = 0;
+    int reti = 0;
+
+    if(items % 2 && ckWARN(WARN_MISC))
+        warn("Odd number of elements in pairkeys");
+
+    {
+        for(; argi < items; argi += 2) {
+            SV *a = ST(argi);
+
+            ST(reti++) = sv_2mortal(newSVsv(a));
+        }
+    }
+
+    XSRETURN(reti);
+}
+
+void
+pairvalues(...)
+PROTOTYPE: @
+PPCODE:
+{
+    int argi = 0;
+    int reti = 0;
+
+    if(items % 2 && ckWARN(WARN_MISC))
+        warn("Odd number of elements in pairvalues");
+
+    {
+        for(; argi < items; argi += 2) {
+            SV *b = argi < items-1 ? ST(argi+1) : &PL_sv_undef;
+
+            ST(reti++) = sv_2mortal(newSVsv(b));
+        }
+    }
+
+    XSRETURN(reti);
+}
+
+void
 pairfirst(block,...)
     SV *block
 PROTOTYPE: &@
@@ -768,80 +885,6 @@ PPCODE:
 }
 
 void
-pairs(...)
-PROTOTYPE: @
-PPCODE:
-{
-    int argi = 0;
-    int reti = 0;
-    HV *pairstash = get_hv("List::Util::_Pair::", GV_ADD);
-
-    if(items % 2 && ckWARN(WARN_MISC))
-        warn("Odd number of elements in pairs");
-
-    {
-        for(; argi < items; argi += 2) {
-            SV *a = ST(argi);
-            SV *b = argi < items-1 ? ST(argi+1) : &PL_sv_undef;
-
-            AV *av = newAV();
-            av_push(av, newSVsv(a));
-            av_push(av, newSVsv(b));
-
-            ST(reti) = sv_2mortal(newRV_noinc((SV *)av));
-            sv_bless(ST(reti), pairstash);
-            reti++;
-        }
-    }
-
-    XSRETURN(reti);
-}
-
-void
-pairkeys(...)
-PROTOTYPE: @
-PPCODE:
-{
-    int argi = 0;
-    int reti = 0;
-
-    if(items % 2 && ckWARN(WARN_MISC))
-        warn("Odd number of elements in pairkeys");
-
-    {
-        for(; argi < items; argi += 2) {
-            SV *a = ST(argi);
-
-            ST(reti++) = sv_2mortal(newSVsv(a));
-        }
-    }
-
-    XSRETURN(reti);
-}
-
-void
-pairvalues(...)
-PROTOTYPE: @
-PPCODE:
-{
-    int argi = 0;
-    int reti = 0;
-
-    if(items % 2 && ckWARN(WARN_MISC))
-        warn("Odd number of elements in pairvalues");
-
-    {
-        for(; argi < items; argi += 2) {
-            SV *b = argi < items-1 ? ST(argi+1) : &PL_sv_undef;
-
-            ST(reti++) = sv_2mortal(newSVsv(b));
-        }
-    }
-
-    XSRETURN(reti);
-}
-
-void
 shuffle(...)
 PROTOTYPE: @
 CODE:
diff --git a/cpan/Scalar-List-Utils/lib/List/Util.pm b/cpan/Scalar-List-Utils/lib/List/Util.pm
index 837b6c89a2..735aebb666 100644
--- a/cpan/Scalar-List-Utils/lib/List/Util.pm
+++ b/cpan/Scalar-List-Utils/lib/List/Util.pm
@@ -12,9 +12,9 @@ require Exporter;
 our @ISA        = qw(Exporter);
 our @EXPORT_OK  = qw(
   all any first min max minstr maxstr none notall product reduce sum sum0 shuffle
-  pairmap pairgrep pairfirst pairs pairkeys pairvalues
+  pairs unpairs pairkeys pairvalues pairmap pairgrep pairfirst
 );
-our $VERSION    = "1.41";
+our $VERSION    = "1.42";
 our $XS_VERSION = $VERSION;
 $VERSION    = eval $VERSION;
 
@@ -254,8 +254,119 @@ or just a list of values. The functions will all preserve the original ordering
 of the pairs, and will not be confused by multiple pairs having the same "key"
 value - nor even do they require that the first of each pair be a plain string.
 
+B<NOTE>: At the time of writing, the following C<pair*> functions that take a
+block do not modify the value of C<$_> within the block, and instead operate
+using the C<$a> and C<$b> globals instead. This has turned out to be a poor
+design, as it precludes the ability to provide a C<pairsort> function. Better
+would be to pass pair-like objects as 2-element array references in C<$_>, in
+a style similar to the return value of the C<pairs> function. At some future
+version this behaviour may be added.
+
+Until then, users are alerted B<NOT> to rely on the value of C<$_> remaining
+unmodified between the outside and the inside of the control block. In
+particular, the following example is B<UNSAFE>:
+
+ my @kvlist = ...
+
+ foreach (qw( some keys here )) {
+    my @items = pairgrep { $a eq $_ } @kvlist;
+    ...
+ }
+
+Instead, write this using a lexical variable:
+
+ foreach my $key (qw( some keys here )) {
+    my @items = pairgrep { $a eq $key } @kvlist;
+    ...
+ }
+
 =cut
 
+=head2 pairs
+
+    my @pairs = pairs @kvlist;
+
+I<Since version 1.29.>
+
+A convenient shortcut to operating on even-sized lists of pairs, this function
+returns a list of ARRAY references, each containing two items from the given
+list. It is a more efficient version of
+
+    @pairs = pairmap { [ $a, $b ] } @kvlist
+
+It is most convenient to use in a C<foreach> loop, for example:
+
+    foreach my $pair ( pairs @KVLIST ) {
+       my ( $key, $value ) = @$pair;
+       ...
+    }
+
+Since version C<1.39> these ARRAY references are blessed objects, recognising
+the two methods C<key> and C<value>. The following code is equivalent:
+
+    foreach my $pair ( pairs @KVLIST ) {
+       my $key   = $pair->key;
+       my $value = $pair->value;
+       ...
+    }
+
+=head2 unpairs
+
+    my @kvlist = unpairs @pairs
+
+I<Since version 1.42.>
+
+The inverse function to C<pairs>; this function takes a list of ARRAY
+references containing two elements each, and returns a flattened list of the
+two values from each of the pairs, in order. This is notionally equivalent to
+
+    my @kvlist = map { @{$_}[0,1] } @pairs
+
+except that it is implemented more efficiently internally. Specifically, for
+any input item it will extract exactly two values for the output list; using
+C<undef> if the input array references are short.
+
+Between C<pairs> and C<unpairs>, a higher-order list function can be used to
+operate on the pairs as single scalars; such as the following near-equivalents
+of the other C<pair*> higher-order functions:
+
+    @kvlist = unpairs grep { FUNC } pairs @kvlist
+    # Like pairgrep, but takes $_ instead of $a and $b
+
+    @kvlist = unpairs map { FUNC } pairs @kvlist
+    # Like pairmap, but takes $_ instead of $a and $b
+
+Note however that these versions will not behave as nicely in scalar context.
+
+Finally, this technique can be used to implement a sort on a keyvalue pair
+list; e.g.:
+
+    @kvlist = unpairs sort { $a->key cmp $b->key } pairs @kvlist
+
+=head2 pairkeys
+
+    my @keys = pairkeys @kvlist;
+
+I<Since version 1.29.>
+
+A convenient shortcut to operating on even-sized lists of pairs, this function
+returns a list of the the first values of each of the pairs in the given list.
+It is a more efficient version of
+
+    @keys = pairmap { $a } @kvlist
+
+=head2 pairvalues
+
+    my @values = pairvalues @kvlist;
+
+I<Since version 1.29.>
+
+A convenient shortcut to operating on even-sized lists of pairs, this function
+returns a list of the the second values of each of the pairs in the given list.
+It is a more efficient version of
+
+    @values = pairmap { $b } @kvlist
+
 =head2 pairgrep
 
     my @kvlist = pairgrep { BLOCK } @kvlist;
@@ -329,58 +440,6 @@ will be visible to the caller.
 
 See L</KNOWN BUGS> for a known-bug with C<pairmap>, and a workaround.
 
-=head2 pairs
-
-    my @pairs = pairs @kvlist;
-
-I<Since version 1.29.>
-
-A convenient shortcut to operating on even-sized lists of pairs, this function
-returns a list of ARRAY references, each containing two items from the given
-list. It is a more efficient version of
-
-    @pairs = pairmap { [ $a, $b ] } @kvlist
-
-It is most convenient to use in a C<foreach> loop, for example:
-
-    foreach my $pair ( pairs @KVLIST ) {
-       my ( $key, $value ) = @$pair;
-       ...
-    }
-
-Since version C<1.39> these ARRAY references are blessed objects, recognising
-the two methods C<key> and C<value>. The following code is equivalent:
-
-    foreach my $pair ( pairs @KVLIST ) {
-       my $key   = $pair->key;
-       my $value = $pair->value;
-       ...
-    }
-
-=head2 pairkeys
-
-    my @keys = pairkeys @kvlist;
-
-I<Since version 1.29.>
-
-A convenient shortcut to operating on even-sized lists of pairs, this function
-returns a list of the the first values of each of the pairs in the given list.
-It is a more efficient version of
-
-    @keys = pairmap { $a } @kvlist
-
-=head2 pairvalues
-
-    my @values = pairvalues @kvlist;
-
-I<Since version 1.29.>
-
-A convenient shortcut to operating on even-sized lists of pairs, this function
-returns a list of the the second values of each of the pairs in the given list.
-It is a more efficient version of
-
-    @values = pairmap { $b } @kvlist
-
 =cut
 
 =head1 OTHER FUNCTIONS
diff --git a/cpan/Scalar-List-Utils/lib/List/Util/XS.pm b/cpan/Scalar-List-Utils/lib/List/Util/XS.pm
index f2e01ae94b..d196ce26fa 100644
--- a/cpan/Scalar-List-Utils/lib/List/Util/XS.pm
+++ b/cpan/Scalar-List-Utils/lib/List/Util/XS.pm
@@ -2,7 +2,7 @@ package List::Util::XS;
 use strict;
 use List::Util;
 
-our $VERSION = "1.41";       # FIXUP
+our $VERSION = "1.42";       # FIXUP
 $VERSION = eval $VERSION;    # FIXUP
 
 1;
diff --git a/cpan/Scalar-List-Utils/lib/Scalar/Util.pm b/cpan/Scalar-List-Utils/lib/Scalar/Util.pm
index 3f17d13b83..8ac705edfe 100644
--- a/cpan/Scalar-List-Utils/lib/Scalar/Util.pm
+++ b/cpan/Scalar-List-Utils/lib/Scalar/Util.pm
@@ -8,7 +8,6 @@ package Scalar::Util;
 
 use strict;
 require Exporter;
-require List::Util; # List::Util loads the XS
 
 our @ISA       = qw(Exporter);
 our @EXPORT_OK = qw(
@@ -17,9 +16,12 @@ our @EXPORT_OK = qw(
   dualvar isdual isvstring looks_like_number openhandle readonly set_prototype
   tainted
 );
-our $VERSION    = "1.41";
+our $VERSION    = "1.42";
 $VERSION   = eval $VERSION;
 
+require List::Util; # List::Util loads the XS
+List::Util->VERSION( $VERSION ); # Ensure we got the right XS version (RT#100863)
+
 our @EXPORT_FAIL;
 
 unless (defined &weaken) {
diff --git a/cpan/Scalar-List-Utils/lib/Sub/Util.pm b/cpan/Scalar-List-Utils/lib/Sub/Util.pm
index e40cf2205e..a276d952f9 100644
--- a/cpan/Scalar-List-Utils/lib/Sub/Util.pm
+++ b/cpan/Scalar-List-Utils/lib/Sub/Util.pm
@@ -8,7 +8,6 @@ use strict;
 use warnings;
 
 require Exporter;
-require List::Util; # as it has the XS
 
 our @ISA = qw( Exporter );
 our @EXPORT_OK = qw(
@@ -16,9 +15,12 @@ our @EXPORT_OK = qw(
   subname set_subname
 );
 
-our $VERSION    = "1.41";
+our $VERSION    = "1.42";
 $VERSION   = eval $VERSION;
 
+require List::Util; # as it has the XS
+List::Util->VERSION( $VERSION ); # Ensure we got the right XS version (RT#100863)
+
 =head1 NAME
 
 Sub::Util - A selection of utility subroutines for subs and CODE references
diff --git a/cpan/Scalar-List-Utils/t/pair.t b/cpan/Scalar-List-Utils/t/pair.t
index fab05dd158..81acf06594 100644
--- a/cpan/Scalar-List-Utils/t/pair.t
+++ b/cpan/Scalar-List-Utils/t/pair.t
@@ -3,8 +3,8 @@
 use strict;
 use warnings;
 
-use Test::More tests => 23;
-use List::Util qw(pairgrep pairfirst pairmap pairs pairkeys pairvalues);
+use Test::More tests => 26;
+use List::Util qw(pairgrep pairfirst pairmap pairs unpairs pairkeys pairvalues);
 
 no warnings 'misc'; # avoid "Odd number of elements" warnings most of the time
 
@@ -96,6 +96,18 @@ is_deeply( [ pairs one => 1, two => ],
   is( $p[0]->value, 1,     'pairs ->value' );
 }
 
+is_deeply( [ unpairs [ four => 4 ], [ five => 5 ], [ six => 6 ] ],
+           [ four => 4, five => 5, six => 6 ],
+           'unpairs' );
+
+is_deeply( [ unpairs [ four => 4 ], [ five => ] ],
+           [ four => 4, five => undef ],
+           'unpairs with short item fills in undef' );
+
+is_deeply( [ unpairs [ four => 4 ], [ five => 5, 5 ] ],
+           [ four => 4, five => 5 ],
+           'unpairs with long item truncates' );
+
 is_deeply( [ pairkeys one => 1, two => 2 ],
            [qw( one two )],
            'pairkeys' );
diff --git a/cpan/Scalar-List-Utils/t/refaddr.t b/cpan/Scalar-List-Utils/t/refaddr.t
index c208943fcf..8d7c441bb3 100644
--- a/cpan/Scalar-List-Utils/t/refaddr.t
+++ b/cpan/Scalar-List-Utils/t/refaddr.t
@@ -21,7 +21,7 @@ my $t;
 foreach my $r ({}, \$t, [], \*F, sub {}) {
   my $n = "$r";
   $n =~ /0x(\w+)/;
-  my $addr = do { local $^W; hex $1 };
+  my $addr = do { no warnings; hex $1 };
   my $before = ref($r);
   is( refaddr($r), $addr, $n);
   is( ref($r), $before, $n);