Upgrade Scalar-List-Utils from version 1.33 to 1.34

7 files changed, 96 insertions, 47 deletions

diff --git a/cpan/List-Util/Changes b/cpan/List-Util/Changes
index 2c1de4d2af..b86e3040df 100644
--- a/cpan/List-Util/Changes
+++ b/cpan/List-Util/Changes
@@ -1,3 +1,10 @@
+1.34 -- Wed Oct 16 13:04 UTC 2013
+
+  * Avoid C99/C++-style comments in XS code
+  * Fix dualvar tests for perl 5.6; fix skip() test counts in dualvar.t
+  * Neater documentation examples of other functions that can be built using
+    reduce
+
 1.33 -- Sun Oct 13 01:35 UTC 2013
 
   * Added any, all, none, notall list reduction functions
diff --git a/cpan/List-Util/ListUtil.xs b/cpan/List-Util/ListUtil.xs
index f99c4cbce3..d3322800a9 100644
--- a/cpan/List-Util/ListUtil.xs
+++ b/cpan/List-Util/ListUtil.xs
@@ -412,7 +412,7 @@ PPCODE:
     HV *stash;
     CV *cv    = sv_2cv(block, &stash, &gv, 0);
     I32 ret_gimme = GIMME_V;
-    int argi = 1; // "shift" the block
+    int argi = 1; /* "shift" the block */
 
     if(!(items % 2) && ckWARN(WARN_MISC))
 	warn("Odd number of elements in pairfirst");
