FAQ
In perl.git, the branch blead has been updated

<http://perl5.git.perl.org/perl.git/commitdiff/e8164ee76be9fe457e58508afccf20abb0cc4008?hp=c7cd1ed9f82c9c90c5be7e254ba04292d7f07e73>

- Log -----------------------------------------------------------------
commit e8164ee76be9fe457e58508afccf20abb0cc4008
Author: Jarkko Hietaniemi <jhi@iki.fi>
Date: Sun May 15 18:32:03 2016 -0400

     Upgrade to Scalar-List-Utils 1.45 from CPAN
-----------------------------------------------------------------------

Summary of changes:
  MANIFEST | 2 +
  Porting/Maintainers.pl | 14 +-
  cpan/Scalar-List-Utils/ListUtil.xs | 224 ++++++++++++++++++++++++++---
  cpan/Scalar-List-Utils/Makefile.PL | 17 ++-
  cpan/Scalar-List-Utils/lib/List/Util.pm | 131 +++++++++++++++--
  cpan/Scalar-List-Utils/lib/List/Util/XS.pm | 3 +-
  cpan/Scalar-List-Utils/lib/Scalar/Util.pm | 30 ++--
  cpan/Scalar-List-Utils/lib/Sub/Util.pm | 2 +-
  cpan/Scalar-List-Utils/t/product.t | 38 ++++-
  cpan/Scalar-List-Utils/t/rt-96343.t | 35 +++++
  cpan/Scalar-List-Utils/t/sum.t | 12 +-
  cpan/Scalar-List-Utils/t/uniq.t | 213 +++++++++++++++++++++++++++
  t/porting/customized.dat | 6 -
  13 files changed, 648 insertions(+), 79 deletions(-)
  create mode 100644 cpan/Scalar-List-Utils/t/rt-96343.t
  create mode 100644 cpan/Scalar-List-Utils/t/uniq.t

diff --git a/MANIFEST b/MANIFEST
index cc7d29c..233dfad 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -2215,6 +2215,7 @@ cpan/Scalar-List-Utils/t/readonly.t Scalar::Util
  cpan/Scalar-List-Utils/t/reduce.t List::Util
  cpan/Scalar-List-Utils/t/refaddr.t Scalar::Util
  cpan/Scalar-List-Utils/t/reftype.t Scalar::Util
+cpan/Scalar-List-Utils/t/rt-96343.t Scalar::Util
  cpan/Scalar-List-Utils/t/scalarutil-proto.t
  cpan/Scalar-List-Utils/t/shuffle.t List::Util
  cpan/Scalar-List-Utils/t/stack-corruption.t List::Util
@@ -2222,6 +2223,7 @@ cpan/Scalar-List-Utils/t/subname.t
  cpan/Scalar-List-Utils/t/sum0.t
  cpan/Scalar-List-Utils/t/sum.t List::Util
  cpan/Scalar-List-Utils/t/tainted.t Scalar::Util
+cpan/Scalar-List-Utils/t/uniq.t Scalar::Util
  cpan/Scalar-List-Utils/t/weak.t Scalar::Util
  cpan/Socket/Makefile.PL Socket extension makefile writer
  cpan/Socket/Socket.pm Socket extension Perl module
diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl
index e6b63bd..231b71f 100755
--- a/Porting/Maintainers.pl
+++ b/Porting/Maintainers.pl
@@ -986,20 +986,8 @@ use File::Glob qw(:case);
      },

      'Scalar-List-Utils' => {
- 'DISTRIBUTION' => 'PEVANS/Scalar-List-Utils-1.42.tar.gz',
+ 'DISTRIBUTION' => 'PEVANS/Scalar-List-Utils-1.45.tar.gz',
          'FILES' => q[cpan/Scalar-List-Utils],
- # Waiting to be merged upstream:
- # https://github.com/Scalar-List-Utils/Scalar-List-Utils/pull/24
- # https://rt.cpan.org/Public/Bug/Display.html?id=105415
- 'CUSTOMIZED' => [
- qw( ListUtil.xs
- lib/List/Util.pm
- lib/List/Util/XS.pm
- lib/Scalar/Util.pm
- lib/Sub/Util.pm
- t/product.t
- )
- ],
      },

      'Search::Dict' => {
diff --git a/cpan/Scalar-List-Utils/ListUtil.xs b/cpan/Scalar-List-Utils/ListUtil.xs
index 04dca10..9b0384a 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 5068e34..247b3b7 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 75866aa..c256696 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 fca0738..0a9ad49 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 99a536d..d2db167 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 1bf5878..6780163 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 38c923b..1aad877 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 0000000..5328a41
--- /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 7a12813..4639a8a 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 0000000..5a6925d
--- /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'
+ );
+}
diff --git a/t/porting/customized.dat b/t/porting/customized.dat
index b2f65e0..d63ecc2 100644
--- a/t/porting/customized.dat
+++ b/t/porting/customized.dat
@@ -40,12 +40,6 @@ File::Path cpan/File-Path/lib/File/Path.pm fd8ce4420a0c113d3f47dd3223859743655c1
  File::Path cpan/File-Path/t/Path_win32.t 94b9276557ce7f80b91f6fd9bfa7a0cd9bf9683e
  Math::BigRat cpan/Math-BigRat/lib/Math/BigRat.pm 6eabc68e04f67694f6fe523e64eb013fc337ca5b
  Pod::Perldoc cpan/Pod-Perldoc/lib/Pod/Perldoc.pm fe0bc906fb74b69cfd3fb289316ba669d770d465
-Scalar-List-Utils cpan/Scalar-List-Utils/lib/List/Util.pm 3b501b7332480b34929bc4df5d48581df3307267
-Scalar-List-Utils cpan/Scalar-List-Utils/lib/List/Util/XS.pm ebd169113d3df79d31ad5535dbd7a538a8c14fd2
-Scalar-List-Utils cpan/Scalar-List-Utils/lib/Scalar/Util.pm def601405bac7a4d6690b8c4207e0f05d65eb4ca
-Scalar-List-Utils cpan/Scalar-List-Utils/lib/Sub/Util.pm 1187d6cd9bccf1264bd53b3a65ea96fad7520068
-Scalar-List-Utils cpan/Scalar-List-Utils/ListUtil.xs 6128584ecb0ae69bb21b16b22daceeffc92df9d9
-Scalar-List-Utils cpan/Scalar-List-Utils/t/product.t 99bf424804f055b99ff2a18b7dcf25bb8b6d2463
  Socket cpan/Socket/Socket.pm 98e38176d745c38282907f391c077298f5a3d0ba
  Socket cpan/Socket/Socket.xs edd4fed212785f11c5c2095a75941dad27d586d9
  autodie cpan/autodie/t/mkdir.t 9e70d2282a3cc7d76a78bf8144fccba20fb37dac

--
Perl5 Master Repository

Search Discussions

Related Discussions

Discussion Navigation
viewthread | post
posts ‹ prev | 1 of 1 | next ›
Discussion Overview
groupperl5-changes @
categoriesperl
postedMay 15, '16 at 10:47p
activeMay 15, '16 at 10:47p
posts1
users1
websiteperl.org

1 user in discussion

Jarkko Hietaniemi: 1 post

People

Translate

site design / logo © 2017 Grokbase