summaryrefslogtreecommitdiff
path: root/cpan/Scalar-List-Utils
diff options
context:
space:
mode:
authorJarkko Hietaniemi <jhi@iki.fi>2016-05-15 18:32:03 -0400
committerJarkko Hietaniemi <jhi@iki.fi>2016-05-15 18:32:03 -0400
commite8164ee76be9fe457e58508afccf20abb0cc4008 (patch)
treeb98c8dd9b731bbb4aa159d18d0da84e19d5e815b /cpan/Scalar-List-Utils
parentc7cd1ed9f82c9c90c5be7e254ba04292d7f07e73 (diff)
downloadperl-e8164ee76be9fe457e58508afccf20abb0cc4008.tar.gz
Upgrade to Scalar-List-Utils 1.45 from CPAN
Diffstat (limited to 'cpan/Scalar-List-Utils')
-rw-r--r--cpan/Scalar-List-Utils/ListUtil.xs224
-rw-r--r--cpan/Scalar-List-Utils/Makefile.PL17
-rw-r--r--cpan/Scalar-List-Utils/lib/List/Util.pm131
-rw-r--r--cpan/Scalar-List-Utils/lib/List/Util/XS.pm3
-rw-r--r--cpan/Scalar-List-Utils/lib/Scalar/Util.pm30
-rw-r--r--cpan/Scalar-List-Utils/lib/Sub/Util.pm2
-rw-r--r--cpan/Scalar-List-Utils/t/product.t38
-rw-r--r--cpan/Scalar-List-Utils/t/rt-96343.t35
-rw-r--r--cpan/Scalar-List-Utils/t/sum.t12
-rw-r--r--cpan/Scalar-List-Utils/t/uniq.t213
10 files changed, 645 insertions, 60 deletions
diff --git a/cpan/Scalar-List-Utils/ListUtil.xs b/cpan/Scalar-List-Utils/ListUtil.xs
index 04dca10eba..9b0384a152 100644
--- a/cpan/Scalar-List-Utils/ListUtil.xs
+++ b/cpan/Scalar-List-Utils/ListUtil.xs
@@ -14,6 +14,12 @@
# include "multicall.h"
#endif
+#if PERL_BCDVERSION < 0x5023008
+# define UNUSED_VAR_newsp PERL_UNUSED_VAR(newsp)
+#else
+# define UNUSED_VAR_newsp NOOP
+#endif
+
#ifndef CvISXSUB
# define CvISXSUB(cv) CvXSUB(cv)
#endif
@@ -66,6 +72,10 @@ my_sv_copypv(pTHX_ SV *const dsv, SV *const ssv)
# define croak_no_modify() croak("%s", PL_no_modify)
#endif
+#ifndef SvNV_nomg
+# define SvNV_nomg SvNV
+#endif
+
enum slu_accum {
ACC_IV,
ACC_NV,
@@ -96,7 +106,7 @@ ALIAS:
CODE:
{
int index;
- NV retval;
+ NV retval = 0.0; /* avoid 'uninit var' warning */
SV *retsv;
int magic;
@@ -212,17 +222,72 @@ CODE:
break;
case ACC_IV:
if(is_product) {
- if(retiv == 0 ||
- (!SvNOK(sv) && SvIOK(sv) && (SvIV(sv) < IV_MAX / retiv))) {
- retiv *= SvIV(sv);
- break;
+ /* TODO: Consider if product() should shortcircuit the moment its
+ * accumulator becomes zero
+ */
+ /* XXX testing flags before running get_magic may
+ * cause some valid tied values to fallback to the NV path
+ * - DAPM */
+ if(!SvNOK(sv) && SvIOK(sv)) {
+ IV i = SvIV(sv);
+ if (retiv == 0) /* avoid later division by zero */
+ break;
+ if (retiv < 0) {
+ if (i < 0) {
+ if (i >= IV_MAX / retiv) {
+ retiv *= i;
+ break;
+ }
+ }
+ else {
+ if (i <= IV_MIN / retiv) {
+ retiv *= i;
+ break;
+ }
+ }
+ }
+ else {
+ if (i < 0) {
+ if (i >= IV_MIN / retiv) {
+ retiv *= i;
+ break;
+ }
+ }
+ else {
+ if (i <= IV_MAX / retiv) {
+ retiv *= i;
+ break;
+ }
+ }
+ }
}
/* else fallthrough */
}
else {
- if(!SvNOK(sv) && SvIOK(sv) && (SvIV(sv) < IV_MAX - retiv)) {
- retiv += SvIV(sv);
- break;
+ /* XXX testing flags before running get_magic may
+ * cause some valid tied values to fallback to the NV path
+ * - DAPM */
+ if(!SvNOK(sv) && SvIOK(sv)) {
+ IV i = SvIV(sv);
+ if (retiv >= 0 && i >= 0) {
+ if (retiv <= IV_MAX - i) {
+ retiv += i;
+ break;
+ }
+ /* else fallthrough */
+ }
+ else if (retiv < 0 && i < 0) {
+ if (retiv >= IV_MIN - i) {
+ retiv += i;
+ break;
+ }
+ /* else fallthrough */
+ }
+ else {
+ /* mixed signs can't overflow */
+ retiv += i;
+ break;
+ }
}
/* else fallthrough */
}
@@ -328,6 +393,7 @@ CODE:
dMULTICALL;
I32 gimme = G_SCALAR;
+ UNUSED_VAR_newsp;
PUSH_MULTICALL(cv);
for(index = 2 ; index < items ; index++) {
GvSV(bgv) = args[index];
@@ -381,10 +447,15 @@ CODE:
if(!CvISXSUB(cv)) {
dMULTICALL;
I32 gimme = G_SCALAR;
+
+ UNUSED_VAR_newsp;
PUSH_MULTICALL(cv);
for(index = 1 ; index < items ; index++) {
- GvSV(PL_defgv) = args[index];
+ SV *def_sv = GvSV(PL_defgv) = args[index];
+# ifdef SvTEMP_off
+ SvTEMP_off(def_sv);
+# endif
MULTICALL;
if(SvTRUEx(*PL_stack_sp)) {
# ifdef PERL_HAS_BAD_MULTICALL_REFCOUNT
@@ -449,9 +520,13 @@ PPCODE:
I32 gimme = G_SCALAR;
int index;
+ UNUSED_VAR_newsp;
PUSH_MULTICALL(cv);
for(index = 1; index < items; index++) {
- GvSV(PL_defgv) = args[index];
+ SV *def_sv = GvSV(PL_defgv) = args[index];
+# ifdef SvTEMP_off
+ SvTEMP_off(def_sv);
+# endif
MULTICALL;
if(SvTRUEx(*PL_stack_sp) ^ invert) {
@@ -539,7 +614,7 @@ PPCODE:
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
+ /* TODO: assert pair is an ARRAY ref */
pairav = (AV *)SvRV(pair);
EXTEND(SP, 2);
@@ -629,6 +704,7 @@ PPCODE:
dMULTICALL;
I32 gimme = G_SCALAR;
+ UNUSED_VAR_newsp;
PUSH_MULTICALL(cv);
for(; argi < items; argi += 2) {
SV *a = GvSV(agv) = stack[argi];
@@ -713,6 +789,7 @@ PPCODE:
dMULTICALL;
I32 gimme = G_SCALAR;
+ UNUSED_VAR_newsp;
PUSH_MULTICALL(cv);
for(; argi < items; argi += 2) {
SV *a = GvSV(agv) = stack[argi];
@@ -803,13 +880,15 @@ PPCODE:
dMULTICALL;
I32 gimme = G_ARRAY;
+ UNUSED_VAR_newsp;
PUSH_MULTICALL(cv);
for(; argi < items; argi += 2) {
- SV *a = GvSV(agv) = args_copy ? args_copy[argi] : stack[argi];
- SV *b = GvSV(bgv) = argi < items-1 ?
+ int count;
+
+ GvSV(agv) = args_copy ? args_copy[argi] : stack[argi];
+ GvSV(bgv) = argi < items-1 ?
(args_copy ? args_copy[argi+1] : stack[argi+1]) :
&PL_sv_undef;
- int count;
MULTICALL;
count = PL_stack_sp - PL_stack_base;
@@ -847,13 +926,14 @@ PPCODE:
{
for(; argi < items; argi += 2) {
dSP;
- SV *a = GvSV(agv) = args_copy ? args_copy[argi] : ST(argi);
- SV *b = GvSV(bgv) = argi < items-1 ?
- (args_copy ? args_copy[argi+1] : ST(argi+1)) :
- &PL_sv_undef;
int count;
int i;
+ GvSV(agv) = args_copy ? args_copy[argi] : ST(argi);
+ GvSV(bgv) = argi < items-1 ?
+ (args_copy ? args_copy[argi+1] : ST(argi+1)) :
+ &PL_sv_undef;
+
PUSHMARK(SP);
count = call_sv((SV*)cv, G_ARRAY);
@@ -927,6 +1007,114 @@ CODE:
}
+void
+uniq(...)
+PROTOTYPE: @
+ALIAS:
+ uniqnum = 0
+ uniqstr = 1
+ uniq = 2
+CODE:
+{
+ int retcount = 0;
+ int index;
+ SV **args = &PL_stack_base[ax];
+ HV *seen;
+
+ if(items == 0 || (items == 1 && !SvGAMAGIC(args[0]) && SvOK(args[0]))) {
+ /* Optimise for the case of the empty list or a defined nonmagic
+ * singleton. Leave a singleton magical||undef for the regular case */
+ retcount = items;
+ goto finish;
+ }
+
+ sv_2mortal((SV *)(seen = newHV()));
+
+ if(ix == 0) {
+ /* uniqnum */
+ /* A temporary buffer for number stringification */
+ SV *keysv = sv_newmortal();
+
+ for(index = 0 ; index < items ; index++) {
+ SV *arg = args[index];
+
+ if(SvGAMAGIC(arg))
+ /* clone the value so we don't invoke magic again */
+ arg = sv_mortalcopy(arg);
+
+ if(SvUOK(arg))
+ sv_setpvf(keysv, "%"UVuf, SvUV(arg));
+ else if(SvIOK(arg))
+ sv_setpvf(keysv, "%"IVdf, SvIV(arg));
+ else
+ sv_setpvf(keysv, "%"NVgf, SvNV(arg));
+#ifdef HV_FETCH_EMPTY_HE
+ HE* he = hv_common(seen, NULL, SvPVX(keysv), SvCUR(keysv), 0, HV_FETCH_LVALUE | HV_FETCH_EMPTY_HE, NULL, 0);
+ if (HeVAL(he))
+ continue;
+
+ HeVAL(he) = &PL_sv_undef;
+#else
+ if(hv_exists(seen, SvPVX(keysv), SvCUR(keysv)))
+ continue;
+
+ hv_store(seen, SvPVX(keysv), SvCUR(keysv), &PL_sv_undef, 0);
+#endif
+
+ if(GIMME_V == G_ARRAY)
+ ST(retcount) = SvOK(arg) ? arg : sv_2mortal(newSViv(0));
+ retcount++;
+ }
+ }
+ else {
+ /* uniqstr or uniq */
+ int seen_undef = 0;
+
+ for(index = 0 ; index < items ; index++) {
+ SV *arg = args[index];
+
+ if(SvGAMAGIC(arg))
+ /* clone the value so we don't invoke magic again */
+ arg = sv_mortalcopy(arg);
+
+ if(ix == 2 && !SvOK(arg)) {
+ /* special handling of undef for uniq() */
+ if(seen_undef)
+ continue;
+
+ seen_undef++;
+
+ if(GIMME_V == G_ARRAY)
+ ST(retcount) = arg;
+ retcount++;
+ continue;
+ }
+#ifdef HV_FETCH_EMPTY_HE
+ HE* he = hv_common(seen, arg, NULL, 0, 0, HV_FETCH_LVALUE | HV_FETCH_EMPTY_HE, NULL, 0);
+ if (HeVAL(he))
+ continue;
+
+ HeVAL(he) = &PL_sv_undef;
+#else
+ if (hv_exists_ent(seen, arg, 0))
+ continue;
+
+ hv_store_ent(seen, arg, &PL_sv_undef, 0);
+#endif
+
+ if(GIMME_V == G_ARRAY)
+ ST(retcount) = SvOK(arg) ? arg : sv_2mortal(newSVpvn("", 0));
+ retcount++;
+ }
+ }
+
+ finish:
+ if(GIMME_V == G_ARRAY)
+ XSRETURN(retcount);
+ else
+ ST(0) = sv_2mortal(newSViv(retcount));
+}
+
MODULE=List::Util PACKAGE=Scalar::Util
void
diff --git a/cpan/Scalar-List-Utils/Makefile.PL b/cpan/Scalar-List-Utils/Makefile.PL
index 5068e34598..247b3b7d9d 100644
--- a/cpan/Scalar-List-Utils/Makefile.PL
+++ b/cpan/Scalar-List-Utils/Makefile.PL
@@ -28,13 +28,24 @@ WriteMakefile(
( $PERL_CORE
? ()
: (
- INSTALLDIRS => ($] < 5.011 ? q[perl] : q[site]),
- PREREQ_PM => {'Test::More' => 0,},
+ INSTALLDIRS => ($] < 5.011 ? q[perl] : q[site]),
+ PREREQ_PM => {'Test::More' => 0,},
(eval { ExtUtils::MakeMaker->VERSION(6.31) } ? (LICENSE => 'perl') : ()),
+ (eval { ExtUtils::MakeMaker->VERSION(6.48) } ? (MIN_PERL_VERSION => '5.006') : ()),
( eval { ExtUtils::MakeMaker->VERSION(6.46) } ? (
META_MERGE => {
+ 'meta-spec' => { version => 2 },
+ dynamic_config => 0,
resources => { ##
- repository => 'https://github.com/Scalar-List-Utils/Scalar-List-Utils',
+ repository => {
+ url => 'https://github.com/Scalar-List-Utils/Scalar-List-Utils.git',
+ web => 'https://github.com/Scalar-List-Utils/Scalar-List-Utils',
+ type => 'git',
+ },
+ bugtracker => {
+ mailto => 'bug-Scalar-List-Utils@rt.cpan.org',
+ web => 'https://rt.cpan.org/Public/Dist/Display.html?Name=Scalar-List-Utils',
+ },
},
}
)
diff --git a/cpan/Scalar-List-Utils/lib/List/Util.pm b/cpan/Scalar-List-Utils/lib/List/Util.pm
index 75866aa6c6..c256696c1a 100644
--- a/cpan/Scalar-List-Utils/lib/List/Util.pm
+++ b/cpan/Scalar-List-Utils/lib/List/Util.pm
@@ -7,14 +7,15 @@
package List::Util;
use strict;
+use warnings;
require Exporter;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(
- all any first min max minstr maxstr none notall product reduce sum sum0 shuffle
+ all any first min max minstr maxstr none notall product reduce sum sum0 shuffle uniq uniqnum uniqstr
pairs unpairs pairkeys pairvalues pairmap pairgrep pairfirst
);
-our $VERSION = "1.42_02";
+our $VERSION = "1.45";
our $XS_VERSION = $VERSION;
$VERSION = eval $VERSION;
@@ -38,17 +39,21 @@ sub import
sub List::Util::_Pair::key { shift->[0] }
sub List::Util::_Pair::value { shift->[1] }
-1;
-
-__END__
-
=head1 NAME
List::Util - A selection of general-utility list subroutines
=head1 SYNOPSIS
- use List::Util qw(first max maxstr min minstr reduce shuffle sum);
+ use List::Util qw(
+ reduce any all none notall first
+
+ max maxstr min minstr product sum sum0
+
+ pairs pairkeys pairvalues pairfirst pairgrep pairmap
+
+ shuffle uniqnum uniqstr
+ );
=head1 DESCRIPTION
@@ -67,7 +72,9 @@ The following set of functions all reduce a list down to a single value.
=cut
-=head2 $result = reduce { BLOCK } @list
+=head2 reduce
+
+ $result = reduce { BLOCK } @list
Reduces C<@list> by calling C<BLOCK> in a scalar context multiple times,
setting C<$a> and C<$b> each time. The first call will be with C<$a> and C<$b>
@@ -107,6 +114,20 @@ C<undef> being returned
$foo = reduce { $a + $b } 0, @values; # sum with 0 identity value
+The above example code blocks also suggest how to use C<reduce> to build a
+more efficient combined version of one of these basic functions and a C<map>
+block. For example, to find the total length of the all the strings in a list,
+we could use
+
+ $total = sum map { length } @strings;
+
+However, this produces a list of temporary integer values as long as the
+original list of strings, only to reduce it down to a single value again. We
+can compute the same result more efficiently by using C<reduce> with a code
+block that accumulates lengths by writing this instead as:
+
+ $total = reduce { $a + length $b } 0, @strings
+
The remaining list-reduction functions are all specialisations of this generic
idea.
@@ -289,22 +310,23 @@ Instead, write this using a lexical variable:
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
+returns a list of C<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 ) {
+ 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:
+Since version C<1.39> these C<ARRAY> references are blessed objects,
+recognising the two methods C<key> and C<value>. The following code is
+equivalent:
- foreach my $pair ( pairs @KVLIST ) {
+ foreach my $pair ( pairs @kvlist ) {
my $key = $pair->key;
my $value = $pair->value;
...
@@ -316,7 +338,7 @@ the two methods C<key> and C<value>. The following code is equivalent:
I<Since version 1.42.>
-The inverse function to C<pairs>; this function takes a list of ARRAY
+The inverse function to C<pairs>; this function takes a list of C<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
@@ -454,6 +476,68 @@ Returns the values of the input in a random order
@cards = shuffle 0..51 # 0..51 in a random order
+=head2 uniq
+
+ my @subset = uniq @values
+
+I<Since version 1.45.>
+
+Filters a list of values to remove subsequent duplicates, as judged by a
+DWIM-ish string equality or C<undef> test. Preserves the order of unique
+elements, and retains the first value of any duplicate set.
+
+ my $count = uniq @values
+
+In scalar context, returns the number of elements that would have been
+returned as a list.
+
+The C<undef> value is treated by this function as distinct from the empty
+string, and no warning will be produced. It is left as-is in the returned
+list. Subsequent C<undef> values are still considered identical to the first,
+and will be removed.
+
+=head2 uniqnum
+
+ my @subset = uniqnum @values
+
+I<Since version 1.44.>
+
+Filters a list of values to remove subsequent duplicates, as judged by a
+numerical equality test. Preserves the order of unique elements, and retains
+the first value of any duplicate set.
+
+ my $count = uniqnum @values
+
+In scalar context, returns the number of elements that would have been
+returned as a list.
+
+Note that C<undef> is treated much as other numerical operations treat it; it
+compares equal to zero but additionally produces a warning if such warnings
+are enabled (C<use warnings 'uninitialized';>). In addition, an C<undef> in
+the returned list is coerced into a numerical zero, so that the entire list of
+values returned by C<uniqnum> are well-behaved as numbers.
+
+=head2 uniqstr
+
+ my @subset = uniqstr @values
+
+I<Since version 1.45.>
+
+Filters a list of values to remove subsequent duplicates, as judged by a
+string equality test. Preserves the order of unique elements, and retains the
+first value of any duplicate set.
+
+ my $count = uniqstr @values
+
+In scalar context, returns the number of elements that would have been
+returned as a list.
+
+Note that C<undef> is treated much as other string operations treat it; it
+compares equal to the empty string but additionally produces a warning if such
+warnings are enabled (C<use warnings 'uninitialized';>). In addition, an
+C<undef> in the returned list is coerced into an empty string, so that the
+entire list of values returned by C<uniqstr> are well-behaved as strings.
+
=cut
=head1 KNOWN BUGS
@@ -501,6 +585,21 @@ afterwards. Lexical variables that are only used during the lifetime of the
block's execution will take their individual values for each invocation, as
normal.
+=head2 uniqnum() on oversized bignums
+
+Due to the way that C<uniqnum()> compares numbers, it cannot distinguish
+differences between bignums (especially bigints) that are too large to fit in
+the native platform types. For example,
+
+ my $x = Math::BigInt->new( "1" x 100 );
+ my $y = $x + 1;
+
+ say for uniqnum( $x, $y );
+
+Will print just the value of C<$x>, believing that C<$y> is a numerically-
+equivalent value. This bug does not affect C<uniqstr()>, which will correctly
+observe that the two values stringify to different strings.
+
=head1 SUGGESTED ADDITIONS
The following are additions that have been requested, but I have been reluctant
@@ -528,3 +627,5 @@ Recent additions and current maintenance by
Paul Evans, <leonerd@leonerd.org.uk>.
=cut
+
+1;
diff --git a/cpan/Scalar-List-Utils/lib/List/Util/XS.pm b/cpan/Scalar-List-Utils/lib/List/Util/XS.pm
index fca0738e5a..0a9ad4950e 100644
--- a/cpan/Scalar-List-Utils/lib/List/Util/XS.pm
+++ b/cpan/Scalar-List-Utils/lib/List/Util/XS.pm
@@ -1,8 +1,9 @@
package List::Util::XS;
use strict;
+use warnings;
use List::Util;
-our $VERSION = "1.42_02"; # FIXUP
+our $VERSION = "1.45"; # 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 99a536df64..d2db167281 100644
--- a/cpan/Scalar-List-Utils/lib/Scalar/Util.pm
+++ b/cpan/Scalar-List-Utils/lib/Scalar/Util.pm
@@ -7,6 +7,7 @@
package Scalar::Util;
use strict;
+use warnings;
require Exporter;
our @ISA = qw(Exporter);
@@ -16,7 +17,7 @@ our @EXPORT_OK = qw(
dualvar isdual isvstring looks_like_number openhandle readonly set_prototype
tainted
);
-our $VERSION = "1.42_02";
+our $VERSION = "1.45";
$VERSION = eval $VERSION;
require List::Util; # List::Util loads the XS
@@ -74,8 +75,8 @@ Scalar::Util - A selection of general-utility scalar subroutines
C<Scalar::Util> contains a selection of subroutines that people have expressed
would be nice to have in the perl core, but the usage would not really be high
-enough to warrant the use of a keyword, and the size so small such that being
-individual extensions would be wasteful.
+enough to warrant the use of a keyword, and the size would be so small that
+being individual extensions would be wasteful.
By default C<Scalar::Util> does not export any subroutines.
@@ -89,7 +90,7 @@ The following functions all perform some useful activity on reference values.
my $pkg = blessed( $ref );
-If C<$ref> is a blessed reference the name of the package that it is blessed
+If C<$ref> is a blessed reference, the name of the package that it is blessed
into is returned. Otherwise C<undef> is returned.
$scalar = "foo";
@@ -108,7 +109,7 @@ C<if(blessed $ref)...>) because the package name C<"0"> is defined yet false.
my $addr = refaddr( $ref );
-If C<$ref> is reference the internal memory address of the referenced value is
+If C<$ref> is reference, the internal memory address of the referenced value is
returned as a plain integer. Otherwise C<undef> is returned.
$addr = refaddr "string"; # undef
@@ -122,7 +123,7 @@ returned as a plain integer. Otherwise C<undef> is returned.
my $type = reftype( $ref );
-If C<$ref> is a reference the basic Perl type of the variable referenced is
+If C<$ref> is a reference, the basic Perl type of the variable referenced is
returned as a plain string (such as C<ARRAY> or C<HASH>). Otherwise C<undef>
is returned.
@@ -138,7 +139,7 @@ is returned.
weaken( $ref );
The lvalue C<$ref> will be turned into a weak reference. This means that it
-will not hold a reference count on the object it references. Also when the
+will not hold a reference count on the object it references. Also, when the
reference count on that object reaches zero, the reference will be set to
undef. This function mutates the lvalue passed as its argument and returns no
value.
@@ -242,8 +243,8 @@ numeric operations:
$bar = $foo + 0;
$dual = isdual($foo); # true
-Note that although C<$!> appears to be dual-valued variable, it is actually
-implemented using a tied scalar:
+Note that although C<$!> appears to be a dual-valued variable, it is
+actually implemented as a magical variable inside the interpreter:
$! = 1;
print("$!\n"); # "Operation not permitted"
@@ -258,7 +259,7 @@ You can capture its numeric and string content using:
my $vstring = isvstring( $var );
-If C<$var> is a scalar which was coded as a vstring the result is true.
+If C<$var> is a scalar which was coded as a vstring, the result is true.
$vs = v49.46.48;
$fmt = isvstring($vs) ? "%vd" : "%s"; #true
@@ -328,15 +329,6 @@ use L</isweak> or L</weaken> you will need to use a newer release of perl.
The version of perl that you are using does not implement Vstrings, to use
L</isvstring> you will need to use a newer release of perl.
-=item C<NAME> is only available with the XS version of Scalar::Util
-
-C<Scalar::Util> contains both perl and C implementations of many of its
-functions so that those without access to a C compiler may still use it.
-However some of the functions are only available when a C compiler was
-available to compile the XS version of the extension.
-
-At present that list is: weaken, isweak, dualvar, isvstring, set_prototype
-
=back
=head1 KNOWN BUGS
diff --git a/cpan/Scalar-List-Utils/lib/Sub/Util.pm b/cpan/Scalar-List-Utils/lib/Sub/Util.pm
index 1bf5878886..678016364e 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.42_02";
+our $VERSION = "1.45";
$VERSION = eval $VERSION;
require List::Util; # as it has the XS
diff --git a/cpan/Scalar-List-Utils/t/product.t b/cpan/Scalar-List-Utils/t/product.t
index 38c923be50..1aad877531 100644
--- a/cpan/Scalar-List-Utils/t/product.t
+++ b/cpan/Scalar-List-Utils/t/product.t
@@ -3,8 +3,9 @@
use strict;
use warnings;
-use Test::More tests => 14;
+use Test::More tests => 25;
+use Config;
use List::Util qw(product);
my $v = product;
@@ -22,6 +23,15 @@ is( $v, -1, 'one -1');
$v = product(0, 1, 2);
is( $v, 0, 'first factor zero' );
+$v = product(0, 1);
+is( $v, 0, '0 * 1');
+
+$v = product(1, 0);
+is( $v, 0, '1 * 0');
+
+$v = product(0, 0);
+is( $v, 0, 'two 0');
+
my $x = -3;
$v = product($x, 3);
@@ -89,3 +99,29 @@ is($v, $v1 * 42 * 2, 'bigint + builtin int');
is($t, 567, 'overload returning non-overload');
}
+SKIP: {
+ skip "IV is not at least 64bit", 8 unless $Config{ivsize} >= 8;
+
+ my $t;
+ my $min = -(1<<31);
+ my $max = (1<<31)-1;
+
+ $t = product($min, $min);
+ is($t, 1<<62, 'min * min');
+ $t = product($min, $max);
+ is($t, (1<<31) - (1<<62), 'min * max');
+ $t = product($max, $min);
+ is($t, (1<<31) - (1<<62), 'max * min');
+ $t = product($max, $max);
+ is($t, (1<<62)-(1<<32)+1, 'max * max');
+
+ $t = product($min*8, $min);
+ cmp_ok($t, '>', (1<<61), 'min*8*min'); # may be an NV
+ $t = product($min*8, $max);
+ cmp_ok($t, '<', -(1<<61), 'min*8*max'); # may be an NV
+ $t = product($max, $min*8);
+ cmp_ok($t, '<', -(1<<61), 'min*max*8'); # may be an NV
+ $t = product($max, $max*8);
+ cmp_ok($t, '>', (1<<61), 'max*max*8'); # may be an NV
+
+}
diff --git a/cpan/Scalar-List-Utils/t/rt-96343.t b/cpan/Scalar-List-Utils/t/rt-96343.t
new file mode 100644
index 0000000000..5328a411db
--- /dev/null
+++ b/cpan/Scalar-List-Utils/t/rt-96343.t
@@ -0,0 +1,35 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+
+{
+ use List::Util qw( first );
+
+ my $hash = {
+ 'HellO WorlD' => 1,
+ };
+
+ is( ( first { 'hello world' eq lc($_) } keys %$hash ), "HellO WorlD",
+ 'first (lc$_) perserves value' );
+}
+
+{
+ use List::Util qw( any );
+
+ my $hash = {
+ 'HellO WorlD' => 1,
+ };
+
+ my $var;
+
+ no warnings 'void';
+ any { lc($_); $var = $_; } keys %$hash;
+
+ is( $var, 'HellO WorlD',
+ 'any (lc$_) leaves value undisturbed' );
+}
+
+done_testing;
diff --git a/cpan/Scalar-List-Utils/t/sum.t b/cpan/Scalar-List-Utils/t/sum.t
index 7a12813ff0..4639a8ac8d 100644
--- a/cpan/Scalar-List-Utils/t/sum.t
+++ b/cpan/Scalar-List-Utils/t/sum.t
@@ -3,7 +3,7 @@
use strict;
use warnings;
-use Test::More tests => 15;
+use Test::More tests => 17;
use Config;
use List::Util qw(sum);
@@ -91,9 +91,17 @@ is($v, $v1 + 42 + 2, 'bigint + builtin int');
}
SKIP: {
- skip "IV is not at least 64bit", 1 unless $Config{ivsize} >= 8;
+ skip "IV is not at least 64bit", 3 unless $Config{ivsize} >= 8;
# Sum using NV will only preserve 53 bits of integer precision
my $t = sum(1<<60, 1);
cmp_ok($t, '>', 1<<60, 'sum uses IV where it can');
+
+ my $min = -(1<<63);
+ my $max = (1<<63)-1;
+
+ $t = sum($min, $max);
+ is($t, -1, 'min + max');
+ $t = sum($max, $min);
+ is($t, -1, 'max + min');
}
diff --git a/cpan/Scalar-List-Utils/t/uniq.t b/cpan/Scalar-List-Utils/t/uniq.t
new file mode 100644
index 0000000000..5a6925d1f5
--- /dev/null
+++ b/cpan/Scalar-List-Utils/t/uniq.t
@@ -0,0 +1,213 @@
+#!./perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 30;
+use List::Util qw( uniqnum uniqstr uniq );
+
+use Tie::Array;
+
+is_deeply( [ uniqstr ],
+ [],
+ 'uniqstr of empty list' );
+
+is_deeply( [ uniqstr qw( abc ) ],
+ [qw( abc )],
+ 'uniqstr of singleton list' );
+
+is_deeply( [ uniqstr qw( x x x ) ],
+ [qw( x )],
+ 'uniqstr of repeated-element list' );
+
+is_deeply( [ uniqstr qw( a b a c ) ],
+ [qw( a b c )],
+ 'uniqstr removes subsequent duplicates' );
+
+is_deeply( [ uniqstr qw( 1 1.0 1E0 ) ],
+ [qw( 1 1.0 1E0 )],
+ 'uniqstr compares strings' );
+
+{
+ my $warnings = "";
+ local $SIG{__WARN__} = sub { $warnings .= join "", @_ };
+
+ is_deeply( [ uniqstr "", undef ],
+ [ "" ],
+ 'uniqstr considers undef and empty-string equivalent' );
+
+ ok( length $warnings, 'uniqstr on undef yields a warning' );
+
+ is_deeply( [ uniqstr undef ],
+ [ "" ],
+ 'uniqstr on undef coerces to empty-string' );
+}
+
+{
+ my $warnings = "";
+ local $SIG{__WARN__} = sub { $warnings .= join "", @_ };
+
+ my $cafe = "cafe\x{301}";
+
+ is_deeply( [ uniqstr $cafe ],
+ [ $cafe ],
+ 'uniqstr is happy with Unicode strings' );
+
+ utf8::encode( my $cafebytes = $cafe );
+
+ is_deeply( [ uniqstr $cafe, $cafebytes ],
+ [ $cafe, $cafebytes ],
+ 'uniqstr does not squash bytewise-equal but differently-encoded strings' );
+
+ is( $warnings, "", 'No warnings are printed when handling Unicode strings' );
+}
+
+is_deeply( [ uniqnum qw( 1 1.0 1E0 2 3 ) ],
+ [ 1, 2, 3 ],
+ 'uniqnum compares numbers' );
+
+is_deeply( [ uniqnum qw( 1 1.1 1.2 1.3 ) ],
+ [ 1, 1.1, 1.2, 1.3 ],
+ 'uniqnum distinguishes floats' );
+
+# Hard to know for sure what an Inf is going to be. Lets make one
+my $Inf = 0 + 1E1000;
+my $NaN;
+$Inf **= 1000 while ( $NaN = $Inf - $Inf ) == $NaN;
+
+is_deeply( [ uniqnum 0, 1, 12345, $Inf, -$Inf, $NaN, 0, $Inf, $NaN ],
+ [ 0, 1, 12345, $Inf, -$Inf, $NaN ],
+ 'uniqnum preserves the special values of +-Inf and Nan' );
+
+{
+ my $maxint = ~0;
+
+ is_deeply( [ uniqnum $maxint, $maxint-1, -1 ],
+ [ $maxint, $maxint-1, -1 ],
+ 'uniqnum preserves uniqness of full integer range' );
+}
+
+{
+ my $warnings = "";
+ local $SIG{__WARN__} = sub { $warnings .= join "", @_ };
+
+ is_deeply( [ uniqnum 0, undef ],
+ [ 0 ],
+ 'uniqnum considers undef and zero equivalent' );
+
+ ok( length $warnings, 'uniqnum on undef yields a warning' );
+
+ is_deeply( [ uniqnum undef ],
+ [ 0 ],
+ 'uniqnum on undef coerces to zero' );
+}
+
+is_deeply( [ uniq () ],
+ [],
+ 'uniq of empty list' );
+
+{
+ my $warnings = "";
+ local $SIG{__WARN__} = sub { $warnings .= join "", @_ };
+
+ is_deeply( [ uniq "", undef ],
+ [ "", undef ],
+ 'uniq distintinguishes empty-string from undef' );
+
+ is_deeply( [ uniq undef, undef ],
+ [ undef ],
+ 'uniq considers duplicate undefs as identical' );
+
+ ok( !length $warnings, 'uniq on undef does not warn' );
+}
+
+is( scalar( uniqstr qw( a b c d a b e ) ), 5, 'uniqstr() in scalar context' );
+
+{
+ package Stringify;
+
+ use overload '""' => sub { return $_[0]->{str} };
+
+ sub new { bless { str => $_[1] }, $_[0] }
+
+ package main;
+
+ my @strs = map { Stringify->new( $_ ) } qw( foo foo bar );
+
+ is_deeply( [ uniqstr @strs ],
+ [ $strs[0], $strs[2] ],
+ 'uniqstr respects stringify overload' );
+}
+
+{
+ package Numify;
+
+ use overload '0+' => sub { return $_[0]->{num} };
+
+ sub new { bless { num => $_[1] }, $_[0] }
+
+ package main;
+ use Scalar::Util qw( refaddr );
+
+ my @nums = map { Numify->new( $_ ) } qw( 2 2 5 );
+
+ # is_deeply wants to use eq overloading
+ my @ret = uniqnum @nums;
+ ok( scalar @ret == 2 &&
+ refaddr $ret[0] == refaddr $nums[0] &&
+ refaddr $ret[1] == refaddr $nums[2],
+ 'uniqnum respects numify overload' );
+}
+
+{
+ package DestroyNotifier;
+
+ use overload '""' => sub { "SAME" };
+
+ sub new { bless { var => $_[1] }, $_[0] }
+
+ sub DESTROY { ${ $_[0]->{var} }++ }
+
+ package main;
+
+ my @destroyed = (0) x 3;
+ my @notifiers = map { DestroyNotifier->new( \$destroyed[$_] ) } 0 .. 2;
+
+ my @uniqstr = uniqstr @notifiers;
+ undef @notifiers;
+
+ is_deeply( \@destroyed, [ 0, 1, 1 ],
+ 'values filtered by uniqstr() are destroyed' );
+
+ undef @uniqstr;
+ is_deeply( \@destroyed, [ 1, 1, 1 ],
+ 'all values destroyed' );
+}
+
+{
+ "a a b" =~ m/(.) (.) (.)/;
+ is_deeply( [ uniqstr $1, $2, $3 ],
+ [qw( a b )],
+ 'uniqstr handles magic' );
+
+ "1 1 2" =~ m/(.) (.) (.)/;
+ is_deeply( [ uniqnum $1, $2, $3 ],
+ [ 1, 2 ],
+ 'uniqnum handles magic' );
+}
+
+{
+ my @array;
+ tie @array, 'Tie::StdArray';
+ @array = (
+ ( map { ( 1 .. 10 ) } 0 .. 1 ),
+ ( map { ( 'a' .. 'z' ) } 0 .. 1 )
+ );
+
+ my @u = uniq @array;
+ is_deeply(
+ \@u,
+ [ 1 .. 10, 'a' .. 'z' ],
+ 'uniq uniquifies mixed numbers and strings correctly in a tied array'
+ );
+}