Update Scalar-List-Utils to 1.56

[Delta]

1.56 -- 2021-03-30
    * Added `List::Util::zip`, `List::Util::mesh` and related functions
      (RT129479)
    * Updated embedded ppport.h for Devel::PPPort v3.62

9 files changed, 259 insertions, 21 deletions

diff --git a/cpan/Scalar-List-Utils/ListUtil.xs b/cpan/Scalar-List-Utils/ListUtil.xs
index 5bccc88444..2ce9085569 100644
--- a/cpan/Scalar-List-Utils/ListUtil.xs
+++ b/cpan/Scalar-List-Utils/ListUtil.xs
@@ -28,7 +28,7 @@
 
 #if defined(USE_LONG_DOUBLE) && LDBL_MANT_DIG == 106
 #  define NV_IS_DOUBLEDOUBLE
-#endif  
+#endif
 
 #ifndef PERL_VERSION_DECIMAL
 #  define PERL_VERSION_DECIMAL(r,v,s) (r*1000000 + v*1000 + s)
@@ -88,7 +88,7 @@
 #define sv_catpvn_flags(b,n,l,f) sv_catpvn(b,n,l)
 #endif
 
-#if !PERL_VERSION_GE(5,8,0)
+#if !PERL_VERSION_GE(5,8,3)
 static NV Perl_ceil(NV nv) {
     return -Perl_floor(-nv);
 }
@@ -138,10 +138,6 @@ my_sv_copypv(pTHX_ SV *const dsv, SV *const ssv)
 #  define PERL_HAS_BAD_MULTICALL_REFCOUNT
 #endif
 
-#if PERL_VERSION < 14
-#  define croak_no_modify() croak("%s", PL_no_modify)
-#endif
-
 #ifndef SvNV_nomg
 #  define SvNV_nomg SvNV
 #endif
@@ -244,6 +240,15 @@ static double MY_callrand(pTHX_ CV *randcv)
     return ret;
 }
 
+enum {
+    ZIP_SHORTEST = 1,
+    ZIP_LONGEST  = 2,
+
+    ZIP_MESH          = 4,
+    ZIP_MESH_LONGEST  = ZIP_MESH|ZIP_LONGEST,
+    ZIP_MESH_SHORTEST = ZIP_MESH|ZIP_SHORTEST,
+};
+
 MODULE=List::Util       PACKAGE=List::Util
 
 void
@@ -1449,7 +1454,7 @@ CODE:
 #endif
         }
 #if NVSIZE > IVSIZE                          /* $Config{nvsize} > $Config{ivsize} */
-        /* Avoid altering arg's flags */ 
+        /* Avoid altering arg's flags */
         if(SvUOK(arg))      nv_arg = (NV)SvUV(arg);
         else if(SvIOK(arg)) nv_arg = (NV)SvIV(arg);
         else                nv_arg = SvNV(arg);
@@ -1474,9 +1479,9 @@ CODE:
              * that are allocated but never used. (It is only the 10-byte      *
              * extended precision long double that allocates bytes that are    *
              * never used. For all other NV types ACTUAL_NVSIZE == sizeof(NV). */
-            sv_setpvn(keysv, (char *) &nv_arg, ACTUAL_NVSIZE);  
+            sv_setpvn(keysv, (char *) &nv_arg, ACTUAL_NVSIZE);
         }
-#else                                    /* $Config{nvsize} == $Config{ivsize} == 8 */ 
+#else                                    /* $Config{nvsize} == $Config{ivsize} == 8 */
         if( SvIOK(arg) || !SvOK(arg) ) {
 
             /* It doesn't matter if SvUOK(arg) is TRUE */
@@ -1506,7 +1511,7 @@ CODE:
                  * Then subtract 1 so that all of the ("allowed") bits below the set bit *
                  * are 1 && all other ("disallowed") bits are set to 0.                  *
                  * (If the value prior to subtraction was 0, then subtracting 1 will set *
-                 * all bits - which is also fine.)                                       */ 
+                 * all bits - which is also fine.)                                       */
                 UV valid_bits = (lowest_set << 53) - 1;
 
                 /* The value of arg can be exactly represented by a double unless one    *
@@ -1515,9 +1520,9 @@ CODE:
                  * by -1 prior to performing that '&' operation - so multiply iv by sign.*/
                 if( !((iv * sign) & (~valid_bits)) ) {
                     /* Avoid altering arg's flags */
-                    nv_arg = uok ? (NV)SvUV(arg) : (NV)SvIV(arg); 
+                    nv_arg = uok ? (NV)SvUV(arg) : (NV)SvIV(arg);
                     sv_setpvn(keysv, (char *) &nv_arg, 8);
-                }          
+                }
                 else {
                     /* Read in the bytes, rather than the numeric value of the IV/UV as  *
                      * this is more efficient, despite having to sv_catpvn an extra byte.*/
@@ -1565,6 +1570,99 @@ CODE:
         ST(0) = sv_2mortal(newSViv(retcount));
 }
 
