Skip Menu |
 

This queue is for tickets about the NEXT CPAN distribution.

Report information
The Basics
Id: 88620
Status: new
Priority: 0/
Queue: NEXT

People
Owner: Nobody in particular
Requestors: ryan.delany [...] oracle.com
Cc: jkeenan [...] cpan.org
AdminCc:

Bug Information
Severity: (no value)
Broken in: (no value)
Fixed in: (no value)



CC: jkeenan [...] cpan.org
Subject: [RT #119731] NEXT::DISTINCT can wrongly skip parent function calls
Download (untitled) / with headers
text/plain 4.2k
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
Download NEXT-distinct.patch
text/x-diff 750b
--- /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
Download reproducer.pl
text/x-perl 1.4k
#!/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();


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.