Update to Scalar-List-Utils-1.22 from CPAN

11 files changed, 68 insertions, 17 deletions

diff --git a/cpan/List-Util/Changes b/cpan/List-Util/Changes
index 737b94dd68..8f71596e13 100644
--- a/cpan/List-Util/Changes
+++ b/cpan/List-Util/Changes
@@ -1,3 +1,11 @@
+1.22 -- Sat Nov 14 09:26:15 CST 2009
+
+  * silence a compiler warning about an unreferenced local variable [Steve Hay]
+  * RT#51484 Preserve utf8 flag of string passed to dualvar()
+  * RT#51454 Check first argument to first/reduce is a code reference
+  * RT#50528 [PATCH] p_tainted.t fix for VMS [Craig A. Berry]
+  * RT#48550 fix pure perl looks_like_number not to match non-ascii digits
+
 1.21 -- Mon May 18 10:32:14 CDT 2009
 
   * Change build system for perl-only install not to need to modify blib
diff --git a/cpan/List-Util/ListUtil.xs b/cpan/List-Util/ListUtil.xs
index c2f69a6b56..dfde039fb6 100644
--- a/cpan/List-Util/ListUtil.xs
+++ b/cpan/List-Util/ListUtil.xs
@@ -194,7 +194,6 @@ CODE:
     SV *sv;
     SV *retsv = NULL;
     int index;
-    int magic;
     NV retval = 0;
     if(!items) {
 	XSRETURN_UNDEF;
@@ -334,6 +333,9 @@ CODE:
 	XSRETURN_UNDEF;
     }
     cv = sv_2cv(block, &stash, &gv, 0);
+    if (cv == Nullcv) {
+       croak("Not a subroutine reference");
+    }
     PUSH_MULTICALL(cv);
     SAVESPTR(GvSV(PL_defgv));
 
@@ -406,6 +408,8 @@ CODE:
     ST(0) = sv_newmortal();
     (void)SvUPGRADE(ST(0),SVt_PVNV);
     sv_setpvn(ST(0),ptr,len);
