From: Dave Mitchell <davem@iabyn.com>
Date: Tue, 6 Dec 2016 23:45:35 +0000 (-0200)
Subject: Handle self destruction manually
X-Git-Tag: rt115792^0
X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FVariable-Magic.git;a=commitdiff_plain;h=92d785f98afb5bd5707e622ba9cc68818b8f0b33

Handle self destruction manually

A slightly modified version of the failing test code is as follows:

    use Variable::Magic qw<wizard cast>;

    my $wiz2 = wizard;
    my $wiz1 = wizard free =>
            sub { warn "recasting\n"; &cast($_[0], $wiz2); die ; };

    warn "result of eval = [" . eval {
     my $v = do { my $val = 123; \$val };
     study;
     &cast($v, $wiz1);
     warn "just at end of eval\n";
    } . "]\n";
    warn "just after eval\n";

On 5.24.0, this gives:

    just at end of eval
    recasting
    result of eval = []
    recasting
    just after eval

The mortal RV that is created to temporarily point at the scalar being
freed (the IV(123) above) to pass to the free method, isn't initially
freed, and is only freed by the FREETMPS in the nextstate following the
eval. When freed, it triggers another free of the IV(123), which although
it should now be under the influence of $wiz2 rather than $wiz1, it still
calls the 'free' anon sub (I don't understand why its still called, and I
haven't looked into it).

The TEMP not getting freed until after the statement following the eval is
the bug my blead patch was supposed to fix (which it does), but which
caused infinite recursion.

My fix avoids making the temporary mortal RV a TEMP on the tmps stack,
and instead stores a pointer to it in the vmg_svt_free_cleanup_ud struct.
This RV is then manually freed in both the normal and exception cleanup
paths.
---

diff --git a/Magic.xs b/Magic.xs
index 116eb8a..ba59f54 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
@@ -1416,6 +1420,7 @@ static MGVTBL vmg_propagate_errsv_vtbl = {
 
 typedef struct {
  SV  *sv;
+ SV  *rsv; /* The ref to the sv currently being freed, pushed on the stack */
  int  in_eval;
  I32  base;
 } vmg_svt_free_cleanup_ud;
@@ -1460,6 +1465,15 @@ static int vmg_svt_free_cleanup(pTHX_ void *ud_) {
   SV    *sv = ud->sv;
   MAGIC *mg;
 
+ /* Silently undo the ref - don't trigger destruction in the referent
+  * for a second time */
+ if (SvROK(ud->rsv) && SvRV(ud->rsv) == sv) {
+  --SvREFCNT(sv);
+  SvRV_set(ud->rsv, NULL);
+  SvROK_off(ud->rsv);
+ }
+ SvREFCNT_dec_NN(ud->rsv);
+
   /* We are about to croak() while sv is being destroyed. Try to clean up
    * things a bit. */
   mg = SvMAGIC(sv);
@@ -1467,7 +1481,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 +1531,9 @@ static int vmg_svt_free(pTHX_ SV *sv, MAGIC *mg) {
 
  PUSHMARK(SP);
  EXTEND(SP, 2);
- PUSHs(sv_2mortal(newRV_inc(sv)));
+ /* This will bump the refcount of sv from 0 to 1 */
+ ud.rsv = newRV_inc(sv);
+ PUSHs(ud.rsv);
  PUSHs(mg->mg_obj ? mg->mg_obj : &PL_sv_undef);
  if (w->opinfo)
   XPUSHs(vmg_op_info(w->opinfo));
@@ -1544,6 +1560,15 @@ static int vmg_svt_free(pTHX_ SV *sv, MAGIC *mg) {
 
  POPSTACK;
 
+ /* 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);
+
  FREETMPS;
  LEAVE;