# define SvREFCNT_inc_simple_void(sv) ((void) SvREFCNT_inc(sv))
#endif
+#ifndef SvREFCNT_dec_NN
+# define SvREFCNT_dec_NN(sv) ((void) SvREFCNT_dec(sv))
+#endif
+
#ifndef mPUSHu
# define mPUSHu(U) PUSHs(sv_2mortal(newSVuv(U)))
#endif
# define OP_CLASS(O) (PL_opargs[(O)->op_type] & OA_CLASS_MASK)
#endif
+#define VMG_CAREFUL_SELF_DESTRUCTION XSH_HAS_PERL(5, 25, 3)
+
/* ... Bug-free mg_magical ................................................. */
/* See the discussion at http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2008-01/msg00036.html */
typedef struct {
SV *sv;
+#if VMG_CAREFUL_SELF_DESTRUCTION
+ SV *rsv; /* The ref to the sv currently being freed, pushed on the stack */
+#endif
int in_eval;
I32 base;
} vmg_svt_free_cleanup_ud;
SV *sv = ud->sv;
MAGIC *mg;
+#if VMG_CAREFUL_SELF_DESTRUCTION
+ /* Silently undo the ref - don't trigger destruction in the referent
+ * for a second time */
+ if (SvROK(ud->rsv) && SvRV(ud->rsv) == sv) {
+ SvRV_set(ud->rsv, NULL);
+ SvROK_off(ud->rsv);
+ --SvREFCNT(sv); /* Silent */
+ }
+ SvREFCNT_dec_NN(ud->rsv);
+#endif
+
/* We are about to croak() while sv is being destroyed. Try to clean up
* things a bit. */
mg = SvMAGIC(sv);
vmg_mg_del(sv, NULL, mg, mg->mg_moremagic);
mg_magical(sv);
}
- SvREFCNT_dec(sv);
+ SvREFCNT_dec(sv); /* Re-trigger destruction */
vmg_dispell_guard_oncroak(aTHX_ NULL);
PUSHMARK(SP);
EXTEND(SP, 2);
+ /* This will bump the refcount of sv from 0 to 1 */
+#if VMG_CAREFUL_SELF_DESTRUCTION
+ ud.rsv = newRV_inc(sv);
+ PUSHs(ud.rsv);
+#else
PUSHs(sv_2mortal(newRV_inc(sv)));
+#endif
PUSHs(mg->mg_obj ? mg->mg_obj : &PL_sv_undef);
if (w->opinfo)
XPUSHs(vmg_op_info(w->opinfo));
POPSTACK;
+#if VMG_CAREFUL_SELF_DESTRUCTION
+ /* Silently undo the ref - don't trigger destruction in the referent
+ * for a second time */
+ if (SvROK(ud.rsv) && SvRV(ud.rsv) == sv) {
+ SvRV_set(ud.rsv, NULL);
+ SvROK_off(ud.rsv);
+ --SvREFCNT(sv); /* Silent */
+ }
+ SvREFCNT_dec_NN(ud.rsv);
+#endif
+
FREETMPS;
LEAVE;