Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Scalar::Util::refaddr falsely returns false #7279

Closed
p5pRT opened this issue May 6, 2004 · 4 comments
Closed

Scalar::Util::refaddr falsely returns false #7279

p5pRT opened this issue May 6, 2004 · 4 comments

Comments

@p5pRT
Copy link

p5pRT commented May 6, 2004

Migrated from rt.perl.org#29395 (status was 'resolved')

Searchable as RT29395$

@p5pRT
Copy link
Author

p5pRT commented May 6, 2004

From @muir

Created by @muir

I ran into a bug that refaddr($x{$y}) is false but
$xy = $x{$y}; refaddr($xy) is true.

Very odd. I haven't investigated beyond making a little
test program to demonstrate.

-Dave

#!/home/bin/perl

use Scalar​::Util qw(refaddr reftype);
use Test​::More tests => 6 ;

{
  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};
  ok(ref($x{$y}));
  ok(ref($x{$b}));
  ok(refaddr($xy) == refaddr($y));
  ok(refaddr($xb) == refaddr($b));
  ok(refaddr($x{$y})); # fails in 5.8.3
  ok(refaddr($x{$b})); # fails in 5.8.3
  #print "x{y}=$x{$y} y=$y\n";
  #print "x{b}=$x{$b} b=$b\n";
  #printf "ra(x{y})=%d, ra(y)=%d\n", refaddr($x{$y}), refaddr($y);
  #printf "ra(x{b})=%d, ra(b)=%d\n", refaddr($x{$b}), refaddr($b);
  #printf "x{y} ref()=%s reftype=%s refaddr=%d %s\n", ref($x{$y}), reftype($x{$y}), refaddr($x{$y}), $x{$y};
  #printf "x{b} ref()=%s reftype=%s refaddr=%d %s\n", ref($x{$b}), reftype($x{$b}), refaddr($x{$b}), $x{$b};
  #printf "x{y} ref()=%s reftype=%s refaddr=%d %s\n", ref($xy), reftype($xy), refaddr($xy), $xy;
  #printf "x{b} ref()=%s reftype=%s refaddr=%d %s\n", ref($xb), reftype($xb), refaddr($xb), $xb;
}
 
package Hash3;

use Scalar​::Util qw(refaddr reftype blessed);

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);
}

1;

Perl Info

Flags:
    category=library
    severity=medium

Site configuration information for perl v5.8.3:

Configured by Debian Project at Sat Mar 27 17:07:14 EST 2004.

Summary of my perl5 (revision 5.0 version 8 subversion 3) configuration:
  Platform:
    osname=linux, osvers=2.4.25-ti1211, archname=i386-linux-thread-multi
    uname='linux kosh 2.4.25-ti1211 #1 thu feb 19 18:20:12 est 2004 i686 gnulinux '
    config_args='-Dusethreads -Duselargefiles -Dccflags=-DDEBIAN -Dcccdlflags=-fPIC -Darchname=i386-linux -Dprefix=/usr -Dprivlib=/usr/share/perl/5.8 -Darchlib=/usr/lib/perl/5.8 -Dvendorprefix=/usr -Dvendorlib=/usr/share/perl5 -Dvendorarch=/usr/lib/perl5 -Dsiteprefix=/usr/local -Dsitelib=/usr/local/share/perl/5.8.3 -Dsitearch=/usr/local/lib/perl/5.8.3 -Dman1dir=/usr/share/man/man1 -Dman3dir=/usr/share/man/man3 -Dsiteman1dir=/usr/local/man/man1 -Dsiteman3dir=/usr/local/man/man3 -Dman1ext=1 -Dman3ext=3perl -Dpager=/usr/bin/sensible-pager -Uafs -Ud_csh -Uusesfio -Uusenm -Duseshrplib -Dlibperl=libperl.so.5.8.3 -Dd_dosuid -des'
    hint=recommended, useposix=true, d_sigaction=define
    usethreads=define use5005threads=undef useithreads=define usemultiplicity=define
    useperlio=define d_sfio=undef uselargefiles=define usesocks=undef
    use64bitint=undef use64bitall=undef uselongdouble=undef
    usemymalloc=n, bincompat5005=undef
  Compiler:
    cc='cc', ccflags ='-D_REENTRANT -D_GNU_SOURCE -DTHREADS_HAVE_PIDS -DDEBIAN -fno-strict-aliasing -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
    optimize='-O3',
    cppflags='-D_REENTRANT -D_GNU_SOURCE -DTHREADS_HAVE_PIDS -DDEBIAN -fno-strict-aliasing -I/usr/local/include'
    ccversion='', gccversion='3.3.3 (Debian 20040314)', gccosandvers=''
    intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234
    d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12
    ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
    alignbytes=4, prototype=define
  Linker and Libraries:
    ld='cc', ldflags =' -L/usr/local/lib'
    libpth=/usr/local/lib /lib /usr/lib
    libs=-lgdbm -lgdbm_compat -ldb -ldl -lm -lpthread -lc -lcrypt
    perllibs=-ldl -lm -lpthread -lc -lcrypt
    libc=/lib/libc-2.3.2.so, so=so, useshrplib=true, libperl=libperl.so.5.8.3
    gnulibc_version='2.3.2'
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-rdynamic'
    cccdlflags='-fPIC', lddlflags='-shared -L/usr/local/lib'

