| CC: | jkeenan [...] cpan.org |
| Subject: | [RT #119731] NEXT::DISTINCT can wrongly skip parent function calls |
This bug was originally reported in the Perl 5 but queue at https://rt.perl.org/rt3/Ticket/Display.html?id=119731. Because Porting/Maintainers.pl indicates that the NEXT distribution is maintained on CPAN, I am moving this ticket into NEXT's rt.cpan.org queue.--jkeenan
####################
NEXT::DISTINCT can wrongly skip parent function calls when an object is created at the same memory address as an old object. NEXT uses the memory reference as part of a key into the $NEXT::SEEN hash, so if the old object with the same memory reference is already in the $NEXT::SEEN hash, NEXT::DISTINCT will think that the function call has already been seen and it will skip it.
This can result in an object that did not call its parent init function, if they are using NEXT::DISTINCT::_init().
This only happens when the $NEXT::SEEN variable exists already in the scope when calling NEXT::DISTINCT::_init(). This can happen when you have two inheritence trees and one calls the other. I have reproduced this with perl version 5.10.1 on Linux and with perl version 5.18.1 on Windows.
Output from attached reproducer.pl is below.
(notice how the second object does not have the 'parent' instance variable)
ref: Foo=HASH(0x2578990)
$VAR1 = bless( {
'parent' => 1
}, 'Foo' );
ref: Foo=HASH(0x2578990)
$VAR1 = bless( {}, 'Foo' );
One way to fix the issue would be to assign a unique identifier for the object in the NEXT code, since the memory reference is not always unique. I was able to implement a fix using FieldHash, but there are other ways to fix it as well. Another idea would be to make sure an object is cleared from the $NEXT::SEEN hash when it is destroyed or cleaned up.
I have attached a patch file of my changes.
---
Flags:
category=library
severity=low
module=NEXT
---
Site configuration information for perl 5.18.1:
Configured by strawberry-perl at Tue Aug 13 17:19:29 2013.
Summary of my perl5 (revision 5 version 18 subversion 1) configuration:
Platform:
osname=MSWin32, osvers=4.0, archname=MSWin32-x64-multi-thread
uname='Win32 strawberry-perl 5.18.1.1 #1 Tue Aug 13 17:18:28 2013 x64'
config_args='undef'
hint=recommended, useposix=true, d_sigaction=undef
useithreads=define, usemultiplicity=define
useperlio=define, d_sfio=undef, uselargefiles=define, usesocks=undef
use64bitint=define, use64bitall=undef, uselongdouble=undef
usemymalloc=n, bincompat5005=undef
Compiler:
cc='gcc', ccflags =' -s -O2 -DWIN32 -DWIN64 -DCONSERVATIVE -DPERL_TEXTMODE_SCRIPTS -DPERL_IMPLICIT_CONTEXT -DPERL_IMPLICIT_SYS -DUSE_PERLIO -fno-strict-aliasing -mms-bitfields',
optimize='-s -O2',
cppflags='-DWIN32'
ccversion='', gccversion='4.7.3', gccosandvers=''
intsize=4, longsize=4, ptrsize=8, doublesize=8, byteorder=12345678
d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12
ivtype='long long', ivsize=8, nvtype='double', nvsize=8, Off_t='long long', lseeksize=8
alignbytes=8, prototype=define
Linker and Libraries:
ld='g++', ldflags ='-s -L"C:\strawberry\perl\lib\CORE" -L"C:\strawberry\c\lib"'
libpth=C:\strawberry\c\lib C:\strawberry\c\x86_64-w64-mingw32\lib
libs=-lmoldname -lkernel32 -luser32 -lgdi32 -lwinspool -lcomdlg32 -ladvapi32 -lshell32 -lole32 -loleaut32 -lnetapi32 -luuid -lws2_32 -lmpr -lwinmm -lversion -lodbc32 -lodbccp32 -lcomctl32
perllibs=-lmoldname -lkernel32 -luser32 -lgdi32 -lwinspool -lcomdlg32 -ladvapi32 -lshell32 -lole32 -loleaut32 -lnetapi32 -luuid -lws2_32 -lmpr -lwinmm -lversion -lodbc32 -lodbccp32 -lcomctl32
libc=, so=dll, useshrplib=true, libperl=libperl518.a
gnulibc_version=''
Dynamic Linking:
dlsrc=dl_win32.xs, dlext=dll, d_dlsymun=undef, ccdlflags=' '
cccdlflags=' ', lddlflags='-mdll -s -L"C:\strawberry\perl\lib\CORE" -L"C:\strawberry\c\lib"'
Locally applied patches:
---
@INC for perl 5.18.1:
C:/strawberry/perl/site/lib
C:/strawberry/perl/vendor/lib
C:/strawberry/perl/lib
.
---
Environment for perl 5.18.1:
HOME (unset)
LANG (unset)
LANGUAGE (unset)
LD_LIBRARY_PATH (unset)
LOGDIR (unset)
PATH=C:\Windows\system32;C:\Windows;C:\Windows\System32\Wbem;C:\Windows\System32\WindowsPowerShell\v1.0\;C:\Windows\Program Files\Microsoft Office\Office14;C:\Program Files (x86)\Windows Imaging\;C:\Program Files (x86)\Enterprise Vault\EVClient\;C:\strawberry\c\bin;C:\strawberry\perl\site\bin;C:\strawberry\perl\bin
PERL_BADLANG (unset)
SHELL (unset)
| Subject: | NEXT-distinct.patch |
--- /usr/share/perl5/NEXT.pm 2013-04-30 08:49:01.000000000 -0400
+++ NEXT2.pm 2013-08-29 10:42:17.102001474 -0400
@@ -1,9 +1,13 @@
package NEXT;
$VERSION = '0.64';
use Carp;
+use Hash::Util::FieldHash qw(fieldhashes);
use strict;
use overload ();
+fieldhashes \my(%IDs);
+my $Last_ID = 0;
+
sub NEXT::ELSEWHERE::ancestors
{
my @inlist = shift;
@@ -50,6 +54,12 @@
my $key = ref $self && overload::Overloaded($self)
? overload::StrVal($self) : $self;
+ if (exists $IDs{$key}) {
+ $key = $IDs{$key};
+ } else {
+ $key = ++$Last_ID;
+ }
+
local ($NEXT::NEXT{$key,$wanted_method}, $NEXT::SEEN) =
($NEXT::NEXT{$key,$wanted_method}, $NEXT::SEEN);
| Subject: | reproducer.pl |
#!/usr/bin/perl
{
package Foo;
use NEXT;
our @ISA = ('FooParent');
sub new {
my $class = shift;
my $self = bless {}, $class;
$self->_init();
return $self;
}
sub _init {
my $self = shift;
$self->NEXT::DISTINCT::_init();
}
}
{
package FooParent;
use NEXT;
sub new {
my $class = shift;
my $self = bless {}, $class;
$self->_init();
return $self;
}
sub _init {
my $self = shift;
$self->NEXT::DISTINCT::_init();
$self->{'parent'} = 1;
}
}
{
package Starter;
our @ISA = ('Breaker');
use NEXT;
sub new {
my $class = shift;
my $self = bless {}, $class;
$self->_init();
return $self;
}
sub _init {
my $self = shift;
$self->NEXT::DISTINCT::_init();
}
}
{
package Breaker;
use NEXT;
use Data::Dumper;
sub new {
my $class = shift;
my $self = bless {}, $class;
$self->_init();
return $self;
}
sub _init {
my $self = shift;
$self->NEXT::DISTINCT::_init();
$self->break();
}
sub break {
for(1..2) {
my $obj = Foo->new();
print "\nref: $obj\n";
print Dumper($obj)."\n\n";
}
}
}
my $obj = Starter->new();