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 + +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 will be inserted +into the result to fill in the gaps. + +The C function is particularly handy for iterating over multiple arrays +at the same time with a C loop, taking one element from each: + + foreach ( zip \@xs, \@ys, \@zs ) { + my ($x, $y, $z) = @$_; + ... + } + +B to users of L: This function does not behave the same +as C, but is actually a non-prototyped equivalent to +C. This function does not apply a prototype, +so make sure to invoke it with references to arrays. + +For a function similar to the C function from C, see +L. + + my @result = zip_shortest ... + +A variation of the function that differs in how it behaves when given input +arrays of differing lengths. C 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 is an alias to the C function, provided simply to be +explicit about that behaviour as compared to C. + +=head2 mesh + + my @result = mesh [1..3], ['a'..'c']; + # (1, 'a', 2, 'b', 3, 'c') + +I + +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 will be inserted +into the result to fill in the gaps. + +This is similar to L, 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 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 to users of L: This function is a non-prototyped +equivalent to C or C (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, 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/getmagic-once.t b/cpan/Scalar-List-Utils/t/getmagic-once.t 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 --- 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' );