Locally applied patches:
    


@INC for perl v5.8.3:
    /etc/perl
    /usr/local/lib/perl/5.8.3
    /usr/local/share/perl/5.8.3
    /usr/lib/perl5
    /usr/share/perl5
    /usr/lib/perl/5.8
    /usr/share/perl/5.8
    /usr/local/lib/site_perl
    /usr/local/lib/perl/5.8.2
    /usr/local/share/perl/5.8.2
    .


Environment for perl v5.8.3:
    HOME=/home/muir
    LANG=C
    LANGUAGE (unset)
    LD_LIBRARY_PATH (unset)
    LOGDIR (unset)
    PATH=.:/home/muir/bin/charm:/home/muir/bin:/home/muir/bin/share:/bin:/usr/bin:/sbin:/usr/sbin:/usr/local/shbin:/usr/local/sbin:/usr/local/bin:/usr/local/ptybin:/usr/X11R6/bin:/usr/bin/X11:/usr/local/tex/bin:/usr/ucb:/usr/bin:/bin:/etc:/usr/etc:/usr/games:/lib:/usr/lib:/usr/local/java/bin:/usr/lib/uucp:/usr/openwin/bin:/usr/openwin/bin/xview:/usr/openwin/demo:/usr/adm:/home/muir/tmp
    PERL_BADLANG (unset)
    SHELL=/bin/tcsh

@p5pRT
Copy link
Author

p5pRT commented May 7, 2004

From @mhx

On 2004-05-06, at 20​:32​:18 -0000, David Muir Sharnoff (via RT) wrote​:

# New Ticket Created by David Muir Sharnoff
# Please include the string​: [perl #29395]
# in the subject line of all future correspondence about this issue.
# <URL​: http​://rt.perl.org​:80/rt3/Ticket/Display.html?id=29395 >

This is a bug report for perl from muir@​idiom.com,
generated with the help of perlbug 1.34 running under perl v5.8.3.

-----------------------------------------------------------------
[Please enter your report here]

I ran into a bug that refaddr($x{$y}) is false but
$xy = $x{$y}; refaddr($xy) is true.

Very odd. I haven't investigated beyond making a little
test program to demonstrate.

Thanks for your report.

This has been fixed by the change below.

Marcus

Change 22798 by mhx@​mhx-r2d2 on 2004/05/07 11​:42​:37

  [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().

Affected files ...

... //depot/perl/ext/List/Util/Util.xs#24 edit
... //depot/perl/ext/List/Util/lib/List/Util.pm#18 edit
... //depot/perl/ext/List/Util/lib/Scalar/Util.pm#14 edit
... //depot/perl/ext/List/Util/t/refaddr.t#2 edit

Differences ...

==== //depot/perl/ext/List/Util/Util.xs#24 (text) ====

@​@​ -411,6 +411,8 @​@​
PROTOTYPE​: $
CODE​:
{
+ if (SvMAGICAL(sv))
+ mg_get(sv);
  if(!SvROK(sv)) {
  XSRETURN_UNDEF;
  }

==== //depot/perl/ext/List/Util/lib/List/Util.pm#18 (text) ====

@​@​ -10,7 +10,7 @​@​

@​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;

==== //depot/perl/ext/List/Util/lib/Scalar/Util.pm#14 (text) ====

@​@​ -11,7 +11,7 @​@​

@​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 @​@​
  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 ($] &gt;= 5.008 and /^(Inf(inity)?|NaN)$/i) or ($] &gt;= 5.006001 and /^Inf$/i);

==== //depot/perl/ext/List/Util/t/refaddr.t#2 (xtext) ====

@​@​ -21,7 +21,7 @​@​
# 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 @​@​
  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 @​@​
  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);
+}

@p5pRT
Copy link
Author

p5pRT commented May 7, 2004

The RT System itself - Status changed from 'new' to 'open'

@p5pRT
Copy link
Author

p5pRT commented May 7, 2004

@mhx - Status changed from 'open' to 'resolved'

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Projects
None yet
Development

No branches or pull requests

1 participant