#define VMG_SAVE_LAST_CX (!VMG_HAS_PERL(5, 8, 4) || VMG_HAS_PERL(5, 9, 5))
-STATIC I32 vmg_call_sv(pTHX_ SV *sv, I32 flags, I32 destructor) {
+STATIC I32 vmg_call_sv(pTHX_ SV *sv, I32 flags, SV *dsv) {
#define vmg_call_sv(S, F, D) vmg_call_sv(aTHX_ (S), (F), (D))
I32 ret, cxix = 0, in_eval = 0;
#if VMG_SAVE_LAST_CX
if (cxstack_ix < cxstack_max) {
cxix = cxstack_ix + 1;
- if (destructor && CxTYPE(cxstack + cxix) == CXt_EVAL)
+ if (dsv && CxTYPE(cxstack + cxix) == CXt_EVAL)
in_eval = 1;
}
#else
++PL_Ierror_count;
#endif
- } else if (!in_eval)
+ } else if (!in_eval) {
+ if (dsv) {
+ /* We are about to croak() while dsv is being destroyed. Try to clean up
+ * things a bit. */
+ MAGIC *mg = SvMAGIC(dsv);
+ SvREFCNT_dec((SV *) mg->mg_ptr);
+ /* mg->mg_obj may not be refcounted if the data constructor returned the
+ * variable itself. */
+ if (mg->mg_flags & MGf_REFCOUNTED)
+ SvREFCNT_dec(mg->mg_obj);
+ SvMAGIC_set(dsv, mg->mg_moremagic);
+ Safefree(mg);
+ mg_magical(dsv);
+ SvREFCNT_dec(dsv);
+ }
croak(NULL);
+ }
} else {
if (old_err) {
SvREFCNT_dec(ERRSV);
if (!w)
return;
- SvREFCNT_dec(w->cb_data);
- SvREFCNT_dec(w->cb_get);
- SvREFCNT_dec(w->cb_set);
- SvREFCNT_dec(w->cb_len);
- SvREFCNT_dec(w->cb_clear);
- SvREFCNT_dec(w->cb_free);
- SvREFCNT_dec(w->cb_copy);
+ /* During global destruction, any of the callbacks may already have been
+ * freed, so we can't rely on still being able to access them. */
+ if (!PL_dirty) {
+ SvREFCNT_dec(w->cb_data);
+ SvREFCNT_dec(w->cb_get);
+ SvREFCNT_dec(w->cb_set);
+ SvREFCNT_dec(w->cb_len);
+ SvREFCNT_dec(w->cb_clear);
+ SvREFCNT_dec(w->cb_free);
+ SvREFCNT_dec(w->cb_copy);
#if 0
- SvREFCNT_dec(w->cb_dup);
+ SvREFCNT_dec(w->cb_dup);
#endif
#if MGf_LOCAL
- SvREFCNT_dec(w->cb_local);
+ SvREFCNT_dec(w->cb_local);
#endif /* MGf_LOCAL */
#if VMG_UVAR
- SvREFCNT_dec(w->cb_fetch);
- SvREFCNT_dec(w->cb_store);
- SvREFCNT_dec(w->cb_exists);
- SvREFCNT_dec(w->cb_delete);
+ SvREFCNT_dec(w->cb_fetch);
+ SvREFCNT_dec(w->cb_store);
+ SvREFCNT_dec(w->cb_exists);
+ SvREFCNT_dec(w->cb_delete);
#endif /* VMG_UVAR */
+ }
+ /* PerlMemShared_free() and Safefree() are still fine during global
+ * destruction though. */
vmg_vtable_free(w->vtable);
Safefree(w);
/* --- Wizard SV objects --------------------------------------------------- */
STATIC int vmg_wizard_sv_free(pTHX_ SV *sv, MAGIC *mg) {
- if (PL_dirty) /* During global destruction, the context is already freed */
- return 0;
-
vmg_wizard_free((vmg_wizard *) mg->mg_ptr);
return 0;
PUSHs(args[i]);
PUTBACK;
- vmg_call_sv(ctor, G_SCALAR, 0);
+ vmg_call_sv(ctor, G_SCALAR, NULL);
SPAGAIN;
nsv = POPs;
if (mg->mg_type == PERL_MAGIC_uvar)
break;
}
- /* assert(mg); */
uf = (struct ufuncs *) mg->mg_ptr;
- /* assert(uf->uf_val == vmg_svt_val); */
if (uf[1].uf_val || uf[1].uf_set) {
/* Revert the original uvar magic. */
uf[0] = uf[1];
XPUSHs(vmg_op_info(opinfo));
PUTBACK;
- vmg_call_sv(cb, G_SCALAR, 0);
+ vmg_call_sv(cb, G_SCALAR, NULL);
SPAGAIN;
svr = POPs;
XPUSHs(vmg_op_info(opinfo));
PUTBACK;
- vmg_call_sv(w->cb_len, G_SCALAR, 0);
+ vmg_call_sv(w->cb_len, G_SCALAR, NULL);
SPAGAIN;
svr = POPs;
dSP;
- /* Don't even bother if we are in global destruction - the wizard is prisoner
- * of circular references and we are way beyond user realm */
+ /* During global destruction, we cannot be sure that the wizard and its free
+ * callback are still alive. */
if (PL_dirty)
return 0;
XPUSHs(vmg_op_info(w->opinfo));
PUTBACK;
- vmg_call_sv(w->cb_free, G_SCALAR, 1);
+ vmg_call_sv(w->cb_free, G_SCALAR, sv);
SPAGAIN;
svr = POPs;