summaryrefslogtreecommitdiff
path: root/sv.c
diff options
context:
space:
mode:
authorTony Cook <tony@develop-help.com>2016-01-18 17:42:32 +1100
committerTony Cook <tony@develop-help.com>2016-02-08 14:52:51 +1100
commitac3b837b9e1b412c93837ea13eacd367439264ec (patch)
tree1a57c2a1b3721be0a9d9e9b2aae739f1c0ba29bc /sv.c
parent27895dda808516d2e00748a19f6648febae7161f (diff)
downloadperl-ac3b837b9e1b412c93837ea13eacd367439264ec.tar.gz
[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.
Diffstat (limited to 'sv.c')
-rw-r--r--sv.c34
1 files changed, 20 insertions, 14 deletions
diff --git a/sv.c b/sv.c
index 71c398b872..42baa293ee 100644
--- a/sv.c
+++ b/sv.c
@@ -6775,25 +6775,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;
- }
+ meta->destroy_gen = PL_sub_generation;
+ meta->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)