+void
+zip(...)
+ALIAS:
+    zip_longest   = ZIP_LONGEST
+    zip_shortest  = ZIP_SHORTEST
+    mesh          = ZIP_MESH
+    mesh_longest  = ZIP_MESH_LONGEST
+    mesh_shortest = ZIP_MESH_SHORTEST
+PPCODE:
+    UV nlists = items; /* number of lists */
+    AV **lists;        /* inbound lists */
+    UV len = 0;        /* length of longest inbound list = length of result */
+    UV i;
+    bool is_mesh = (ix & ZIP_MESH);
+    ix &= ~ZIP_MESH;
+
+    if(!nlists)
+        XSRETURN(0);
+
+    Newx(lists, nlists, AV *);
+    SAVEFREEPV(lists);
+
+    /* TODO: This may or maynot work on objects with arrayification overload */
+    /* Remember to unit test it */
+
+    for(i = 0; i < nlists; i++) {
+        SV *arg = ST(i);
+        AV *av;
+
+        if(!SvROK(arg) || SvTYPE(SvRV(arg)) != SVt_PVAV)
+            croak("Expected an ARRAY reference to zip");
+        av = lists[i] = (AV *)SvRV(arg);
+
+        if(!i) {
+            len = av_count(av);
+            continue;
+        }
+
+        switch(ix) {
+            case 0: /* zip is alias to zip_longest */
+            case ZIP_LONGEST:
+                if(av_count(av) > len)
+                    len = av_count(av);
+                break;
+
+            case ZIP_SHORTEST:
+                if(av_count(av) < len)
+                    len = av_count(av);
+                break;
+        }
+    }
+
+    if(is_mesh) {
+        UV retcount = len * nlists;
+
+        EXTEND(SP, retcount);
+
+        for(i = 0; i < len; i++) {
+            UV listi;
+
+            for(listi = 0; listi < nlists; listi++) {
+                SV *item = (i < av_count(lists[listi])) ?
+                    AvARRAY(lists[listi])[i] :
+                    &PL_sv_undef;
+
+                mPUSHs(SvREFCNT_inc(item));
+            }
+        }
+
+        XSRETURN(retcount);
+    }
+    else {
+        EXTEND(SP, len);
+
+        for(i = 0; i < len; i++) {
+            UV listi;
+            AV *ret = newAV();
+            av_extend(ret, nlists);
+
+            for(listi = 0; listi < nlists; listi++) {
+                SV *item = (i < av_count(lists[listi])) ?
+                    AvARRAY(lists[listi])[i] :
+                    &PL_sv_undef;
+
+                av_push(ret, SvREFCNT_inc(item));
+            }
+
+            mPUSHs(newRV_noinc((SV *)ret));
+        }
+
+        XSRETURN(len);
+    }
+
 MODULE=List::Util       PACKAGE=Scalar::Util
 
 void
diff --git a/cpan/Scalar-List-Utils/lib/List/Util.pm b/cpan/Scalar-List-Utils/lib/List/Util.pm
index e582d60874..dad5357f43 100644
--- a/cpan/Scalar-List-Utils/lib/List/Util.pm
+++ b/cpan/Scalar-List-Utils/lib/List/Util.pm
@@ -13,10 +13,10 @@ require Exporter;
 our @ISA        = qw(Exporter);
 our @EXPORT_OK  = qw(
   all any first min max minstr maxstr none notall product reduce reductions sum sum0
-  sample shuffle uniq uniqint uniqnum uniqstr
+  sample shuffle uniq uniqint uniqnum uniqstr zip zip_longest zip_shortest mesh mesh_longest mesh_shortest
   head tail pairs unpairs pairkeys pairvalues pairmap pairgrep pairfirst
 );
-our $VERSION    = "1.55";
+our $VERSION    = "1.56";
 our $XS_VERSION = $VERSION;
 $VERSION =~ tr/_//d;
 
@@ -57,7 +57,7 @@ List::Util - A selection of general-utility list subroutines
 
       pairs unpairs pairkeys pairvalues pairfirst pairgrep pairmap
 
-      shuffle uniq uniqint uniqnum uniqstr
+      shuffle uniq uniqint uniqnum uniqstr zip mesh
     );
 
 =head1 DESCRIPTION
@@ -653,6 +653,83 @@ all but the first C<$size> elements from C<@list>.
     @result = tail -2, qw( foo bar baz );
     # baz
 
