Update to Scalar-List-Utils-1.17
Graham Barr [Mon, 23 May 2005 13:49:59 +0000 (13:49 +0000)]
p4raw-id: //depot/perl@24551

ext/List/Util/Changes
ext/List/Util/README
ext/List/Util/lib/List/Util.pm
ext/List/Util/lib/Scalar/Util.pm
ext/List/Util/t/lln.t
ext/List/Util/t/p_tainted.t
ext/List/Util/t/refaddr.t

index bbf8abe..4fbdc8b 100644 (file)
@@ -1,3 +1,15 @@
+1.17 -- Mon May 23 08:55:26 CDT 2005
+
+Bug Fixes
+  * Update XS code to declare PERL_UNUSED_DECL conditionally
+
+1.16 -- Fri May 20 10:22:49 CDT 2005
+
+Bug Fixes
+  * Change to refaddr.t test to avoid false errors on some 64 bit platforms
+  * Fix all perl only tests to work when in the core build environment
+  * Fix looks like number test to work for 5.8.5 and above
 1.15 -- Fri May 13 11:01:15 CDT 2005
 
 Bug Fixes
index 8d95b57..e41de55 100644 (file)
@@ -33,6 +33,6 @@ There is a bug in perl5.6.0 with UV's that are >= 1<<31. This will
 show up as tests 8 and 9 of dualvar.t failing
 
 
-Copyright (c) 1997-2004 Graham Barr <gbarr@pobox.com>. All rights reserved.
+Copyright (c) 1997-2005 Graham Barr <gbarr@pobox.com>. All rights reserved.
 This library is free software; you can redistribute it and/or
 modify it under the same terms as Perl itself.
index fc69ea2..55696ad 100644 (file)
@@ -10,7 +10,7 @@ require Exporter;
 
 @ISA        = qw(Exporter);
 @EXPORT_OK  = qw(first min max minstr maxstr reduce sum shuffle);
-$VERSION    = "1.15";
+$VERSION    = "1.17";
 $XS_VERSION = $VERSION;
 $VERSION    = eval $VERSION;
 
index d8b1625..36476b3 100644 (file)
@@ -11,7 +11,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.15";
+$VERSION    = "1.17";
 $VERSION   = eval $VERSION;
 
 sub export_fail {
@@ -68,7 +68,8 @@ sub blessed ($) {
 sub refaddr($) {
   my $pkg = ref($_[0]) or return undef;
   bless $_[0], 'Scalar::Util::Fake';
-  my $i = int($_[0]);
+  "$_[0]" =~ /0x(\w+)/;
+  my $i = do { local $^W; hex $1 };
   bless $_[0], $pkg;
   $i;
 }
@@ -122,7 +123,7 @@ sub looks_like_number {
   local $_ = shift;
 
   # checks from perlfaq4
-  return $] < 5.009002 unless defined;
+  return $] < 5.008005 unless defined;
   return 1 if (/^[+-]?\d+$/); # is a +/- integer
   return 1 if (/^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/); # a C float
   return 1 if ($] >= 5.008 and /^(Inf(inity)?|NaN)$/i) or ($] >= 5.006001 and /^Inf$/i);
index 0324d7b..5b9661f 100644 (file)
@@ -25,6 +25,6 @@ is(!!looks_like_number("Inf"),            $] >= 5.006001,     'Inf');
 is(!!looks_like_number("Infinity"), $] >= 5.008,       'Infinity');
 is(!!looks_like_number("NaN"),     $] >= 5.008,        'NaN');
 is(!!looks_like_number("foo"),     '',                 'foo');
-is(!!looks_like_number(undef),     $] < 5.009002,      'undef');
+is(!!looks_like_number(undef),     $] < 5.008005,      'undef');
 
 # We should copy some of perl core tests like t/base/num.t here
index 9f2e33f..6196729 100644 (file)
@@ -3,5 +3,32 @@
 # force perl-only version to be tested
 sub List::Util::bootstrap {}
 
-(my $f = __FILE__) =~ s/p_//;
-do $f;
+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 Test::More tests => 4;
+
+use Scalar::Util qw(tainted);
+
+ok( !tainted(1), 'constant number');
+
+my $var = 2;
+
+ok( !tainted($var), 'known variable');
+
+my $key = (keys %ENV)[0];
+
+ok( tainted($ENV{$key}),       'environment variable');
+
+$var = $ENV{$key};
+ok( tainted($var),     'copy of environment variable');
index 448a53d..d4dfcd7 100755 (executable)
@@ -29,8 +29,9 @@ foreach $v (undef, 10, 'string') {
 }
 
 foreach $r ({}, \$t, [], \*F, sub {}) {
-  my $addr = $r + 0;
   my $n = "$r";
+  $n =~ /0x(\w+)/;
+  my $addr = do { local $^W; hex $1 };
   is( refaddr($r), $addr, $n);
 
   my $obj = bless $r, 'FooBar';