Hello community,
here is the log from the commit of package perl-Scalar-List-Utils for
openSUSE:Factory checked in at 2020-02-09 21:02:12
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/perl-Scalar-List-Utils (Old)
and /work/SRC/openSUSE:Factory/.perl-Scalar-List-Utils.new.26092 (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "perl-Scalar-List-Utils"
Sun Feb 9 21:02:12 2020 rev:18 rq:770045 version:1.54
Changes:
--------
---
/work/SRC/openSUSE:Factory/perl-Scalar-List-Utils/perl-Scalar-List-Utils.changes
2019-10-30 14:40:55.893742735 +0100
+++
/work/SRC/openSUSE:Factory/.perl-Scalar-List-Utils.new.26092/perl-Scalar-List-Utils.changes
2020-02-09 21:02:23.663352766 +0100
@@ -1,0 +2,21 @@
+Mon Feb 3 03:15:24 UTC 2020 - <[email protected]>
+
+- updated to 1.54
+ see /usr/share/doc/packages/perl-Scalar-List-Utils/Changes
+
+ 1.54 -- 2020-02-02 15:47
+ [CHANGES]
+ * Added List::Util::reductions (RT128237)
+ * Added List::Util::sample (RT131535)
+ * Recognise $List::Util::RAND as a source of randomness for sampling
+ functions (RT131536)
+
+ [BUGFIXES]
+ * Document the difference between ref() and reftype() on precompiled
+ qr// regexps (RT127963)
+ * Various improvements to List::Util::uniqnum() to handle stringified
+ Inf and NaN, negative zero
+ * Detect platform NV size and number of digits required to calculate
+ uniqueness
+
+-------------------------------------------------------------------
Old:
----
Scalar-List-Utils-1.53.tar.gz
New:
----
Scalar-List-Utils-1.54.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ perl-Scalar-List-Utils.spec ++++++
--- /var/tmp/diff_new_pack.e2CdJS/_old 2020-02-09 21:02:24.967353506 +0100
+++ /var/tmp/diff_new_pack.e2CdJS/_new 2020-02-09 21:02:25.007353528 +0100
@@ -1,7 +1,7 @@
#
# spec file for package perl-Scalar-List-Utils
#
-# Copyright (c) 2019 SUSE LINUX GmbH, Nuernberg, Germany.
+# Copyright (c) 2020 SUSE LINUX GmbH, Nuernberg, Germany.
#
# All modifications and additions to the file contributed by third parties
# remain the property of their copyright owners, unless otherwise agreed
@@ -17,7 +17,7 @@
Name: perl-Scalar-List-Utils
-Version: 1.53
+Version: 1.54
Release: 0
%define cpan_name Scalar-List-Utils
Summary: Common Scalar and List utility subroutines
@@ -36,7 +36,7 @@
%prep
%setup -q -n %{cpan_name}-%{version}
-find . -type f ! -path "*/t/*" ! -name "*.pl" ! -name "*.sh" -print0 | xargs
-0 chmod 644
+find . -type f ! -path "*/t/*" ! -name "*.pl" ! -path "*/bin/*" ! -path
"*/script/*" ! -name "configure" -print0 | xargs -0 chmod 644
%build
perl Makefile.PL INSTALLDIRS=vendor OPTIMIZE="%{optflags}"
++++++ Scalar-List-Utils-1.53.tar.gz -> Scalar-List-Utils-1.54.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Scalar-List-Utils-1.53/Changes
new/Scalar-List-Utils-1.54/Changes
--- old/Scalar-List-Utils-1.53/Changes 2019-10-24 11:42:03.000000000 +0200
+++ new/Scalar-List-Utils-1.54/Changes 2020-02-02 16:55:59.000000000 +0100
@@ -1,3 +1,18 @@
+1.54 -- 2020-02-02 15:47
+ [CHANGES]
+ * Added List::Util::reductions (RT128237)
+ * Added List::Util::sample (RT131535)
+ * Recognise $List::Util::RAND as a source of randomness for sampling
+ functions (RT131536)
+
+ [BUGFIXES]
+ * Document the difference between ref() and reftype() on precompiled
+ qr// regexps (RT127963)
+ * Various improvements to List::Util::uniqnum() to handle stringified
+ Inf and NaN, negative zero
+ * Detect platform NV size and number of digits required to calculate
+ uniqueness
+
1.53 -- 2019-10-24 10:41:12
[BUGFIXES]
* Handle Unicode package names in Scalar::Util::blessed (GH #81)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Scalar-List-Utils-1.53/ListUtil.xs
new/Scalar-List-Utils-1.54/ListUtil.xs
--- old/Scalar-List-Utils-1.53/ListUtil.xs 2019-10-23 12:03:30.000000000
+0200
+++ new/Scalar-List-Utils-1.54/ListUtil.xs 2020-02-02 16:55:59.000000000
+0100
@@ -175,6 +175,54 @@
/* Magic for set_subname */
static MGVTBL subname_vtbl;
+static void MY_initrand(pTHX)
+{
+#if (PERL_VERSION < 9)
+ struct op dmy_op;
+ struct op *old_op = PL_op;
+
+ /* We call pp_rand here so that Drand01 get initialized if rand()
+ or srand() has not already been called
+ */
+ memzero((char*)(&dmy_op), sizeof(struct op));
+ /* we let pp_rand() borrow the TARG allocated for this XS sub */
+ dmy_op.op_targ = PL_op->op_targ;
+ PL_op = &dmy_op;
+ (void)*(PL_ppaddr[OP_RAND])(aTHX);
+ PL_op = old_op;
+#else
+ /* Initialize Drand01 if rand() or srand() has
+ not already been called
+ */
+ if(!PL_srand_called) {
+ (void)seedDrand01((Rand_seed_t)Perl_seed(aTHX));
+ PL_srand_called = TRUE;
+ }
+#endif
+}
+
+static double MY_callrand(pTHX_ CV *randcv)
+{
+ dSP;
+ double ret;
+
+ ENTER;
+ PUSHMARK(SP);
+ PUTBACK;
+
+ call_sv((SV *)randcv, G_SCALAR);
+
+ SPAGAIN;
+
+ ret = POPn;
+ ret -= trunc(ret); /* bound to < 1 */
+ if(ret < 0) ret += 1.0; /* bound to 0 <= ret < 1 */
+
+ LEAVE;
+
+ return ret;
+}
+
MODULE=List::Util PACKAGE=List::Util
void
@@ -451,10 +499,14 @@
reduce(block,...)
SV *block
PROTOTYPE: &@
+ALIAS:
+ reduce = 0
+ reductions = 1
CODE:
{
SV *ret = sv_newmortal();
int index;
+ AV *retvals;
GV *agv,*bgv,*gv;
HV *stash;
SV **args = &PL_stack_base[ax];
@@ -463,8 +515,12 @@
if(cv == Nullcv)
croak("Not a subroutine reference");
- if(items <= 1)
- XSRETURN_UNDEF;
+ if(items <= 1) {
+ if(ix)
+ XSRETURN(0);
+ else
+ XSRETURN_UNDEF;
+ }
agv = gv_fetchpv("a", GV_ADD, SVt_PV);
bgv = gv_fetchpv("b", GV_ADD, SVt_PV);
@@ -472,6 +528,17 @@
SAVESPTR(GvSV(bgv));
GvSV(agv) = ret;
SvSetMagicSV(ret, args[1]);
+
+ if(ix) {
+ /* Precreate an AV for return values; -1 for cv, -1 for top index */
+ retvals = newAV();
+ av_extend(retvals, items-1-1);
+
+ /* so if throw an exception they can be reclaimed */
+ SAVEFREESV(retvals);
+
+ av_push(retvals, newSVsv(ret));
+ }
#ifdef dMULTICALL
assert(cv);
if(!CvISXSUB(cv)) {
@@ -484,6 +551,8 @@
GvSV(bgv) = args[index];
MULTICALL;
SvSetMagicSV(ret, *PL_stack_sp);
+ if(ix)
+ av_push(retvals, newSVsv(ret));
}
# ifdef PERL_HAS_BAD_MULTICALL_REFCOUNT
if(CvDEPTH(multicall_cv) > 1)
@@ -502,11 +571,26 @@
call_sv((SV*)cv, G_SCALAR);
SvSetMagicSV(ret, *PL_stack_sp);
+ if(ix)
+ av_push(retvals, newSVsv(ret));
}
}
- ST(0) = ret;
- XSRETURN(1);
+ if(ix) {
+ int i;
+ SV **svs = AvARRAY(retvals);
+ /* steal the SVs from retvals */
+ for(i = 0; i < items-1; i++) {
+ ST(i) = sv_2mortal(svs[i]);
+ svs[i] = NULL;
+ }
+
+ XSRETURN(items-1);
+ }
+ else {
+ ST(0) = ret;
+ XSRETURN(1);
+ }
}
void
@@ -1137,31 +1221,17 @@
CODE:
{
int index;
-#if (PERL_VERSION < 9)
- struct op dmy_op;
- struct op *old_op = PL_op;
+ SV *randsv = get_sv("List::Util::RAND", 0);
+ CV * const randcv = randsv && SvROK(randsv) && SvTYPE(SvRV(randsv)) ==
SVt_PVCV ?
+ (CV *)SvRV(randsv) : NULL;
- /* We call pp_rand here so that Drand01 get initialized if rand()
- or srand() has not already been called
- */
- memzero((char*)(&dmy_op), sizeof(struct op));
- /* we let pp_rand() borrow the TARG allocated for this XS sub */
- dmy_op.op_targ = PL_op->op_targ;
- PL_op = &dmy_op;
- (void)*(PL_ppaddr[OP_RAND])(aTHX);
- PL_op = old_op;
-#else
- /* Initialize Drand01 if rand() or srand() has
- not already been called
- */
- if(!PL_srand_called) {
- (void)seedDrand01((Rand_seed_t)Perl_seed(aTHX));
- PL_srand_called = TRUE;
- }
-#endif
+ if(!randcv)
+ MY_initrand(aTHX);
for (index = items ; index > 1 ; ) {
- int swap = (int)(Drand01() * (double)(index--));
+ int swap = (int)(
+ (randcv ? MY_callrand(aTHX_ randcv) : Drand01()) *
(double)(index--)
+ );
SV *tmp = ST(swap);
ST(swap) = ST(index);
ST(index) = tmp;
@@ -1170,6 +1240,52 @@
XSRETURN(items);
}
+void
+sample(...)
+PROTOTYPE: $@
+CODE:
+{
+ UV count = items ? SvUV(ST(0)) : 0;
+ int reti = 0;
+ SV *randsv = get_sv("List::Util::RAND", 0);
+ CV * const randcv = randsv && SvROK(randsv) && SvTYPE(SvRV(randsv)) ==
SVt_PVCV ?
+ (CV *)SvRV(randsv) : NULL;
+
+ if(!count)
+ XSRETURN(0);
+
+ /* Now we've extracted count from ST(0) the rest of this logic will be a
+ * lot neater if we move the topmost item into ST(0) so we can just work
+ * within 0..items-1 */
+ ST(0) = POPs;
+ items--;
+
+ if(count > items)
+ count = items;
+
+ if(!randcv)
+ MY_initrand(aTHX);
+
+ /* Partition the stack into ST(0)..ST(reti-1) containing the sampled
results
+ * and ST(reti)..ST(items-1) containing the remaining pending candidates
+ */
+ while(reti < count) {
+ int index = (int)(
+ (randcv ? MY_callrand(aTHX_ randcv) : Drand01()) * (double)(items
- reti)
+ );
+
+ SV *selected = ST(reti + index);
+ /* preserve the element we're about to stomp on by putting it back into
+ * the pending partition */
+ ST(reti + index) = ST(reti);
+
+ ST(reti) = selected;
+ reti++;
+ }
+
+ XSRETURN(reti);
+}
+
void
uniq(...)
@@ -1201,6 +1317,7 @@
for(index = 0 ; index < items ; index++) {
SV *arg = args[index];
+ NV nv_arg;
#ifdef HV_FETCH_EMPTY_HE
HE* he;
#endif
@@ -1217,12 +1334,35 @@
#endif
}
- if(!SvOK(arg) || SvUOK(arg))
+ if(!SvOK(arg) || SvUOK(arg)) {
sv_setpvf(keysv, "%" UVuf, SvUV(arg));
- else if(SvIOK(arg))
+ }
+ else if(SvIOK(arg)) {
sv_setpvf(keysv, "%" IVdf, SvIV(arg));
- else
- sv_setpvf(keysv, "%.15" NVgf, SvNV(arg));
+ }
+ else {
+ nv_arg = SvNV(arg);
+ /* use 0 for both 0 and -0.0 */
+ if(nv_arg == 0) {
+ sv_setpvs(keysv, "0");
+ }
+ /* for NaN, use the platform's normal stringification */
+ else if (nv_arg != nv_arg) {
+ sv_setpvf(keysv, "%" NVgf, nv_arg);
+ }
+ /* for numbers outside of the IV or UV range, we don't need to
+ * use a comparable format, so just use the raw bytes, adding
+ * 'f' to ensure not matching a stringified number */
+ else if (nv_arg < (NV)IV_MIN || nv_arg > (NV)UV_MAX) {
+ sv_setpvn(keysv, (char *) &nv_arg, sizeof(NV));
+ sv_catpvn(keysv, "f", 1);
+ }
+ /* smaller floats get formatted using %g and could be equal to
+ * a UV or IV */
+ else {
+ sv_setpvf(keysv, "%0.*" NVgf, NV_MAX_PRECISION, nv_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))
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Scalar-List-Utils-1.53/MANIFEST
new/Scalar-List-Utils-1.54/MANIFEST
--- old/Scalar-List-Utils-1.53/MANIFEST 2019-10-24 11:42:20.000000000 +0200
+++ new/Scalar-List-Utils-1.54/MANIFEST 2020-02-02 16:57:38.000000000 +0100
@@ -29,9 +29,11 @@
t/prototype.t
t/readonly.t
t/reduce.t
+t/reductions.t
t/refaddr.t
t/reftype.t
t/rt-96343.t
+t/sample.t
t/scalarutil-proto.t
t/shuffle.t
t/stack-corruption.t
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Scalar-List-Utils-1.53/META.json
new/Scalar-List-Utils-1.54/META.json
--- old/Scalar-List-Utils-1.53/META.json 2019-10-24 11:42:20.000000000
+0200
+++ new/Scalar-List-Utils-1.54/META.json 2020-02-02 16:57:37.000000000
+0100
@@ -4,7 +4,7 @@
"Graham Barr <[email protected]>"
],
"dynamic_config" : 0,
- "generated_by" : "ExtUtils::MakeMaker version 7.34, CPAN::Meta::Converter
version 2.150010",
+ "generated_by" : "ExtUtils::MakeMaker version 7.42, CPAN::Meta::Converter
version 2.150010",
"license" : [
"perl_5"
],
@@ -49,6 +49,6 @@
"web" : "https://github.com/Scalar-List-Utils/Scalar-List-Utils";
}
},
- "version" : "1.53",
- "x_serialization_backend" : "JSON::PP version 2.97001"
+ "version" : "1.54",
+ "x_serialization_backend" : "JSON::PP version 4.04"
}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Scalar-List-Utils-1.53/META.yml
new/Scalar-List-Utils-1.54/META.yml
--- old/Scalar-List-Utils-1.53/META.yml 2019-10-24 11:42:20.000000000 +0200
+++ new/Scalar-List-Utils-1.54/META.yml 2020-02-02 16:57:37.000000000 +0100
@@ -7,7 +7,7 @@
configure_requires:
ExtUtils::MakeMaker: '0'
dynamic_config: 0
-generated_by: 'ExtUtils::MakeMaker version 7.34, CPAN::Meta::Converter version
2.150010'
+generated_by: 'ExtUtils::MakeMaker version 7.42, CPAN::Meta::Converter version
2.150010'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
@@ -23,5 +23,5 @@
resources:
bugtracker:
https://rt.cpan.org/Public/Dist/Display.html?Name=Scalar-List-Utils
repository: https://github.com/Scalar-List-Utils/Scalar-List-Utils.git
-version: '1.53'
+version: '1.54'
x_serialization_backend: 'CPAN::Meta::YAML version 0.018'
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Scalar-List-Utils-1.53/Makefile.PL
new/Scalar-List-Utils-1.54/Makefile.PL
--- old/Scalar-List-Utils-1.53/Makefile.PL 2018-02-20 20:07:53.000000000
+0100
+++ new/Scalar-List-Utils-1.54/Makefile.PL 2020-02-02 16:55:59.000000000
+0100
@@ -6,12 +6,42 @@
use File::Spec;
use ExtUtils::MakeMaker;
my $PERL_CORE = grep { $_ eq 'PERL_CORE=1' } @ARGV;
+my $defines = $ENV{PERL_CORE} ? q[-DPERL_EXT] : q[-DPERL_EXT -DUSE_PPPORT_H];
+
+my $nv_digits;
+
+my $ivsize = $Config{ivsize} * 8;
+my $uv_digits = 1 + int(log(2) / log(10) * $ivsize);
+
+my $nvsize = $Config{nvsize} * 8;
+# we want NV and UV numbers in the same range to format the same, so make sure
+# NVs are given at least as many digits as UVs. If IV/UVs have equal or
+# greater bits, there's no reason to check NV size since it won't be able to
+# have as much mantissa.
+if ($ivsize >= $nvsize) {
+ $nv_digits = $uv_digits;
+}
+else {
+ # maximum possible digits that could fit in something NV size
+ my $max_digits = 1 + int(log(2) / log(10) * $nvsize);
+
+ my $float = sprintf '%0.'.$max_digits.'g', 1/9;
+ my ($accurate_digits) = $float =~ /(1+)/;
+ # additional digit provides 'partial' accuracy
+ $nv_digits = 1 + length $accurate_digits;
+
+ if ($nv_digits < $uv_digits) {
+ $nv_digits = $uv_digits;
+ }
+}
+
+$defines .= " -DNV_MAX_PRECISION=$nv_digits";
WriteMakefile(
NAME => q[List::Util],
ABSTRACT => q[Common Scalar and List utility subroutines],
AUTHOR => q[Graham Barr <[email protected]>],
- DEFINE => ($ENV{PERL_CORE} ? q[-DPERL_EXT] : q[-DPERL_EXT
-DUSE_PPPORT_H]),
+ DEFINE => $defines,
DISTNAME => q[Scalar-List-Utils],
VERSION_FROM => 'lib/List/Util.pm',
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Scalar-List-Utils-1.53/lib/List/Util/XS.pm
new/Scalar-List-Utils-1.54/lib/List/Util/XS.pm
--- old/Scalar-List-Utils-1.53/lib/List/Util/XS.pm 2019-10-24
11:42:03.000000000 +0200
+++ new/Scalar-List-Utils-1.54/lib/List/Util/XS.pm 2020-02-02
16:55:59.000000000 +0100
@@ -3,7 +3,7 @@
use warnings;
use List::Util;
-our $VERSION = "1.53"; # FIXUP
+our $VERSION = "1.54"; # FIXUP
$VERSION =~ tr/_//d; # FIXUP
1;
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Scalar-List-Utils-1.53/lib/List/Util.pm
new/Scalar-List-Utils-1.54/lib/List/Util.pm
--- old/Scalar-List-Utils-1.53/lib/List/Util.pm 2019-10-24 11:42:03.000000000
+0200
+++ new/Scalar-List-Utils-1.54/lib/List/Util.pm 2020-02-02 16:55:59.000000000
+0100
@@ -12,16 +12,20 @@
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(
- all any first min max minstr maxstr none notall product reduce sum sum0
shuffle uniq uniqnum uniqstr
+ all any first min max minstr maxstr none notall product reduce reductions
sum sum0
+ sample shuffle uniq uniqnum uniqstr
head tail pairs unpairs pairkeys pairvalues pairmap pairgrep pairfirst
);
-our $VERSION = "1.53";
+our $VERSION = "1.54";
our $XS_VERSION = $VERSION;
$VERSION =~ tr/_//d;
require XSLoader;
XSLoader::load('List::Util', $XS_VERSION);
+# Used by shuffle()
+our $RAND;
+
sub import
{
my $pkg = caller;
@@ -47,7 +51,7 @@
=head1 SYNOPSIS
use List::Util qw(
- reduce any all none notall first
+ reduce any all none notall first reductions
max maxstr min minstr product sum sum0
@@ -69,7 +73,8 @@
=head1 LIST-REDUCTION FUNCTIONS
-The following set of functions all reduce a list down to a single value.
+The following set of functions all apply a given block of code to a list of
+values.
=cut
@@ -129,8 +134,28 @@
$total = reduce { $a + length $b } 0, @strings
-The remaining list-reduction functions are all specialisations of this generic
-idea.
+The other scalar-returning list reduction functions are all specialisations of
+this generic idea.
+
+=head2 reductions
+
+ @results = reductions { BLOCK } @list
+
+I<Since version 1.54.>
+
+Similar to C<reduce> except that it also returns the intermediate values along
+with the final result. As before, C<$a> is set to the first element of the
+given list, and the C<BLOCK> is then called once for remaining item in the
+list set into C<$b>, with the result being captured for return as well as
+becoming the new value for C<$a>.
+
+The returned list will begin with the initial value for C<$a>, followed by
+each return value from the block in order. The final value of the result will
+be identical to what the C<reduce> function would have returned given the same
+block and list.
+
+ reduce { "$a-$b" } "a".."d" # "a-b-c-d"
+ reductions { "$a-$b" } "a".."d" # "a", "a-b", "a-b-c", "a-b-c-d"
=head2 any
@@ -489,6 +514,25 @@
@cards = shuffle 0..51 # 0..51 in a random order
+This function is affected by the C<$RAND> variable.
+
+=cut
+
+=head2 sample
+
+ my @items = sample $count, @values
+
+I<Since version 1.54.>
+
+Randomly select the given number of elements from the input list. Any given
+position in the input list will be selected at most once.
+
+If there are fewer than C<$count> items in the list then the function will
+return once all of them have been randomly selected; effectively the function
+behaves similarly to L</shuffle>.
+
+This function is affected by the C<$RAND> variable.
+
=head2 uniq
my @subset = uniq @values
@@ -587,6 +631,21 @@
@result = tail -2, qw( foo bar baz );
# baz
+=head1 CONFIGURATION VARIABLES
+
+=head2 $RAND
+
+ local $List::Util::RAND = sub { ... };
+
+I<Since version 1.54.>
+
+This package variable is used by code which needs to generate random numbers
+(such as the L</shuffle> and L</sample> functions). If set to a CODE reference
+it provides an alternative to perl's builtin C<rand()> function. When a new
+random number is needed this function will be invoked with no arguments and is
+expected to return a floating-point value, of which only the fractional part
+will be used.
+
=head1 KNOWN BUGS
=head2 RT #95409
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Scalar-List-Utils-1.53/lib/Scalar/Util.pm
new/Scalar-List-Utils-1.54/lib/Scalar/Util.pm
--- old/Scalar-List-Utils-1.53/lib/Scalar/Util.pm 2019-10-24
11:42:03.000000000 +0200
+++ new/Scalar-List-Utils-1.54/lib/Scalar/Util.pm 2020-02-02
16:55:59.000000000 +0100
@@ -17,7 +17,7 @@
dualvar isdual isvstring looks_like_number openhandle readonly set_prototype
tainted
);
-our $VERSION = "1.53";
+our $VERSION = "1.54";
$VERSION =~ tr/_//d;
require List::Util; # List::Util loads the XS
@@ -134,6 +134,11 @@
$obj = bless {}, "Foo";
$type = reftype $obj; # HASH
+Note that for internal reasons, all precompiled regexps (C<qr/.../>) are
+blessed references; thus C<ref()> returns the package name string C<"Regexp">
+on these but C<reftype()> will return the underlying C structure type of
+C<"REGEXP"> in all capitals.
+
=head2 weaken
weaken( $ref );
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Scalar-List-Utils-1.53/lib/Sub/Util.pm
new/Scalar-List-Utils-1.54/lib/Sub/Util.pm
--- old/Scalar-List-Utils-1.53/lib/Sub/Util.pm 2019-10-24 11:42:03.000000000
+0200
+++ new/Scalar-List-Utils-1.54/lib/Sub/Util.pm 2020-02-02 16:55:59.000000000
+0100
@@ -15,7 +15,7 @@
subname set_subname
);
-our $VERSION = "1.53";
+our $VERSION = "1.54";
$VERSION =~ tr/_//d;
require List::Util; # as it has the XS
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Scalar-List-Utils-1.53/t/reduce.t
new/Scalar-List-Utils-1.54/t/reduce.t
--- old/Scalar-List-Utils-1.53/t/reduce.t 2019-10-23 12:05:19.000000000
+0200
+++ new/Scalar-List-Utils-1.54/t/reduce.t 2020-02-02 16:55:59.000000000
+0100
@@ -5,7 +5,7 @@
use List::Util qw(reduce min);
use Test::More;
-plan tests => 30 + ($::PERL_ONLY ? 0 : 2);
+plan tests => 31 + ($::PERL_ONLY ? 0 : 2);
my $v = reduce {};
@@ -144,6 +144,11 @@
} }
+{
+ my @ret = reduce { $a + $b } 1 .. 5;
+ is_deeply( \@ret, [ 15 ], 'reduce in list context yields only final answer'
);
+}
+
# XSUB callback
use constant XSUBC => 42;
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Scalar-List-Utils-1.53/t/reductions.t
new/Scalar-List-Utils-1.54/t/reductions.t
--- old/Scalar-List-Utils-1.53/t/reductions.t 1970-01-01 01:00:00.000000000
+0100
+++ new/Scalar-List-Utils-1.54/t/reductions.t 2020-02-02 16:55:59.000000000
+0100
@@ -0,0 +1,53 @@
+#!./perl
+
+use strict;
+use warnings;
+
+use Test::More;
+
+use List::Util qw( reductions );
+
+is_deeply( [ reductions { } ], [],
+ 'emmpty list'
+);
+
+is_deeply(
+ [ reductions { $a + $b } 1 .. 5 ],
+ [ 1, 3, 6, 10, 15 ],
+ 'sum 1..5'
+);
+
+# We don't guarantee what this will return but it definitely shouldn't crash
+{
+ my $ret = reductions { $a + $b } 1 .. 3;
+ pass( 'reductions in scalar context does not crash' );
+}
+
+my $destroyed_count;
+sub Guardian::DESTROY { $destroyed_count++ }
+
+{
+ undef $destroyed_count;
+
+ my @ret = reductions { $b } map { bless [], "Guardian" } 1 .. 5;
+
+ ok( !$destroyed_count, 'nothing destroyed yet' );
+
+ @ret = ();
+
+ is( $destroyed_count, 5, 'all the items were destroyed' );
+}
+
+{
+ undef $destroyed_count;
+
+ ok( !defined eval {
+ reductions { die "stop" if $b == 4; bless [], "Guardian" } 1 .. 4;
+ 1
+ }, 'die in BLOCK is propagated'
+ );
+
+ is( $destroyed_count, 2, 'intermediate temporaries are destroyed after
exception' );
+}
+
+done_testing;
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Scalar-List-Utils-1.53/t/sample.t
new/Scalar-List-Utils-1.54/t/sample.t
--- old/Scalar-List-Utils-1.53/t/sample.t 1970-01-01 01:00:00.000000000
+0100
+++ new/Scalar-List-Utils-1.54/t/sample.t 2020-02-02 16:55:59.000000000
+0100
@@ -0,0 +1,73 @@
+#!./perl
+
+use strict;
+use warnings;
+
+use Test::More;
+
+use List::Util qw(sample);
+
+{
+ my @items = sample 3, 1 .. 10;
+ is( scalar @items, 3, 'returns correct count when plentiful' );
+
+ @items = sample 10, 1 .. 10;
+ is( scalar @items, 10, 'returns correct count when exact' );
+
+ @items = sample 20, 1 .. 10;
+ is( scalar @items, 10, 'returns correct count when short' );
+}
+
+{
+ my @items = sample 5, 1 .. 5;
+ is_deeply( [ sort { $a <=> $b } @items ], [ 1 .. 5 ],
+ 'returns a permutation of the input list when exact' );
+}
+
+{
+ # These two seeds happen to give different results for me, but there is the
+ # smallest 1-in-2**48 chance that they happen to agree on some platform. If
+ # so then pick a different seed value.
+
+ srand 1234;
+ my $x = join "", sample 3, 'a'..'z';
+
+ srand 5678;
+ my $y = join "", sample 3, 'a'..'z';
+
+ isnt( $x, $y, 'returns different result on different random seed' );
+
+ srand;
+}
+
+{
+ my @nums = ( 1..5 );
+ sample 5, @nums;
+
+ is_deeply( \@nums, [ 1..5 ],
+ 'sample does not mutate passed array'
+ );
+}
+
+{
+ my $destroyed_count;
+ sub Guardian::DESTROY { $destroyed_count++ }
+
+ my @ret = sample 3, map { bless [], "Guardian" } 1 .. 10;
+
+ is( $destroyed_count, 7, 'the 7 unselected items were destroyed' );
+
+ @ret = ();
+
+ is( $destroyed_count, 10, 'all the items were destroyed' );
+}
+
+{
+ local $List::Util::RAND = sub { 4/10 };
+
+ is( join( "", sample 5, 'A'..'Z' ), 'JKALC',
+ 'rigged rand() yields predictable output'
+ );
+}
+
+done_testing;
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Scalar-List-Utils-1.53/t/shuffle.t
new/Scalar-List-Utils-1.54/t/shuffle.t
--- old/Scalar-List-Utils-1.53/t/shuffle.t 2019-10-23 12:05:19.000000000
+0200
+++ new/Scalar-List-Utils-1.54/t/shuffle.t 2020-02-02 16:55:59.000000000
+0100
@@ -3,7 +3,7 @@
use strict;
use warnings;
-use Test::More tests => 6;
+use Test::More tests => 7;
use List::Util qw(shuffle);
@@ -24,3 +24,13 @@
my @s = sort { $a <=> $b } @r;
is( "@in", "@s", 'values');
+
+{
+ local $List::Util::RAND = sub { 4/10 }; # chosen by a fair die
+
+ @r = shuffle(1..10);
+ # This random function happens to always generate the same result
+ is_deeply( \@r, [ 10, 1, 8, 2, 6, 7, 3, 9, 4, 5 ],
+ 'rigged rand() yields predictable output'
+ );
+}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/Scalar-List-Utils-1.53/t/uniq.t
new/Scalar-List-Utils-1.54/t/uniq.t
--- old/Scalar-List-Utils-1.53/t/uniq.t 2019-10-23 12:05:19.000000000 +0200
+++ new/Scalar-List-Utils-1.54/t/uniq.t 2020-02-02 16:55:59.000000000 +0100
@@ -2,8 +2,8 @@
use strict;
use warnings;
-
-use Test::More tests => 33;
+use Config; # to determine nvsize
+use Test::More tests => 39;
use List::Util qw( uniqnum uniqstr uniq );
use Tie::Array;
@@ -87,6 +87,112 @@
'uniqnum distinguishes large floats (stringified)' );
}
+my ($uniq_count1, $uniq_count2, $equiv);
+
+if($Config{nvsize} == 8) {
+ # NV is either 'double' or 8-byte 'long double'
+
+ # The 2 values should be unequal - but just in case perl is buggy:
+ $equiv = 1 if 1.4142135623730951 == 1.4142135623730954;
+
+ $uniq_count1 = uniqnum (1.4142135623730951,
+ 1.4142135623730954 );
+
+ $uniq_count2 = uniqnum('1.4142135623730951',
+ '1.4142135623730954' );
+}
+
+elsif(length(sqrt(2)) > 25) {
+ # NV is either IEEE 'long double' or '__float128' or doubledouble
+
+ if(1 + (2 ** -1074) != 1) {
+ # NV is doubledouble
+
+ # The 2 values should be unequal - but just in case perl is buggy:
+ $equiv = 1 if 1 + (2 ** -1074) == 1 + (2 ** - 1073);
+
+ $uniq_count1 = uniqnum (1 + (2 ** -1074),
+ 1 + (2 ** -1073) );
+ # The 2 values should be unequal - but just in case perl is buggy:
+ $equiv = 1 if 4.0564819207303340847894502572035e31 ==
4.0564819207303340847894502572034e31;
+
+ $uniq_count2 = uniqnum('4.0564819207303340847894502572035e31',
+ '4.0564819207303340847894502572034e31' );
+ }
+
+ else {
+ # NV is either IEEE 'long double' or '__float128'
+
+ # The 2 values should be unequal - but just in case perl is buggy:
+ $equiv = 1 if 1.7320508075688772935274463415058722 ==
1.73205080756887729352744634150587224;
+
+ $uniq_count1 = uniqnum (1.7320508075688772935274463415058722,
+ 1.73205080756887729352744634150587224 );
+
+ $uniq_count2 = uniqnum('1.7320508075688772935274463415058722',
+ '1.73205080756887729352744634150587224' );
+ }
+}
+
+else {
+ # NV is extended precision 'long double'
+
+ # The 2 values should be unequal - but just in case perl is buggy:
+ $equiv = 1 if 2.2360679774997896963 == 2.23606797749978969634;
+
+ $uniq_count1 = uniqnum (2.2360679774997896963,
+ 2.23606797749978969634 );
+
+ $uniq_count2 = uniqnum('2.2360679774997896963',
+ '2.23606797749978969634' );
+}
+
+if($equiv) {
+ is($uniq_count1, 1, 'uniqnum preserves uniqueness of high precision floats');
+ is($uniq_count2, 1, 'uniqnum preserves uniqueness of high precision floats
(stringified)');
+}
+
+else {
+ is($uniq_count1, 2, 'uniqnum preserves uniqueness of high precision floats');
+ is($uniq_count2, 2, 'uniqnum preserves uniqueness of high precision floats
(stringified)');
+}
+
+SKIP: {
+ skip ('test not relevant for this perl configuration', 1) unless
$Config{nvsize} == 8
+ &&
$Config{ivsize} == 8;
+
+ my @in = (~0, ~0 - 1, 18446744073709551614.0, 18014398509481985,
1.8014398509481985e16);
+ my(@correct);
+
+ # On perl-5.6.2 (and perhaps other old versions), ~0 - 1 is assigned to an
NV.
+ # This affects the outcome of the following test, so we need to first
determine
+ # whether ~0 - 1 is an NV or a UV:
+
+ if("$in[1]" eq "1.84467440737096e+19") {
+
+ # It's an NV and $in[2] is a duplicate of $in[1]
+ @correct = (~0, ~0 - 1, 18014398509481985, 1.8014398509481985e16);
+ }
+ else {
+
+ # No duplicates in @in
+ @correct = @in;
+ }
+
+ is_deeply( [ uniqnum @in ],
+ [ @correct ],
+ 'uniqnum correctly compares UV/IVs that overflow NVs' );
+}
+
+my $ls = 31;
+if($Config{ivsize} == 8) { $ls = 63 }
+
+is_deeply( [ uniqnum ( 1 << $ls, 2 ** $ls,
+ 1 << ($ls - 3), 2 ** ($ls - 3),
+ 5 << ($ls - 3), 5 * (2 ** ($ls - 3))) ],
+ [ 1 << $ls, 1 << ($ls - 3), 5 << ($ls -3) ],
+ 'uniqnum correctly compares UV/IVs that don\'t overflow NVs' );
+
# Hard to know for sure what an Inf is going to be. Lets make one
my $Inf = 0 + 1E1000;
my $NaN;
@@ -101,20 +207,43 @@
my $maxint = ~0 >> 1;
my $minint = -(~0 >> 1) - 1;
- my @nums = ($maxuint, $maxuint-1, -1, $Inf, $NaN, $maxint, $minint, 1 );
+ my @nums = ($maxuint, $maxuint-1, -1, $maxint, $minint, 1 );
+
+ {
+ use warnings FATAL => 'numeric';
+ if (eval {
+ "$Inf" + 0 == $Inf
+ }) {
+ push @nums, $Inf;
+ }
+ if (eval {
+ my $nanish = "$NaN" + 0;
+ $nanish != 0 && !$nanish != $NaN;
+ }) {
+ push @nums, $NaN;
+ }
+ }
is_deeply( [ uniqnum @nums, 1.0 ],
[ @nums ],
- 'uniqnum preserves uniqness of full integer range' );
+ 'uniqnum preserves uniqueness of full integer range' );
my @strs = map "$_", @nums;
- skip( "Perl $] doesn't stringify UV_MAX right ($maxuint)", 1 )
- if $maxuint !~ /\A[0-9]+\z/;
+ if($maxuint !~ /\A[0-9]+\z/) {
+ skip( "Perl $] doesn't stringify UV_MAX right ($maxuint)", 1 );
+ }
is_deeply( [ uniqnum @strs, "1.0" ],
[ @strs ],
- 'uniqnum preserves uniqness of full integer range
(stringified)' );
+ 'uniqnum preserves uniqueness of full integer range
(stringified)' );
+}
+
+{
+ my @nums = (6.82132005170133e-38, 62345678);
+ is_deeply( [ uniqnum @nums ], [ @nums ],
+ 'uniqnum keeps uniqueness of numbers that stringify to the same byte
pattern as a float'
+ );
}
{
@@ -132,6 +261,10 @@
'uniqnum on undef coerces to zero' );
}
+is_deeply( [uniqnum 0, -0.0 ],
+ [0],
+ 'uniqnum handles negative zero');
+
is_deeply( [ uniq () ],
[],
'uniq of empty list' );
