summaryrefslogtreecommitdiff
path: root/ext/List
diff options
context:
space:
mode:
authorMarcus Holland-Moritz <mhx-perl@gmx.net>2004-05-07 11:42:37 +0000
committerMarcus Holland-Moritz <mhx-perl@gmx.net>2004-05-07 11:42:37 +0000
commit4579700caf516bccbced85a34dbe4beac42f3adb (patch)
tree8c9057d79a2c70522fdd5375ecc6b20e2eb0c99d /ext/List
parent40454f2627208fbd759d13437538e524c882cfac (diff)
downloadperl-4579700caf516bccbced85a34dbe4beac42f3adb.tar.gz
[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
Diffstat (limited to 'ext/List')
-rw-r--r--ext/List/Util/Util.xs2
-rw-r--r--ext/List/Util/lib/List/Util.pm2
-rw-r--r--ext/List/Util/lib/Scalar/Util.pm4
-rwxr-xr-xext/List/Util/t/refaddr.t51
4 files changed, 55 insertions, 4 deletions
diff --git a/ext/List/Util/Util.xs b/ext/List/Util/Util.xs
index 0e0cfbfc2b..af6a586fad 100644
--- 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 ff38fb4469..04f55183b0 100644
--- 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 ad192a8a74..e74c024a0a 100644
--- 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 efb962ccc1..424b0028c0 100755
--- 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);
+}