X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FVariable-Magic.git;a=blobdiff_plain;f=Magic.xs;h=aa4af3518fc3c50dc6d35484ab3160cee3929a12;hp=116eb8a728a23bd241e7c3d1086c55b94359fe55;hb=HEAD;hpb=d0d2f5ac7d4406b6158a57cddde7535285703c5e

diff --git a/Magic.xs b/Magic.xs
index 116eb8a..aa4af35 100644
--- a/Magic.xs
+++ b/Magic.xs
@@ -155,6 +155,10 @@ static OP *vmg_trampoline_bump(pTHX_ vmg_trampoline *t, SV *sv, OP *o) {
 # 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
@@ -183,6 +187,8 @@ static OP *vmg_trampoline_bump(pTHX_ vmg_trampoline *t, SV *sv, OP *o) {
 # 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 */
@@ -1416,6 +1422,9 @@ static MGVTBL vmg_propagate_errsv_vtbl = {
 
 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;
@@ -1460,6 +1469,17 @@ static int vmg_svt_free_cleanup(pTHX_ void *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);
@@ -1467,7 +1487,7 @@ static int vmg_svt_free_cleanup(pTHX_ void *ud_) {
    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);
 
@@ -1517,7 +1537,13 @@ static int vmg_svt_free(pTHX_ SV *sv, MAGIC *mg) {
 
  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));
@@ -1544,6 +1570,17 @@ static int vmg_svt_free(pTHX_ SV *sv, MAGIC *mg) {
 
  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;