Skip Menu |

To: perlbug [...] perl.org
From: Todd Rinaldo <toddr [...] cpan.org>
Subject: magic for overload broken 5.18..blead
Date: Tue, 20 Oct 2015 11:29:08 -0500
Download (untitled) / with headers
text/plain 3.9k
This is a bug report for perl from toddr@cpan.org, generated with the help of perlbug 1.39 running under perl 5.17.7. ----------------------------------------------------------------- [Please describe your issue here] The following segfaults in blead: perl -MDevel::Peek=Dump -E'version->new("v5.22.0"); Dump(\%version::)' This was discovered during B::C development. https://github.com/rurban/perl-compiler/issues/219 The output looks like this: SV = IV(0x8c1e234) at 0x8c1e238 REFCNT = 1 FLAGS = (TEMP,ROK) RV = 0x8c1e418 SV = PVHV(0x8c24010) at 0x8c1e418 REFCNT = 4 FLAGS = (OOK,OVERLOAD,SHAREKEYS) STASH = 0x10/root/bisect.sh: line 10: 26914 Segmentation fault ./perl -Ilib -MDevel::Peek=Dump -E'version->new("v5.22.0");Dump(\%version::)' I bisected this and came up with this commit which was a revert of a revert. c07f9fb2c73bebcf70fabbf464c0c3452af4fcbf is the first bad commit commit c07f9fb2c73bebcf70fabbf464c0c3452af4fcbf Author: Father Chrysostomos sprout@cpan.org Date: Tue Nov 20 13:47:27 2012 -0800 Revert "Revert "8c34e50dc slowed down detruction with no DESTROY"" This reverts commit 95f9781bc2fad025553db0160ef9c2c5363312a1. Now that the crash has been fixed by the preceding commit, we can reinstate 7cc6787e9db. :100644 100644 2d1d887fe8b4256b2b5682dc6d26065f12ab5a6d be2038f4e7cdaf2d918c5df419348fca09290ab0 M mro.c :100644 100644 9f5c157a87b3f41f96566337e612a3674c129bbd a7914988e7861ead362d718960a408fd5bd0a5e3 M sv.c bisect run success [Please do not change anything below this line] ----------------------------------------------------------------- --- Flags: category=core severity=medium --- Site configuration information for perl 5.17.7: Configured by root at Tue Oct 20 11:16:03 CDT 2015. Summary of my perl5 (revision 5 version 17 subversion 7) configuration: Commit id: c07f9fb2c73bebcf70fabbf464c0c3452af4fcbf Platform: osname=linux, osvers=2.6.32-573.3.1.el6.i686, archname=i686-linux uname='linux toddr.dev 2.6.32-573.3.1.el6.i686 #1 smp thu aug 13 19:58:36 utc 2015 i686 i686 i386 gnulinux ' config_args='-Dusedevel -Doptimize=-g -Dcc=ccache gcc -Dld=gcc -Dnoextensions=Encode -des' hint=recommended, useposix=true, d_sigaction=define useithreads=undef, usemultiplicity=undef useperlio=define, d_sfio=undef, uselargefiles=define, usesocks=undef use64bitint=undef, use64bitall=undef, uselongdouble=undef usemymalloc=n, bincompat5005=undef Compiler: cc='ccache gcc', ccflags ='-fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64', optimize='-g', cppflags='-fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include' ccversion='', gccversion='4.4.7 20120313 (Red Hat 4.4.7-16)', 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='gcc', ldflags =' -fstack-protector -L/usr/local/lib' libpth=/usr/local/lib /lib /usr/lib libs=-lnsl -lgdbm -ldb -ldl -lm -lcrypt -lutil -lc perllibs=-lnsl -ldl -lm -lcrypt -lutil -lc libc=/lib/libc-2.12.so, so=so, useshrplib=false, libperl=libperl.a gnulibc_version='2.12' Dynamic Linking: dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E' cccdlflags='-fPIC', lddlflags='-shared -g -L/usr/local/lib -fstack-protector' Locally applied patches: --- @INC for perl 5.17.7: lib /usr/local/lib/perl5/site_perl/5.17.7/i686-linux /usr/local/lib/perl5/site_perl/5.17.7 /usr/local/lib/perl5/5.17.7/i686-linux /usr/local/lib/perl5/5.17.7 . --- Environment for perl 5.17.7: HOME=/root LANG=en_US.UTF-8 LANGUAGE (unset) LD_LIBRARY_PATH (unset) LOGDIR (unset) PATH=/usr/local/bin:/usr/bin:/bin:/usr/sbin:/sbin:. PERL_BADLANG (unset) SHELL=/bin/zsh
RT-Send-CC: perl5-porters [...] perl.org
Also being looked at here to fix the core perl issue. https://github.com/perl11/cperl/issues/60
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 340b
This can be simplified to this. $>perl -MDevel::Peek=Dump -E' Dump(\%version::)' SV = IV(0x9771284) at 0x9771288 REFCNT = 1 FLAGS = (TEMP,ROK) RV = 0x97716ac SV = PVHV(0x9777280) at 0x97716ac REFCNT = 4 FLAGS = (OOK,SHAREKEYS,OVERLOAD) STASH = 0x14zsh: segmentation fault perl -MDevel::Peek=Dump -E' Dump(\%version::)'
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 666b
I analyzed the commit that broke things and boiled down the fix for the problem (based on the offending commit) to the attached patch. I do not claim to fully understand why it works or if it's the correct solution. Hopefully someone with more knowledge can comment on the legitimacy of the patch. At a glance it appears that if you don't determine that there's an AUTOLOAD for DESTROY, then there's no reason to try to setup the destructor cache for it? Additionally I cannot figure out how to trigger this failure without Devel::Peek and I'm pretty sure that wouldn't be a valid test to validate sv.c? I guess we could add the test here? ext/Devel-Peek/t/
Subject: 0001-Don-t-setup-destructor-cache-for-an-sv-if-gv_fetchme.patch
From e10f534e98017cb897d596988b74949c579cf5b5 Mon Sep 17 00:00:00 2001 From: Todd Rinaldo <toddr@cpan.org> Date: Tue, 20 Oct 2015 14:52:31 -0500 Subject: [PATCH] Don't setup destructor cache for an sv if gv_fetchmeth_autoload fails. Causes segfaults in overload / version.pm --- sv.c | 25 ++++++++++++++----------- 1 file changed, 14 insertions(+), 11 deletions(-) diff --git a/sv.c b/sv.c index f0c1553..94e62be 100644 --- a/sv.c +++ b/sv.c @@ -6742,17 +6742,20 @@ S_curse(pTHX_ SV * const sv, const bool check_refcnt) { if (!destructor || HvMROMETA(stash)->destroy_gen != PL_sub_generation) { - GV * const gv = - gv_fetchmeth_autoload(stash, "DESTROY", 7, 0); - if (gv) destructor = GvCV(gv); - if (!SvOBJECT(stash)) - { - SvSTASH(stash) = - destructor ? (HV *)destructor : ((HV *)0)+1; - HvAUX(stash)->xhv_mro_meta->destroy_gen = - PL_sub_generation; - } - } + GV * const gv = + gv_fetchmeth_autoload(stash, "DESTROY", 7, 0); + if (gv) + { + destructor = GvCV(gv); + if (!SvOBJECT(stash)) + { + SvSTASH(stash) = + destructor ? (HV *)destructor : ((HV *)0)+1; + HvAUX(stash)->xhv_mro_meta->destroy_gen = + PL_sub_generation; + } + } + } assert(!destructor || destructor == ((CV *)0)+1 || SvTYPE(destructor) == SVt_PVCV); if (destructor && destructor != ((CV *)0)+1 -- 2.6.2
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 587b
On Tue Oct 20 13:24:38 2015, TODDR wrote: Show quoted text
> Additionally I cannot figure out how to trigger this failure without > Devel::Peek and I'm pretty sure that wouldn't be a valid test to > validate sv.c? I guess we could add the test here?
./perl -Ilib -MB -E 'version->new("v5.22.0"); $s = B::svref_2object(\%version::); $s->SvSTASH' works with your patch and crashes without it. As to your patch, if I understand it, it means that we'd no longer be caching the common case that the stash *doesn't* have a DESTROY sub, unless there was another member to the GV like @version::DESTROY. Tony
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 195b
There are reported bugs related to this problem in CPAN Internals::DumpArenas https://rt.cpan.org/Public/Bug/Display.html?id=81635 version https://rt.cpan.org/Public/Bug/Display.html?id=107459
RT-Send-CC: perl5-porters [...] perl.org
This is a TODO test for the failure that could be applied until we can find a correct solution.
Subject: 0001-Document-broken-SvSTASH-for-version-in-B-s-test-suit.patch
From fccca5a4b46e088dbdd54c540c0dbe02dc036dc1 Mon Sep 17 00:00:00 2001 From: Todd Rinaldo <toddr@cpan.org> Date: Wed, 18 Nov 2015 18:51:36 -0600 Subject: [PATCH] Document broken SvSTASH for %version:: in B's test suite RT 126410: This may not be a B bug but we have no test coverage for SvSTASH at the moment. TODO the test until it is working correctly. --- ext/B/t/sv_stash.t | 22 ++++++++++++++++++++++ 1 file changed, 22 insertions(+) create mode 100644 ext/B/t/sv_stash.t diff --git a/ext/B/t/sv_stash.t b/ext/B/t/sv_stash.t new file mode 100644 index 0000000..e78f3cc --- /dev/null +++ b/ext/B/t/sv_stash.t @@ -0,0 +1,22 @@ +#!./perl -w + +BEGIN { + unshift @INC, 't'; + require Config; + if ( ( $Config::Config{'extensions'} !~ /\bB\b/ ) ) { + print "1..0 # Skip -- Perl configured without B module\n"; + exit 0; + } + require 'test.pl'; +} +plan 1; + +# RT #126410 = used to coredump when doing SvSTASH on %version:: + +TODO: { + local $TODO = 'Broken since c07f9fb2c7 - revert of a revert: slowed down detruction with no DESTROY'; + fresh_perl_is( + 'use B; version->new("v5.22.0"); $s = B::svref_2object(\%version::); $s->SvSTASH print "ok\n"', + "ok\n", { stderr => 1 }, 'RT #126410 - SvSTASH against %version::' + ); +} -- 2.6.3
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 636b
On Wed Nov 18 16:55:06 2015, TODDR wrote: Show quoted text
> This is a TODO test for the failure that could be applied until we can > find a correct solution.
That patch has a syntax error and doesn't update MANIFEST. I've attached a fixed version of that. I've also attached a change that moves the DESTROY cache from the stash to the mro metadata, where we're already keeping the destroy sub generation. This *doesn't* fix the AUTOLOAD bug from #124387, the more obvious fixes for that are causing other tests to fail - in particular op/method.t is seeing UNIVERSAL::AUTOLOAD called on IO::File->DESTROY when the stdio handles are destroyed. Tony
Subject: 0001-Document-broken-SvSTASH-for-version-in-B-s-test-suit.patch
From d9d3577186ec74239503d64ab4fdbc7f746fecbb Mon Sep 17 00:00:00 2001 From: Todd Rinaldo <toddr@cpan.org> Date: Mon, 18 Jan 2016 16:30:37 +1100 Subject: Document broken SvSTASH for %version:: in B's test suite RT 126410: This may not be a B bug but we have no test coverage for SvSTASH at the moment. TODO the test until it is working correctly. TonyC: fix syntax error and update MANIFEST --- MANIFEST | 1 + ext/B/t/sv_stash.t | 22 ++++++++++++++++++++++ 2 files changed, 23 insertions(+) create mode 100644 ext/B/t/sv_stash.t diff --git a/MANIFEST b/MANIFEST index e75199d..2927abe 100644 --- a/MANIFEST +++ b/MANIFEST @@ -3630,6 +3630,7 @@ ext/B/t/optree_varinit.t my,our,local var init optimization ext/B/t/o.t See if O works ext/B/t/pragma.t See if user pragmas work. ext/B/t/showlex.t See if B::ShowLex works +ext/B/t/sv_stash.t See if SvSTASH() works ext/B/t/terse.t See if B::Terse works ext/B/t/walkoptree.t See if B::walkoptree (and friends) work ext/B/t/xref.t See if B::Xref works diff --git a/ext/B/t/sv_stash.t b/ext/B/t/sv_stash.t new file mode 100644 index 0000000..eaaabcf --- /dev/null +++ b/ext/B/t/sv_stash.t @@ -0,0 +1,22 @@ +#!./perl -w + +BEGIN { + unshift @INC, 't'; + require Config; + if ( ( $Config::Config{'extensions'} !~ /\bB\b/ ) ) { + print "1..0 # Skip -- Perl configured without B module\n"; + exit 0; + } + require 'test.pl'; +} +plan 1; + +# RT #126410 = used to coredump when doing SvSTASH on %version:: + +TODO: { + local $TODO = 'Broken since c07f9fb2c7 - revert of a revert: slowed down detruction with no DESTROY'; + fresh_perl_is( + 'use B; version->new("v5.22.0"); $s = B::svref_2object(\%version::); $s->SvSTASH; print "ok\n"', + "ok\n", { stderr => 1 }, 'RT #126410 - SvSTASH against %version::' + ); +} -- 2.1.4
Subject: 0002-perl-126410-keep-the-DESTROY-cache-in-mro_meta.patch
From e595e351151b2bdd09d42ddaa3262164ed3c0f2a Mon Sep 17 00:00:00 2001 From: Tony Cook <tony@develop-help.com> Date: Mon, 18 Jan 2016 17:42:32 +1100 Subject: [perl #126410] keep the DESTROY cache in mro_meta We're already keeping destroy_gen there, so keep the CV there too. The previous implementation, introduced in 8c34e50d, kept the destroy method cache in the stash's stash, which broke B's SvSTASH method. Before that, the DESTROY method was cached in overload magic. --- ext/B/t/sv_stash.t | 1 - hv.h | 1 + mro_core.c | 10 +++++----- sv.c | 34 ++++++++++++++++++++-------------- 4 files changed, 26 insertions(+), 20 deletions(-) diff --git a/ext/B/t/sv_stash.t b/ext/B/t/sv_stash.t index eaaabcf..e9abf4d 100644 --- a/ext/B/t/sv_stash.t +++ b/ext/B/t/sv_stash.t @@ -14,7 +14,6 @@ plan 1; # RT #126410 = used to coredump when doing SvSTASH on %version:: TODO: { - local $TODO = 'Broken since c07f9fb2c7 - revert of a revert: slowed down detruction with no DESTROY'; fresh_perl_is( 'use B; version->new("v5.22.0"); $s = B::svref_2object(\%version::); $s->SvSTASH; print "ok\n"', "ok\n", { stderr => 1 }, 'RT #126410 - SvSTASH against %version::' diff --git a/hv.h b/hv.h index c249b8f..3eee6df 100644 --- a/hv.h +++ b/hv.h @@ -82,6 +82,7 @@ struct mro_meta { const struct mro_alg *mro_which; /* which mro alg is in use? */ HV *isa; /* Everything this class @ISA */ HV *super; /* SUPER method cache */ + CV *destroy; /* DESTROY method if destroy_gen non-zero */ U32 destroy_gen; /* Generation number of DESTROY cache */ }; diff --git a/mro_core.c b/mro_core.c index c1e2da7..5604c46 100644 --- a/mro_core.c +++ b/mro_core.c @@ -538,8 +538,8 @@ Perl_mro_isa_changed_in(pTHX_ HV* stash) /* pessimise derefs for now. Will get recalculated by Gv_AMupdate() */ HvAUX(stash)->xhv_aux_flags &= ~HvAUXf_NO_DEREF; - /* DESTROY can be cached in SvSTASH. */ - if (!SvOBJECT(stash)) SvSTASH(stash) = NULL; + /* DESTROY can be cached in meta. */ + meta->destroy_gen = 0; /* Iterate the isarev (classes that are our children), wiping out their linearization, method and isa caches @@ -1320,8 +1320,8 @@ Perl_mro_method_changed_in(pTHX_ HV *stash) /* Inc the package generation, since a local method changed */ HvMROMETA(stash)->pkg_gen++; - /* DESTROY can be cached in SvSTASH. */ - if (!SvOBJECT(stash)) SvSTASH(stash) = NULL; + /* DESTROY can be cached in meta */ + HvMROMETA(stash)->destroy_gen = 0; /* If stash is UNIVERSAL, or one of UNIVERSAL's parents, invalidate all method caches globally */ @@ -1346,7 +1346,7 @@ Perl_mro_method_changed_in(pTHX_ HV *stash) mrometa->cache_gen++; if(mrometa->mro_nextmethod) hv_clear(mrometa->mro_nextmethod); - if (!SvOBJECT(revstash)) SvSTASH(revstash) = NULL; + mrometa->destroy_gen = 0; } } diff --git a/sv.c b/sv.c index cea54d7..0a5ffe8 100644 --- a/sv.c +++ b/sv.c @@ -6737,25 +6737,31 @@ S_curse(pTHX_ SV * const sv, const bool check_refcnt) { assert(SvTYPE(stash) == SVt_PVHV); if (HvNAME(stash)) { CV* destructor = NULL; + struct mro_meta *meta; assert (SvOOK(stash)); - if (!SvOBJECT(stash)) destructor = (CV *)SvSTASH(stash); - if (!destructor || HvMROMETA(stash)->destroy_gen - != PL_sub_generation) - { + + DEBUG_o( deb(aTHX_ "Looking for DESTROY method for %s\n", + HvNAME(stash)) ); + + /* don't make this an initialization above the assert, since it needs + an AUX structure */ + meta = HvMROMETA(stash); + if (meta->destroy_gen && meta->destroy_gen == PL_sub_generation) { + destructor = meta->destroy; + DEBUG_o( deb(aTHX_ "Using cached DESTROY method %p for %s\n", + (void *)destructor, HvNAME(stash)) ); + } + else { GV * const gv = gv_fetchmeth_autoload(stash, "DESTROY", 7, 0); if (gv) destructor = GvCV(gv); - if (!SvOBJECT(stash)) - { - SvSTASH(stash) = - destructor ? (HV *)destructor : ((HV *)0)+1; - HvAUX(stash)->xhv_mro_meta->destroy_gen = - PL_sub_generation; - } + HvMROMETA(stash)->destroy_gen = PL_sub_generation; + HvMROMETA(stash)->destroy = destructor; + DEBUG_o( deb(aTHX_ "Set cached DESTROY method %p for %s\n", + (void *)destructor, HvNAME(stash)) ); } - assert(!destructor || destructor == ((CV *)0)+1 - || SvTYPE(destructor) == SVt_PVCV); - if (destructor && destructor != ((CV *)0)+1 + assert(!destructor || SvTYPE(destructor) == SVt_PVCV); + if (destructor /* A constant subroutine can have no side effects, so don't bother calling it. */ && !CvCONST(destructor) -- 2.1.4
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 545b
On Mon Jan 18 15:03:11 2016, tonyc wrote: Show quoted text
> On Wed Nov 18 16:55:06 2015, TODDR wrote:
> > This is a TODO test for the failure that could be applied until we > > can > > find a correct solution.
> > That patch has a syntax error and doesn't update MANIFEST. > > I've attached a fixed version of that. > > I've also attached a change that moves the DESTROY cache from the > stash to the mro metadata, where we're already keeping the destroy sub > generation.
Replaces the second patch, because it was broken on debugging/threaded builds. Tony
Subject: 0002-perl-126410-keep-the-DESTROY-cache-in-mro_meta.patch
From ca9b9b0f10423fc26aec854fd4fbbaffb61713a2 Mon Sep 17 00:00:00 2001 From: Tony Cook <tony@develop-help.com> Date: Mon, 18 Jan 2016 17:42:32 +1100 Subject: [perl #126410] keep the DESTROY cache in mro_meta We're already keeping destroy_gen there, so keep the CV there too. The previous implementation, introduced in 8c34e50d, kept the destroy method cache in the stash's stash, which broke B's SvSTASH method. Before that, the DESTROY method was cached in overload magic. --- ext/B/t/sv_stash.t | 1 - hv.h | 1 + mro_core.c | 10 +++++----- sv.c | 34 ++++++++++++++++++++-------------- 4 files changed, 26 insertions(+), 20 deletions(-) diff --git a/ext/B/t/sv_stash.t b/ext/B/t/sv_stash.t index eaaabcf..e9abf4d 100644 --- a/ext/B/t/sv_stash.t +++ b/ext/B/t/sv_stash.t @@ -14,7 +14,6 @@ plan 1; # RT #126410 = used to coredump when doing SvSTASH on %version:: TODO: { - local $TODO = 'Broken since c07f9fb2c7 - revert of a revert: slowed down detruction with no DESTROY'; fresh_perl_is( 'use B; version->new("v5.22.0"); $s = B::svref_2object(\%version::); $s->SvSTASH; print "ok\n"', "ok\n", { stderr => 1 }, 'RT #126410 - SvSTASH against %version::' diff --git a/hv.h b/hv.h index c249b8f..3eee6df 100644 --- a/hv.h +++ b/hv.h @@ -82,6 +82,7 @@ struct mro_meta { const struct mro_alg *mro_which; /* which mro alg is in use? */ HV *isa; /* Everything this class @ISA */ HV *super; /* SUPER method cache */ + CV *destroy; /* DESTROY method if destroy_gen non-zero */ U32 destroy_gen; /* Generation number of DESTROY cache */ }; diff --git a/mro_core.c b/mro_core.c index c1e2da7..5604c46 100644 --- a/mro_core.c +++ b/mro_core.c @@ -538,8 +538,8 @@ Perl_mro_isa_changed_in(pTHX_ HV* stash) /* pessimise derefs for now. Will get recalculated by Gv_AMupdate() */ HvAUX(stash)->xhv_aux_flags &= ~HvAUXf_NO_DEREF; - /* DESTROY can be cached in SvSTASH. */ - if (!SvOBJECT(stash)) SvSTASH(stash) = NULL; + /* DESTROY can be cached in meta. */ + meta->destroy_gen = 0; /* Iterate the isarev (classes that are our children), wiping out their linearization, method and isa caches @@ -1320,8 +1320,8 @@ Perl_mro_method_changed_in(pTHX_ HV *stash) /* Inc the package generation, since a local method changed */ HvMROMETA(stash)->pkg_gen++; - /* DESTROY can be cached in SvSTASH. */ - if (!SvOBJECT(stash)) SvSTASH(stash) = NULL; + /* DESTROY can be cached in meta */ + HvMROMETA(stash)->destroy_gen = 0; /* If stash is UNIVERSAL, or one of UNIVERSAL's parents, invalidate all method caches globally */ @@ -1346,7 +1346,7 @@ Perl_mro_method_changed_in(pTHX_ HV *stash) mrometa->cache_gen++; if(mrometa->mro_nextmethod) hv_clear(mrometa->mro_nextmethod); - if (!SvOBJECT(revstash)) SvSTASH(revstash) = NULL; + mrometa->destroy_gen = 0; } } diff --git a/sv.c b/sv.c index e3e5af4..97fa810 100644 --- a/sv.c +++ b/sv.c @@ -6736,25 +6736,31 @@ S_curse(pTHX_ SV * const sv, const bool check_refcnt) { assert(SvTYPE(stash) == SVt_PVHV); if (HvNAME(stash)) { CV* destructor = NULL; + struct mro_meta *meta; assert (SvOOK(stash)); - if (!SvOBJECT(stash)) destructor = (CV *)SvSTASH(stash); - if (!destructor || HvMROMETA(stash)->destroy_gen - != PL_sub_generation) - { + + DEBUG_o( Perl_deb(aTHX_ "Looking for DESTROY method for %s\n", + HvNAME(stash)) ); + + /* don't make this an initialization above the assert, since it needs + an AUX structure */ + meta = HvMROMETA(stash); + if (meta->destroy_gen && meta->destroy_gen == PL_sub_generation) { + destructor = meta->destroy; + DEBUG_o( Perl_deb(aTHX_ "Using cached DESTROY method %p for %s\n", + (void *)destructor, HvNAME(stash)) ); + } + else { GV * const gv = gv_fetchmeth_autoload(stash, "DESTROY", 7, 0); if (gv) destructor = GvCV(gv); - if (!SvOBJECT(stash)) - { - SvSTASH(stash) = - destructor ? (HV *)destructor : ((HV *)0)+1; - HvAUX(stash)->xhv_mro_meta->destroy_gen = - PL_sub_generation; - } + HvMROMETA(stash)->destroy_gen = PL_sub_generation; + HvMROMETA(stash)->destroy = destructor; + DEBUG_o( Perl_deb(aTHX_ "Set cached DESTROY method %p for %s\n", + (void *)destructor, HvNAME(stash)) ); } - assert(!destructor || destructor == ((CV *)0)+1 - || SvTYPE(destructor) == SVt_PVCV); - if (destructor && destructor != ((CV *)0)+1 + assert(!destructor || SvTYPE(destructor) == SVt_PVCV); + if (destructor /* A constant subroutine can have no side effects, so don't bother calling it. */ && !CvCONST(destructor) -- 2.1.4
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 680b
On Wed Jan 27 16:39:39 2016, tonyc wrote: Show quoted text
> On Mon Jan 18 15:03:11 2016, tonyc wrote:
> > On Wed Nov 18 16:55:06 2015, TODDR wrote:
> > > This is a TODO test for the failure that could be applied until we > > > can > > > find a correct solution.
> > > > That patch has a syntax error and doesn't update MANIFEST. > > > > I've attached a fixed version of that. > > > > I've also attached a change that moves the DESTROY cache from the > > stash to the mro metadata, where we're already keeping the destroy > > sub > > generation.
> > Replaces the second patch, because it was broken on debugging/threaded > builds.
Replace the second patch again, it didn't handle cloning. Tony
Subject: 0002-perl-126410-keep-the-DESTROY-cache-in-mro_meta.patch
From ef6dd50ddb7308d41126f942286c812b9179107d Mon Sep 17 00:00:00 2001 From: Tony Cook <tony@develop-help.com> Date: Mon, 18 Jan 2016 17:42:32 +1100 Subject: [perl #126410] keep the DESTROY cache in mro_meta We're already keeping destroy_gen there, so keep the CV there too. The previous implementation, introduced in 8c34e50d, kept the destroy method cache in the stash's stash, which broke B's SvSTASH method. Before that, the DESTROY method was cached in overload magic. A previous version of this patch didn't clear the destructor cache on a clone, which caused ext/XS-APItest/t/clone_with_stack.t to fail. --- ext/B/t/sv_stash.t | 1 - hv.h | 1 + mro_core.c | 14 +++++++++----- sv.c | 34 ++++++++++++++++++++-------------- 4 files changed, 30 insertions(+), 20 deletions(-) diff --git a/ext/B/t/sv_stash.t b/ext/B/t/sv_stash.t index eaaabcf..e9abf4d 100644 --- a/ext/B/t/sv_stash.t +++ b/ext/B/t/sv_stash.t @@ -14,7 +14,6 @@ plan 1; # RT #126410 = used to coredump when doing SvSTASH on %version:: TODO: { - local $TODO = 'Broken since c07f9fb2c7 - revert of a revert: slowed down detruction with no DESTROY'; fresh_perl_is( 'use B; version->new("v5.22.0"); $s = B::svref_2object(\%version::); $s->SvSTASH; print "ok\n"', "ok\n", { stderr => 1 }, 'RT #126410 - SvSTASH against %version::' diff --git a/hv.h b/hv.h index c249b8f..3eee6df 100644 --- a/hv.h +++ b/hv.h @@ -82,6 +82,7 @@ struct mro_meta { const struct mro_alg *mro_which; /* which mro alg is in use? */ HV *isa; /* Everything this class @ISA */ HV *super; /* SUPER method cache */ + CV *destroy; /* DESTROY method if destroy_gen non-zero */ U32 destroy_gen; /* Generation number of DESTROY cache */ }; diff --git a/mro_core.c b/mro_core.c index c1e2da7..d4ca7f2 100644 --- a/mro_core.c +++ b/mro_core.c @@ -191,6 +191,10 @@ Perl_mro_meta_dup(pTHX_ struct mro_meta* smeta, CLONE_PARAMS* param) newmeta->super = NULL; + /* clear the destructor cache */ + newmeta->destroy = NULL; + newmeta->destroy_gen = 0; + return newmeta; } @@ -538,8 +542,8 @@ Perl_mro_isa_changed_in(pTHX_ HV* stash) /* pessimise derefs for now. Will get recalculated by Gv_AMupdate() */ HvAUX(stash)->xhv_aux_flags &= ~HvAUXf_NO_DEREF; - /* DESTROY can be cached in SvSTASH. */ - if (!SvOBJECT(stash)) SvSTASH(stash) = NULL; + /* DESTROY can be cached in meta. */ + meta->destroy_gen = 0; /* Iterate the isarev (classes that are our children), wiping out their linearization, method and isa caches @@ -1320,8 +1324,8 @@ Perl_mro_method_changed_in(pTHX_ HV *stash) /* Inc the package generation, since a local method changed */ HvMROMETA(stash)->pkg_gen++; - /* DESTROY can be cached in SvSTASH. */ - if (!SvOBJECT(stash)) SvSTASH(stash) = NULL; + /* DESTROY can be cached in meta */ + HvMROMETA(stash)->destroy_gen = 0; /* If stash is UNIVERSAL, or one of UNIVERSAL's parents, invalidate all method caches globally */ @@ -1346,7 +1350,7 @@ Perl_mro_method_changed_in(pTHX_ HV *stash) mrometa->cache_gen++; if(mrometa->mro_nextmethod) hv_clear(mrometa->mro_nextmethod); - if (!SvOBJECT(revstash)) SvSTASH(revstash) = NULL; + mrometa->destroy_gen = 0; } } diff --git a/sv.c b/sv.c index ad2208e..b0a3e12 100644 --- a/sv.c +++ b/sv.c @@ -6745,25 +6745,31 @@ S_curse(pTHX_ SV * const sv, const bool check_refcnt) { assert(SvTYPE(stash) == SVt_PVHV); if (HvNAME(stash)) { CV* destructor = NULL; + struct mro_meta *meta; assert (SvOOK(stash)); - if (!SvOBJECT(stash)) destructor = (CV *)SvSTASH(stash); - if (!destructor || HvMROMETA(stash)->destroy_gen - != PL_sub_generation) - { + + DEBUG_o( Perl_deb(aTHX_ "Looking for DESTROY method for %s\n", + HvNAME(stash)) ); + + /* don't make this an initialization above the assert, since it needs + an AUX structure */ + meta = HvMROMETA(stash); + if (meta->destroy_gen && meta->destroy_gen == PL_sub_generation) { + destructor = meta->destroy; + DEBUG_o( Perl_deb(aTHX_ "Using cached DESTROY method %p for %s\n", + (void *)destructor, HvNAME(stash)) ); + } + else { GV * const gv = gv_fetchmeth_autoload(stash, "DESTROY", 7, 0); if (gv) destructor = GvCV(gv); - if (!SvOBJECT(stash)) - { - SvSTASH(stash) = - destructor ? (HV *)destructor : ((HV *)0)+1; - HvAUX(stash)->xhv_mro_meta->destroy_gen = - PL_sub_generation; - } + HvMROMETA(stash)->destroy_gen = PL_sub_generation; + HvMROMETA(stash)->destroy = destructor; + DEBUG_o( Perl_deb(aTHX_ "Set cached DESTROY method %p for %s\n", + (void *)destructor, HvNAME(stash)) ); } - assert(!destructor || destructor == ((CV *)0)+1 - || SvTYPE(destructor) == SVt_PVCV); - if (destructor && destructor != ((CV *)0)+1 + assert(!destructor || SvTYPE(destructor) == SVt_PVCV); + if (destructor /* A constant subroutine can have no side effects, so don't bother calling it. */ && !CvCONST(destructor) -- 2.1.4
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 361b
On Tue Feb 02 18:15:11 2016, tonyc wrote: Show quoted text
> Replace the second patch again, it didn't handle cloning.
Applied both patches as 27895dda808516d2e00748a19f6648febae7161f and ac3b837b9e1b412c93837ea13eacd367439264ec. I optimized the second a little, using the already fetched meta instead of calling HvMROMETA() twice in the false part of the cache check. Tony
Download (untitled) / with headers
text/plain 252b
Thank you for submitting this report. You have helped make Perl better. With the release of Perl 5.24.0 on May 9, 2016, this and 149 other issues have been resolved. Perl 5.24.0 may be downloaded via https://metacpan.org/release/RJBS/perl-5.24.0


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

For issues related to this RT instance (aka "perlbug"), please contact perlbug-admin at perl.org