+    if (SvUTF8(str))
+        SvUTF8_on(ST(0));
     if(SvNOK(num) || SvPOK(num) || SvMAGICAL(num)) {
 	SvNV_set(ST(0), SvNV(num));
 	SvNOK_on(ST(0));
diff --git a/cpan/List-Util/lib/List/Util.pm b/cpan/List-Util/lib/List/Util.pm
index 426a7a3b8d..2b51a69d79 100644
--- a/cpan/List-Util/lib/List/Util.pm
+++ b/cpan/List-Util/lib/List/Util.pm
@@ -14,7 +14,7 @@ require Exporter;
 
 @ISA        = qw(Exporter);
 @EXPORT_OK  = qw(first min max minstr maxstr reduce sum shuffle);
-$VERSION    = "1.21";
+$VERSION    = "1.22";
 $XS_VERSION = $VERSION;
 $VERSION    = eval $VERSION;
 
diff --git a/cpan/List-Util/lib/List/Util/PP.pm b/cpan/List-Util/lib/List/Util/PP.pm
index 7fa2a55a21..425f1c5015 100644
--- a/cpan/List-Util/lib/List/Util/PP.pm
+++ b/cpan/List-Util/lib/List/Util/PP.pm
@@ -13,12 +13,14 @@ require Exporter;
 
 @ISA     = qw(Exporter);
 @EXPORT  = qw(first min max minstr maxstr reduce sum shuffle);
-$VERSION = "1.21";
+$VERSION = "1.22";
 $VERSION = eval $VERSION;
 
 sub reduce (&@) {
   my $code = shift;
-  unless(ref($code)) {
+  require Scalar::Util;
+  my $type = Scalar::Util::reftype($code);
+  unless($type and $type eq 'CODE') {
     require Carp;
     Carp::croak("Not a subroutine reference");
   }
@@ -43,6 +45,12 @@ sub reduce (&@) {
 
 sub first (&@) {
   my $code = shift;
+  require Scalar::Util;
+  my $type = Scalar::Util::reftype($code);
+  unless($type and $type eq 'CODE') {
+    require Carp;
+    Carp::croak("Not a subroutine reference");
+  }
 
   foreach (@_) {
     return $_ if &{$code}();
diff --git a/cpan/List-Util/lib/List/Util/XS.pm b/cpan/List-Util/lib/List/Util/XS.pm
index 01ad27ac12..76bf6469c4 100644
--- a/cpan/List-Util/lib/List/Util/XS.pm
+++ b/cpan/List-Util/lib/List/Util/XS.pm
@@ -3,7 +3,7 @@ use strict;
 use vars qw($VERSION);
 use List::Util;
 
-$VERSION = "1.21";           # FIXUP
+$VERSION = "1.22";           # FIXUP
 $VERSION = eval $VERSION;    # FIXUP
 
 sub _VERSION { # FIXUP
diff --git a/cpan/List-Util/lib/Scalar/Util.pm b/cpan/List-Util/lib/Scalar/Util.pm
index db7b20c5c6..24f146f2b3 100644
--- a/cpan/List-Util/lib/Scalar/Util.pm
+++ b/cpan/List-Util/lib/Scalar/Util.pm
@@ -13,7 +13,7 @@ require List::Util; # List::Util loads the XS
 
 @ISA       = qw(Exporter);
 @EXPORT_OK = qw(blessed dualvar reftype weaken isweak tainted readonly openhandle refaddr isvstring looks_like_number set_prototype);
-$VERSION    = "1.21";
+$VERSION    = "1.22";
 $VERSION   = eval $VERSION;
 
 unless (defined &dualvar) {
diff --git a/cpan/List-Util/lib/Scalar/Util/PP.pm b/cpan/List-Util/lib/Scalar/Util/PP.pm
index 0b7f7994ba..e94fe86f21 100644
--- a/cpan/List-Util/lib/Scalar/Util/PP.pm
+++ b/cpan/List-Util/lib/Scalar/Util/PP.pm
@@ -16,7 +16,7 @@ use B qw(svref_2object);
 
 @ISA     = qw(Exporter);
 @EXPORT  = qw(blessed reftype tainted readonly refaddr looks_like_number);
-$VERSION = "1.21";
+$VERSION = "1.22";
 $VERSION = eval $VERSION;
 
 sub blessed ($) {
@@ -98,8 +98,8 @@ sub looks_like_number {
     require overload;
     return overload::Overloaded($_) ? defined(0 + $_) : 0;
   }
-  return 1 if (/^[+-]?\d+$/); # is a +/- integer
-  return 1 if (/^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/); # a C float
+  return 1 if (/^[+-]?[0-9]+$/); # is a +/- integer
+  return 1 if (/^([+-]?)(?=[0-9]|\.[0-9])[0-9]*(\.[0-9]*)?([Ee]([+-]?[0-9]+))?$/); # a C float
   return 1 if ($] >= 5.008 and /^(Inf(inity)?|NaN)$/i) or ($] >= 5.006001 and /^Inf$/i);
 
   0;
diff --git a/cpan/List-Util/t/dualvar.t b/cpan/List-Util/t/dualvar.t
index fab3691a32..5c0fe2140b 100644
--- a/cpan/List-Util/t/dualvar.t
+++ b/cpan/List-Util/t/dualvar.t
@@ -16,7 +16,7 @@ BEGIN {
 use Scalar::Util ();
 use Test::More  (grep { /dualvar/ } @Scalar::Util::EXPORT_FAIL)
 			? (skip_all => 'dualvar requires XS version')
-			: (tests => 11);
+			: (tests => 13);
 
 Scalar::Util->import('dualvar');
 
@@ -49,13 +49,22 @@ SKIP: {
   ok( $var > 0,		'UV 2');
 }
 
+
+{
+  package Tied;
+
+  sub TIESCALAR { bless {} }
+  sub FETCH { 7.5 }
+}
+
 tie my $tied, 'Tied';
 $var = dualvar($tied, "ok");
 ok($var == 7.5,		'Tied num');
 ok($var eq 'ok',	'Tied str');
 
-package Tied;
-
-sub TIESCALAR { bless {} }
-sub FETCH { 7.5 }
 
+SKIP: {
+  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');
+}
diff --git a/cpan/List-Util/t/first.t b/cpan/List-Util/t/first.t
index 07377ab340..1378c39044 100644
--- a/cpan/List-Util/t/first.t
+++ b/cpan/List-Util/t/first.t
@@ -15,7 +15,7 @@ BEGIN {
 
 use List::Util qw(first);
 use Test::More;
-plan tests => ($::PERL_ONLY ? 15 : 17);
+plan tests => 19 + ($::PERL_ONLY ? 0 : 2);
 my $v;
 
 ok(defined &first,	'defined');
@@ -113,3 +113,13 @@ if (!$::PERL_ONLY) { SKIP: {
     like($@, qr/^Can't goto subroutine from a sort sub/, "goto sub");
 
 } }
+
+eval { &first(1,2) };
+ok($@ =~ /^Not a subroutine reference/, 'check for code reference');
+eval { &first(qw(a b)) };
+ok($@ =~ /^Not a subroutine reference/, 'check for code reference');
+eval { &first([],1,2,3) };
+ok($@ =~ /^Not a subroutine reference/, 'check for code reference');
+eval { &first(+{},1,2,3) };
+ok($@ =~ /^Not a subroutine reference/, 'check for code reference');
+
diff --git a/cpan/List-Util/t/lln.t b/cpan/List-Util/t/lln.t
index d31633be6f..1499cdb49d 100644
--- a/cpan/List-Util/t/lln.t
+++ b/cpan/List-Util/t/lln.t
@@ -14,7 +14,7 @@ BEGIN {
 }
 
 use strict;
-use Test::More tests => 18;
+use Test::More tests => 19;
 use Scalar::Util qw(looks_like_number);
 
 foreach my $num (qw(1 -1 +1 1.0 +1.0 -1.0 -1.0e-12)) {
@@ -43,4 +43,6 @@ tie %foo, 'Foo';
 is(!!looks_like_number($foo{'abc'}),	    '',			'Tied');
 is(!!looks_like_number($foo{'123'}),	    1,			'Tied');
 
+is(!!looks_like_number("\x{1815}"),	   '',			'MONGOLIAN DIGIT FIVE');
+
 # We should copy some of perl core tests like t/base/num.t here
diff --git a/cpan/List-Util/t/reduce.t b/cpan/List-Util/t/reduce.t
index 5d6e3d942c..2e1257521c 100644
--- a/cpan/List-Util/t/reduce.t
+++ b/cpan/List-Util/t/reduce.t
@@ -16,7 +16,7 @@ BEGIN {
 
 use List::Util qw(reduce min);
 use Test::More;
-plan tests => ($::PERL_ONLY ? 23 : 25);
+plan tests => 27 + ($::PERL_ONLY ? 0 : 2);
 
 my $v = reduce {};
 
@@ -150,3 +150,13 @@ if (!$::PERL_ONLY) { SKIP: {
     like($@, qr/^Can't goto subroutine from a sort sub/, "goto sub");
 
 } }
+
+eval { &reduce(1,2) };
+ok($@ =~ /^Not a subroutine reference/, 'check for code reference');
+eval { &reduce(qw(a b)) };
+ok($@ =~ /^Not a subroutine reference/, 'check for code reference');
+eval { &reduce([],1,2,3) };
+ok($@ =~ /^Not a subroutine reference/, 'check for code reference');
+eval { &reduce(+{},1,2,3) };
+ok($@ =~ /^Not a subroutine reference/, 'check for code reference');
+