@@ -423,7 +423,7 @@ PPCODE:
     SAVESPTR(GvSV(bgv));
 #ifdef dMULTICALL
     if(!CvISXSUB(cv)) {
-	// Since MULTICALL is about to move it
+	/* Since MULTICALL is about to move it */
 	SV **stack = PL_stack_base + ax;
 
 	dMULTICALL;
@@ -494,7 +494,7 @@ PPCODE:
     /* This function never returns more than it consumed in arguments. So we
      * can build the results "live", behind the arguments
      */
-    int argi = 1; // "shift" the block
+    int argi = 1; /* "shift" the block */
     int reti = 0;
 
     if(!(items % 2) && ckWARN(WARN_MISC))
@@ -506,7 +506,7 @@ PPCODE:
     SAVESPTR(GvSV(bgv));
 #ifdef dMULTICALL
     if(!CvISXSUB(cv)) {
-	// Since MULTICALL is about to move it
+	/* Since MULTICALL is about to move it */
 	SV **stack = PL_stack_base + ax;
 	int i;
 
@@ -522,7 +522,7 @@ PPCODE:
 
             if(SvTRUEx(*PL_stack_sp)) {
 		if(ret_gimme == G_ARRAY) {
-		    // We can't mortalise yet or they'd be mortal too early
+		    /* We can't mortalise yet or they'd be mortal too early */
 		    stack[reti++] = newSVsv(a);
 		    stack[reti++] = newSVsv(b);
 		}
@@ -580,7 +580,7 @@ PPCODE:
     SV **args_copy = NULL;
     I32 ret_gimme = GIMME_V;
 
-    int argi = 1; // "shift" the block
+    int argi = 1; /* "shift" the block */
     int reti = 0;
 
     if(!(items % 2) && ckWARN(WARN_MISC))
@@ -595,7 +595,7 @@ PPCODE:
  */
 #if defined(dMULTICALL) && (PERL_BCDVERSION > 0x5010000 || PERL_BCDVERSION < 0x5008009)
     if(!CvISXSUB(cv)) {
-	// Since MULTICALL is about to move it
+	/* Since MULTICALL is about to move it */
 	SV **stack = PL_stack_base + ax;
 	I32 ret_gimme = GIMME_V;
 	int i;
diff --git a/cpan/List-Util/lib/List/Util.pm b/cpan/List-Util/lib/List/Util.pm
index 988ed72b28..067b60cdda 100644
--- a/cpan/List-Util/lib/List/Util.pm
+++ b/cpan/List-Util/lib/List/Util.pm
@@ -4,7 +4,7 @@
 # This program is free software; you can redistribute it and/or
 # modify it under the same terms as Perl itself.
 #
-# This module is normally only loaded if the XS module is not available
+# Maintained since 2013 by Paul Evans <leonerd@leonerd.org.uk>
 
 package List::Util;
 
@@ -16,7 +16,7 @@ our @EXPORT_OK  = qw(
   all any first min max minstr maxstr none notall reduce sum sum0 shuffle
   pairmap pairgrep pairfirst pairs pairkeys pairvalues
 );
-our $VERSION    = "1.33";
+our $VERSION    = "1.34";
 our $XS_VERSION = $VERSION;
 $VERSION    = eval $VERSION;
 
@@ -83,11 +83,28 @@ Returns the result of the last call to BLOCK. If LIST is empty then
 C<undef> is returned. If LIST only contains one element then that
 element is returned and BLOCK is not executed.
 
+The following examples all demonstrate how C<reduce> could be used to
+implement the other list-reduction functions in this module. (They are
+not in fact implemented like this, but instead in a more efficient
+manner in individual C functions).
+
+    $foo = reduce { defined($a)            ? $a :
+                    $code->(local $_ = $b) ? $b :
+                                             undef } undef, @list # first
+
+    $foo = reduce { $a > $b ? $a : $b } 1..10       # max
+    $foo = reduce { $a gt $b ? $a : $b } 'A'..'Z'   # maxstr
     $foo = reduce { $a < $b ? $a : $b } 1..10       # min
     $foo = reduce { $a lt $b ? $a : $b } 'aa'..'zz' # minstr
     $foo = reduce { $a + $b } 1 .. 10               # sum
     $foo = reduce { $a . $b } @bar                  # concat
 
+    $foo = reduce { $a || $code->(local $_ = $b) } 0, @bar   # any
+    $foo = reduce { $a && $code->(local $_ = $b) } 1, @bar   # all
+    $foo = reduce { $a && !$code->(local $_ = $b) } 1, @bar  # none
+    $foo = reduce { $a || !$code->(local $_ = $b) } 0, @bar  # notall
+       # Note that these implementations do not fully short-circuit
+
 If your algorithm requires that C<reduce> produce an identity value, then
 make sure that you always pass that identity value as the first argument to prevent
 C<undef> being returned
@@ -136,13 +153,6 @@ C<undef> is returned.
     $foo = first { $_ > $value } @list    # first value in @list which
                                           # is greater than $value
 
-This function could be implemented using C<reduce> like this
-
-    $foo = reduce { defined($a) ? $a : wanted($b) ? $b : undef } undef, @list
-
-for example wanted() could be defined() which would return the first
-defined value in @list
-
 =head2 max LIST
 
 Returns the entry in the list with the highest numerical value. If the
@@ -152,10 +162,6 @@ list is empty then C<undef> is returned.
     $foo = max 3,9,12               # 12
     $foo = max @bar, @baz           # whatever
 
-This function could be implemented using C<reduce> like this
-
-    $foo = reduce { $a > $b ? $a : $b } 1..10
-
 =head2 maxstr LIST
 
 Similar to C<max>, but treats all the entries in the list as strings
@@ -166,10 +172,6 @@ If the list is empty then C<undef> is returned.
     $foo = maxstr "hello","world"   # "world"
     $foo = maxstr @bar, @baz        # whatever
 
-This function could be implemented using C<reduce> like this
-
-    $foo = reduce { $a gt $b ? $a : $b } 'A'..'Z'
-
 =head2 min LIST
 
 Similar to C<max> but returns the entry in the list with the lowest
@@ -179,10 +181,6 @@ numerical value. If the list is empty then C<undef> is returned.
     $foo = min 3,9,12               # 3
     $foo = min @bar, @baz           # whatever
 
-This function could be implemented using C<reduce> like this
-
-    $foo = reduce { $a < $b ? $a : $b } 1..10
-
 =head2 minstr LIST
 
 Similar to C<min>, but treats all the entries in the list as strings
@@ -193,10 +191,6 @@ If the list is empty then C<undef> is returned.
     $foo = minstr "hello","world"   # "hello"
     $foo = minstr @bar, @baz        # whatever
 
-This function could be implemented using C<reduce> like this
-
-    $foo = reduce { $a lt $b ? $a : $b } 'A'..'Z'
-
 =head2 sum LIST
 
 Returns the sum of all the elements in LIST. If LIST is empty then
@@ -206,10 +200,6 @@ C<undef> is returned.
     $foo = sum 3,9,12               # 24
     $foo = sum @bar, @baz           # whatever
 
-This function could be implemented using C<reduce> like this
-
-    $foo = reduce { $a + $b } 1..10
-
 =head2 sum0 LIST
 
 Similar to C<sum>, except this returns 0 when given an empty list, rather
diff --git a/cpan/List-Util/lib/List/Util/XS.pm b/cpan/List-Util/lib/List/Util/XS.pm
index c479d1eb31..f0c34a864b 100644
--- a/cpan/List-Util/lib/List/Util/XS.pm
+++ b/cpan/List-Util/lib/List/Util/XS.pm
@@ -2,7 +2,7 @@ package List::Util::XS;
 use strict;
 use List::Util;
 
-our $VERSION = "1.33";       # FIXUP
+our $VERSION = "1.34";       # FIXUP
 $VERSION = eval $VERSION;    # FIXUP
 
 1;
diff --git a/cpan/List-Util/lib/Scalar/Util.pm b/cpan/List-Util/lib/Scalar/Util.pm
index 314da0e148..14420b2082 100644
--- a/cpan/List-Util/lib/Scalar/Util.pm
+++ b/cpan/List-Util/lib/Scalar/Util.pm
@@ -3,6 +3,8 @@
 # Copyright (c) 1997-2007 Graham Barr <gbarr@pobox.com>. All rights reserved.
 # This program is free software; you can redistribute it and/or
 # modify it under the same terms as Perl itself.
+#
+# Maintained since 2013 by Paul Evans <leonerd@leonerd.org.uk>
 
 package Scalar::Util;
 
@@ -26,7 +28,7 @@ our @EXPORT_OK = qw(
   tainted
   weaken
 );
-our $VERSION    = "1.33";
+our $VERSION    = "1.34";
 $VERSION   = eval $VERSION;
 
 our @EXPORT_FAIL;
diff --git a/cpan/List-Util/t/any-all.t b/cpan/List-Util/t/any-all.t
new file mode 100644
index 0000000000..6fbf89a6ec
--- /dev/null
+++ b/cpan/List-Util/t/any-all.t
@@ -0,0 +1,33 @@
+#!./perl
+
+BEGIN {
+    unless (-d 'blib') {
+	chdir 't' if -d 't';
+	@INC = '../lib';
+	require Config; import Config;
+	keys %Config; # Silence warning
+	if ($Config{extensions} !~ /\bList\/Util\b/) {
+	    print "1..0 # Skip: List::Util was not built\n";
+	    exit 0;
+	}
+    }
+}
+
+use List::Util qw(any all notall none);
+use Test::More tests => 12;
+
+ok(  (any { $_ == 1 } 1, 2, 3), 'any true' );
+ok( !(any { $_ == 1 } 2, 3, 4), 'any false' );
+ok( !(any { 1 }), 'any empty list' );
+
+ok(  (all { $_ == 1 } 1, 1, 1), 'all true' );
+ok( !(all { $_ == 1 } 1, 2, 3), 'all false' );
+ok(  (all { 1 }), 'all empty list' );
+
+ok(  (notall { $_ == 1 } 1, 2, 3), 'notall true' );
+ok( !(notall { $_ == 1 } 1, 1, 1), 'notall false' );
+ok( !(notall { 1 }), 'notall empty list' );
+
+ok(  (none { $_ == 1 } 2, 3, 4), 'none true' );
+ok( !(none { $_ == 1 } 1, 2, 3), 'none false' );
+ok(  (none { 1 }), 'none empty list' );
diff --git a/cpan/List-Util/t/dualvar.t b/cpan/List-Util/t/dualvar.t
index abd6479001..0943c75545 100644
--- a/cpan/List-Util/t/dualvar.t
+++ b/cpan/List-Util/t/dualvar.t
@@ -49,7 +49,7 @@ ok( isdual($var),	'Is a dualvar');
 ok( $var == $numstr,	'NV');
 
 SKIP: {
-  skip("dualvar with UV value known to fail with $]",2) if $] < 5.006_001;
+  skip("dualvar with UV value known to fail with $]",3) if $] < 5.006_001;
   my $bits = ($Config{'use64bitint'}) ? 63 : 31;
   $var = dualvar(1<<$bits, "");
   ok( isdual($var),		'Is a dualvar');
@@ -78,22 +78,38 @@ ok($var eq 'ok',	'Tied str');
 
 
 SKIP: {
-  skip("need utf8::is_utf8",3) unless defined &utf8::is_utf8;
+  skip("need utf8::is_utf8",2) unless defined &utf8::is_utf8;
   ok(!!utf8::is_utf8(dualvar(1,chr(400))), 'utf8');
   ok( !utf8::is_utf8(dualvar(1,"abc")),    'not utf8');
 }
 
+BEGIN {
+  if($Config{'useithreads'}) {
+    require threads; import threads;
+    require threads::shared; import threads::shared;
+    require constant; import constant HAVE_THREADS => 1;
+  }
+  else {
+    require constant; import constant HAVE_THREADS => 0;
+  }
+}
 
 SKIP: {
-  skip("Perl not compiled with 'useithreads'",20) unless ($Config{'useithreads'});
-  require threads; import threads;
-  require threads::shared; import threads::shared;
+  skip("Perl not compiled with 'useithreads'",20) unless HAVE_THREADS;
   skip("Requires threads::shared v1.42 or later",20) unless ($threads::shared::VERSION >= 1.42);
 
-  my $siv :shared = dualvar(42, 'Fourty-Two');
-  my $snv :shared = dualvar(3.14, 'PI');
+  my $siv;
+  share($siv);
+  $siv = dualvar(42, 'Fourty-Two');
+
+  my $snv;
+  share($snv);
+  $snv = dualvar(3.14, 'PI');
+
+  my $suv;
+  share($suv);
   my $bits = ($Config{'use64bitint'}) ? 63 : 31;
-  my $suv :shared = dualvar(1<<$bits, 'Large unsigned int');
+  $suv = dualvar(1<<$bits, 'Large unsigned int');
 
   ok($siv == 42, 'Shared IV number preserved');
   ok($siv eq 'Fourty-Two', 'Shared string preserved');
@@ -106,7 +122,8 @@ SKIP: {
   ok($suv eq 'Large unsigned int', 'Shared string preserved');
   ok(isdual($suv), 'Is a dualvar');
 
-  my @ary :shared;
+  my @ary;
+  share(@ary);
   $ary[0] = $siv;
   $ary[1] = $snv;
   $ary[2] = $suv;