magic for overload broken 5.18..blead #14999
Comments
From @toddrCreated by @toddrThe following segfaults in blead: perl -MDevel::Peek=Dump -E'version->new("v5.22.0"); Dump(\%version::)' This was discovered during B::C development. The output looks like this: I bisected this and came up with this commit which was a revert of a revert. c07f9fb is the first bad commit Revert "Revert "8c34e50dc slowed down detruction with no DESTROY"" This reverts commit 95f9781. Now that the crash has been fixed by the preceding commit, we can Perl Info |
From @toddrAlso being looked at here to fix the core perl issue. perl11/cperl#60 |
From [Unknown Contact. See original ticket]Also being looked at here to fix the core perl issue. perl11/cperl#60 |
From @toddrThis can be simplified to this. $>perl -MDevel::Peek=Dump -E' Dump(\%version::)' |
From @toddrI 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/ |
From @toddr0001-Don-t-setup-destructor-cache-for-an-sv-if-gv_fetchme.patchFrom 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
|
From @tonycozOn Tue Oct 20 13:24:38 2015, TODDR wrote:
./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 |
|
The RT System itself - Status changed from 'new' to 'open' |
From @toddrThere are reported bugs related to this problem in CPAN Internals::DumpArenas https://rt.cpan.org/Public/Bug/Display.html?id=81635 |
From @toddrThis is a TODO test for the failure that could be applied until we can find a correct solution. |
From @toddr0001-Document-broken-SvSTASH-for-version-in-B-s-test-suit.patchFrom 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
|
From @tonycozOn Wed Nov 18 16:55:06 2015, TODDR wrote:
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 |
From @tonycoz0001-Document-broken-SvSTASH-for-version-in-B-s-test-suit.patchFrom 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
|
From @tonycoz0002-perl-126410-keep-the-DESTROY-cache-in-mro_meta.patchFrom 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
|
From @tonycozOn Mon Jan 18 15:03:11 2016, tonyc wrote:
Replaces the second patch, because it was broken on debugging/threaded builds. Tony |
From @tonycoz0002-perl-126410-keep-the-DESTROY-cache-in-mro_meta.patchFrom 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
|
From @tonycozOn Wed Jan 27 16:39:39 2016, tonyc wrote:
Replace the second patch again, it didn't handle cloning. Tony |
From @tonycoz0002-perl-126410-keep-the-DESTROY-cache-in-mro_meta.patchFrom 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
|
From @tonycozOn Tue Feb 02 18:15:11 2016, tonyc wrote:
Applied both patches as 27895dd and ac3b837. 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 |
|
@tonycoz - Status changed from 'open' to 'pending release' |
From @khwilliamsonThank you for submitting this report. You have helped make Perl better. Perl 5.24.0 may be downloaded via https://metacpan.org/release/RJBS/perl-5.24.0 |
|
@khwilliamson - Status changed from 'pending release' to 'resolved' |
Migrated from rt.perl.org#126410 (status was 'resolved')
Searchable as RT126410$
The text was updated successfully, but these errors were encountered: