call_sv(ctor, G_SCALAR);
SPAGAIN;
-
nsv = POPs;
#if VMG_HAS_PERL(5, 8, 3)
SvREFCNT_inc(nsv); /* Or it will be destroyed in FREETMPS */
#else
nsv = sv_newref(nsv); /* Workaround some bug in SvREFCNT_inc() */
#endif
-
PUTBACK;
FREETMPS;
FREETMPS;
LEAVE;
-
return ret;
}
}
STATIC int vmg_svt_free(pTHX_ SV *sv, MAGIC *mg) {
+ SV *wiz = (SV *) mg->mg_ptr;
+ int ret = 0;
+
+ /* This may happen in global destruction */
+ if (SvTYPE(wiz) == SVTYPEMASK)
+ return 0;
+
/* So that it can survive tmp cleanup in vmg_cb_call */
SvREFCNT_inc(sv);
+
#if !VMG_HAS_PERL_MAINT(5, 11, 0, 32686)
/* The previous magic tokens were freed but the magic chain wasn't updated, so
* if you access the sv from the callback the old deleted magics will trigger
* and cause memory misreads. Change 32686 solved it that way : */
SvMAGIC_set(sv, mg);
#endif
+
/* Perl_mg_free will get rid of the magic and decrement mg->mg_obj and
* mg->mg_ptr reference count */
- return vmg_cb_call1e(SV2MGWIZ(mg->mg_ptr)->cb_free, sv, mg->mg_obj);
+ ret = vmg_cb_call1e(SV2MGWIZ(wiz)->cb_free, sv, mg->mg_obj);
+
+ /* Calling SvREFCNT_dec() will trigger destructors in an infinite loop, so
+ * we have to rely on SvREFCNT() being a lvalue. Heck, even the core does it */
+ --SvREFCNT(sv);
+
+ return ret;
}
#if MGf_COPY
char buf[8];
MGWIZ *w;
- if (PL_dirty) /* during global destruction, the context is already freed */
+ if (PL_dirty) /* During global destruction, the context is already freed */
return 0;
w = SV2MGWIZ(wiz);