+=head2 zip
+
+    my @result = zip [1..3], ['a'..'c'];
+    # [1, 'a'], [2, 'b'], [3, 'c']
+
+I<Since version 1.56.>
+
+Returns a list of array references, composed of elements from the given list
+of array references. Each array in the returned list is composed of elements
+at that corresponding position from each of the given input arrays. If any
+input arrays run out of elements before others, then C<undef> will be inserted
+into the result to fill in the gaps.
+
+The C<zip> function is particularly handy for iterating over multiple arrays
+at the same time with a C<foreach> loop, taking one element from each:
+
+    foreach ( zip \@xs, \@ys, \@zs ) {
+        my ($x, $y, $z) = @$_;
+        ...
+    }
+
+B<NOTE> to users of L<List::MoreUtils>: This function does not behave the same
+as C<List::MoreUtils::zip>, but is actually a non-prototyped equivalent to
+C<List::MoreUtils::zip_unflatten>. This function does not apply a prototype,
+so make sure to invoke it with references to arrays.
+
+For a function similar to the C<zip> function from C<List::MoreUtils>, see
+L<mesh>.
+
+    my @result = zip_shortest ...
+
+A variation of the function that differs in how it behaves when given input
+arrays of differing lengths. C<zip_shortest> will stop as soon as any one of
+the input arrays run out of elements, discarding any remaining unused values
+from the others.
+
+    my @result = zip_longest ...
+
+C<zip_longest> is an alias to the C<zip> function, provided simply to be
+explicit about that behaviour as compared to C<zip_shortest>.
+
+=head2 mesh
+
+    my @result = mesh [1..3], ['a'..'c'];
+    # (1, 'a', 2, 'b', 3, 'c')
+
+I<Since version 1.56.>
+
+Returns a list of items collected from elements of the given list of array
+references. Each section of items in the returned list is composed of elements
+at the corresponding position from each of the given input arrays. If any
+input arrays run out of elements before others, then C<undef> will be inserted
+into the result to fill in the gaps.
+
+This is similar to L<zip>, except that all of the ranges in the result are
+returned in one long flattened list, instead of being bundled into separate
+arrays.
+
+Because it returns a flat list of items, the C<mesh> function is particularly
+useful for building a hash out of two separate arrays of keys and values:
+
+    my %hash = mesh \@keys, \@values;
+
+    my $href = { mesh \@keys, \@values };
+
+B<NOTE> to users of L<List::MoreUtils>: This function is a non-prototyped
+equivalent to C<List::MoreUtils::mesh> or C<List::MoreUtils::zip> (themselves
+aliases of each other). This function does not apply a prototype, so make sure
+to invoke it with references to arrays.
+
+    my @result = mesh_shortest ...
+
+    my @result = mesh_longest ...
+
+These variations are similar to those of L<zip>, in that they differ in
+behaviour when one of the input lists runs out of elements before the others.
+
 =head1 CONFIGURATION VARIABLES
 
 =head2 $RAND
diff --git a/cpan/Scalar-List-Utils/lib/List/Util/XS.pm b/cpan/Scalar-List-Utils/lib/List/Util/XS.pm
index 88f663f0ec..70d33131cc 100644
--- a/cpan/Scalar-List-Utils/lib/List/Util/XS.pm
+++ b/cpan/Scalar-List-Utils/lib/List/Util/XS.pm
@@ -3,7 +3,7 @@ use strict;
 use warnings;
 use List::Util;
 
-our $VERSION = "1.55";       # FIXUP
+our $VERSION = "1.56";       # FIXUP
 $VERSION =~ tr/_//d;         # FIXUP
 
 1;
diff --git a/cpan/Scalar-List-Utils/lib/Scalar/Util.pm b/cpan/Scalar-List-Utils/lib/Scalar/Util.pm
index a7345aad78..de3e892298 100644
--- a/cpan/Scalar-List-Utils/lib/Scalar/Util.pm
+++ b/cpan/Scalar-List-Utils/lib/Scalar/Util.pm
@@ -17,7 +17,7 @@ our @EXPORT_OK = qw(
   dualvar isdual isvstring looks_like_number openhandle readonly set_prototype
   tainted
 );
-our $VERSION    = "1.55";
+our $VERSION    = "1.56";
 $VERSION =~ tr/_//d;
 
 require List::Util; # List::Util loads the XS
diff --git a/cpan/Scalar-List-Utils/lib/Sub/Util.pm b/cpan/Scalar-List-Utils/lib/Sub/Util.pm
index d7b59aebab..1eee0ded41 100644
--- a/cpan/Scalar-List-Utils/lib/Sub/Util.pm
+++ b/cpan/Scalar-List-Utils/lib/Sub/Util.pm
@@ -15,7 +15,7 @@ our @EXPORT_OK = qw(
   subname set_subname
 );
 
