This queue is for tickets about the NEXT CPAN distribution.

Report information
The Basics

Nobody in particular
ryan.delany [...]
jkeenan [...]

(no value)
Broken in:
(no value)
Fixed in:
(no value)

Subject: [RT #119731] NEXT::DISTINCT can wrongly skip parent function calls
This bug was originally reported in the Perl 5 but queue at Because Porting/ indicates that the NEXT distribution is maintained on CPAN, I am moving this ticket into NEXT's 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 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 #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/ 2013-04-30 08:49:01.000000000 -0400 +++ 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);
#!/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 runs on Request Tracker, is sponsored by The Perl Foundation, and maintained by Best Practical Solutions.

Please report any issues with to