Skip to content

Commit

Permalink
Update Scalar-List-Utils to 1.56
Browse files Browse the repository at this point in the history
  • Loading branch information
Max Maischein committed May 22, 2021
1 parent aa467bd commit 9cc5c43
Show file tree
Hide file tree
Showing 11 changed files with 262 additions and 22 deletions.
2 changes: 2 additions & 0 deletions MANIFEST
Expand Up @@ -1975,6 +1975,7 @@ cpan/Scalar-List-Utils/t/isvstring.t Scalar::Util
cpan/Scalar-List-Utils/t/lln.t Scalar::Util
cpan/Scalar-List-Utils/t/max.t List::Util
cpan/Scalar-List-Utils/t/maxstr.t List::Util
cpan/Scalar-List-Utils/t/mesh.t
cpan/Scalar-List-Utils/t/min.t List::Util
cpan/Scalar-List-Utils/t/minstr.t List::Util
cpan/Scalar-List-Utils/t/openhan.t Scalar::Util
Expand All @@ -1998,6 +1999,7 @@ cpan/Scalar-List-Utils/t/tainted.t Scalar::Util
cpan/Scalar-List-Utils/t/uniq.t Scalar::Util
cpan/Scalar-List-Utils/t/uniqnum.t
cpan/Scalar-List-Utils/t/weak.t Scalar::Util
cpan/Scalar-List-Utils/t/zip.t
cpan/Socket/Makefile.PL Socket extension makefile writer
cpan/Socket/Socket.pm Socket extension Perl module
cpan/Socket/Socket.xs Socket extension external subroutines
Expand Down
2 changes: 1 addition & 1 deletion Porting/Maintainers.pl
Expand Up @@ -978,7 +978,7 @@ package Maintainers;
},

'Scalar::Util' => {
'DISTRIBUTION' => 'PEVANS/Scalar-List-Utils-1.55.tar.gz',
'DISTRIBUTION' => 'PEVANS/Scalar-List-Utils-1.56.tar.gz',
'FILES' => q[cpan/Scalar-List-Utils],
},

Expand Down
122 changes: 110 additions & 12 deletions cpan/Scalar-List-Utils/ListUtil.xs
Expand Up @@ -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)
Expand Down Expand Up @@ -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);
}
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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);
Expand All @@ -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 */
Expand Down Expand Up @@ -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 *
Expand All @@ -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.*/
Expand Down Expand Up @@ -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
Expand Down
83 changes: 80 additions & 3 deletions cpan/Scalar-List-Utils/lib/List/Util.pm
Expand Up @@ -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;

Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion cpan/Scalar-List-Utils/lib/List/Util/XS.pm
Expand Up @@ -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;
Expand Down
2 changes: 1 addition & 1 deletion cpan/Scalar-List-Utils/lib/Scalar/Util.pm
Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion cpan/Scalar-List-Utils/lib/Sub/Util.pm
Expand Up @@ -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
Expand Down
31 changes: 31 additions & 0 deletions 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' );
3 changes: 2 additions & 1 deletion cpan/Scalar-List-Utils/t/uniq.t
Expand Up @@ -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] }

Expand Down

0 comments on commit 9cc5c43

Please sign in to comment.