-our $VERSION    = "1.55";
+our $VERSION    = "1.56";
 $VERSION =~ tr/_//d;
 
 require List::Util; # as it has the XS
diff --git a/cpan/Scalar-List-Utils/t/mesh.t b/cpan/Scalar-List-Utils/t/mesh.t
new file mode 100644
index 0000000000..957e028262
--- /dev/null
+++ b/cpan/Scalar-List-Utils/t/mesh.t
@@ -0,0 +1,31 @@
+#!./perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 7;
+use List::Util qw(mesh mesh_longest mesh_shortest);
+
+is_deeply( [mesh ()], [],
+  'mesh empty returns empty');
+
+is_deeply( [mesh ['a'..'c']], [ 'a', 'b', 'c' ],
+  'mesh of one list returns the list' );
+
+is_deeply( [mesh ['one', 'two'], [1, 2]], [ one => 1, two => 2 ],
+  'mesh of two lists returns a list of two pairs' );
+
+# Unequal length arrays
+
+is_deeply( [mesh_longest ['x', 'y', 'z'], ['X', 'Y']], [ 'x', 'X', 'y', 'Y', 'z', undef ],
+  'mesh_longest extends short lists with undef' );
+
+is_deeply( [mesh_shortest ['x', 'y', 'z'], ['X', 'Y']], [ 'x', 'X', 'y', 'Y' ],
+  'mesh_shortest stops after shortest list' );
+
+# Non arrayref arguments throw exception
+ok( !defined eval { mesh 1, 2, 3 },
+  'non-reference argument throws exception' );
+
+ok( !defined eval { mesh +{ one => 1 } },
+  'reference to non array throws exception' );
diff --git a/cpan/Scalar-List-Utils/t/uniq.t b/cpan/Scalar-List-Utils/t/uniq.t
index c55f03a638..d296aa8d57 100644
--- a/cpan/Scalar-List-Utils/t/uniq.t
+++ b/cpan/Scalar-List-Utils/t/uniq.t
@@ -158,7 +158,8 @@ SKIP: {
     package Googol;
 
     use overload '""' => sub { "1" . ( "0"x100 ) },
-                 'int' => sub { $_[0] };
+                 'int' => sub { $_[0] },
+                 fallback => 1;
 
     sub new { bless {}, $_[0] }
 
diff --git a/cpan/Scalar-List-Utils/t/uniqnum.t b/cpan/Scalar-List-Utils/t/uniqnum.t
index d34d2c7747..cfe132ac18 100644
--- a/cpan/Scalar-List-Utils/t/uniqnum.t
+++ b/cpan/Scalar-List-Utils/t/uniqnum.t
@@ -130,7 +130,7 @@ if( $Config{ivsize} == 8 ) {
 }
 
 # Populate @in with UV-NV pairs of equivalent values.
-# Each of these values is exactly representable as 
+# Each of these values is exactly representable as
 # either a UV or an NV.
 
 my @in = (1 << $ls, 2 ** $ls,
@@ -181,7 +181,7 @@ if( $Config{ivsize} == 8 && $Config{nvsize} == 8 ) {
 }
 
 # uniqnum should discard each of the NVs as being a
-# duplicate of the preceding UV. 
+# duplicate of the preceding UV.
 
 is_deeply( [ uniqnum @in],
            [ @correct],
diff --git a/cpan/Scalar-List-Utils/t/zip.t b/cpan/Scalar-List-Utils/t/zip.t
new file mode 100644
index 0000000000..f103d39737
--- /dev/null
+++ b/cpan/Scalar-List-Utils/t/zip.t
@@ -0,0 +1,31 @@
+#!./perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 7;
+use List::Util qw(zip zip_longest zip_shortest);
+
+is_deeply( [zip ()], [],
+  'zip empty returns empty');
+
+is_deeply( [zip ['a'..'c']], [ ['a'], ['b'], ['c'] ],
+  'zip of one list returns a list of singleton lists' );
+
+is_deeply( [zip ['one', 'two'], [1, 2]], [ [one => 1], [two => 2] ],
+  'zip of two lists returns a list of pair lists' );
+
+# Unequal length arrays
+
+is_deeply( [zip_longest ['x', 'y', 'z'], ['X', 'Y']], [ ['x', 'X'], ['y', 'Y'], ['z', undef] ],
+  'zip_longest extends short lists with undef' );
+
+is_deeply( [zip_shortest ['x', 'y', 'z'], ['X', 'Y']], [ ['x', 'X'], ['y', 'Y'] ],
+  'zip_shortest stops after shortest list' );
+
+# Non arrayref arguments throw exception
+ok( !defined eval { zip 1, 2, 3 },
+  'non-reference argument throws exception' );
+
+ok( !defined eval { zip +{ one => 1 } },
+  'reference to non array throws exception' );