[perl #29395] Scalar::Util::refaddr falsely returns false

Add mg_get() to refaddr() when SV is magical.
Fix the non-xs version of looks_like_number().

p4raw-id: //depot/perl@22798

diff --git a/ext/List/Util/Util.xs b/ext/List/Util/Util.xs
index 0e0cfbf..af6a586 100644 (file)
--- a/ext/List/Util/Util.xs
+++ b/ext/List/Util/Util.xs
@@ -411,6 +411,8 @@ refaddr(sv)
 PROTOTYPE: $
 CODE:
 {
+    if (SvMAGICAL(sv))
+       mg_get(sv);
     if(!SvROK(sv)) {
        XSRETURN_UNDEF;
     }

diff --git a/ext/List/Util/lib/List/Util.pm b/ext/List/Util/lib/List/Util.pm
index ff38fb4..04f5518 100644 (file)
--- a/ext/List/Util/lib/List/Util.pm
+++ b/ext/List/Util/lib/List/Util.pm
@@ -10,7 +10,7 @@ require Exporter;
 
 @ISA        = qw(Exporter);
 @EXPORT_OK  = qw(first min max minstr maxstr reduce sum shuffle);
-$VERSION    = "1.13_01";
+$VERSION    = "1.13_02";
 $XS_VERSION = $VERSION;
 $VERSION    = eval $VERSION;
 

diff --git a/ext/List/Util/lib/Scalar/Util.pm b/ext/List/Util/lib/Scalar/Util.pm
index ad192a8..e74c024 100644 (file)
--- a/ext/List/Util/lib/Scalar/Util.pm
+++ b/ext/List/Util/lib/Scalar/Util.pm
@@ -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.13_01";
+$VERSION   = "1.13_02";
 $VERSION   = eval $VERSION;
 
 sub export_fail {
@@ -122,7 +122,7 @@ sub looks_like_number {
   local $_ = shift;
 
   # checks from perlfaq4
-  return 1 unless defined;
+  return $] < 5.009002 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);

diff --git a/ext/List/Util/t/refaddr.t b/ext/List/Util/t/refaddr.t
index efb962c..424b002 100755 (executable)
--- a/ext/List/Util/t/refaddr.t
+++ b/ext/List/Util/t/refaddr.t
@@ -21,7 +21,7 @@ use Symbol qw(gensym);
 # Ensure we do not trigger and tied methods
 tie *F, 'MyTie';
 
-print "1..13\n";
+print "1..19\n";
 
 my $i = 1;
 foreach $v (undef, 10, 'string') {
@@ -38,6 +38,30 @@ foreach $r ({}, \$t, [], \*F, sub {}) {
   print "ok ",$i++,"\n";
 }
 
+{
+  my $z = '77';
+  my $y = \$z;
+  my $a = '78';
+  my $b = \$a;
+  tie my %x, 'Hash3', {};
+  $x{$y} = 22;
+  $x{$b} = 23;
+  my $xy = $x{$y};
+  my $xb = $x{$b}; 
+  print "not " unless ref($x{$y});
+  print "ok ",$i++,"\n";
+  print "not " unless ref($x{$b});
+  print "ok ",$i++,"\n";
+  print "not " unless refaddr($xy) == refaddr($y);
+  print "ok ",$i++,"\n";
+  print "not " unless refaddr($xb) == refaddr($b);
+  print "ok ",$i++,"\n";
+  print "not " unless refaddr($x{$y});
+  print "ok ",$i++,"\n";
+  print "not " unless refaddr($x{$b});
+  print "ok ",$i++,"\n";
+}
+
 package FooBar;
 
 use overload  '0+' => sub { 10 },
@@ -52,3 +76,28 @@ sub AUTOLOAD {
   warn "$AUTOLOAD called";
   exit 1; # May be in an eval
 }
+
+package Hash3;
+
+use Scalar::Util qw(refaddr);
+
+sub TIEHASH
+{
+       my $pkg = shift;
+       return bless [ @_ ], $pkg;
+}
+sub FETCH
+{
+       my $self = shift;
+       my $key = shift;
+       my ($underlying) = @$self;
+       return $underlying->{refaddr($key)};
+}
+sub STORE
+{
+       my $self = shift;
+       my $key = shift;
+       my $value = shift;
+       my ($underlying) = @$self;
+       return ($underlying->{refaddr($key)} = $key);
+}