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.
# define SvREFCNT_inc_simple_void(sv) ((void) SvREFCNT_inc(sv))
#endif
# 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
#ifndef mPUSHu
# define mPUSHu(U) PUSHs(sv_2mortal(newSVuv(U)))
#endif
+ SV *rsv; /* The ref to the sv currently being freed, pushed on the stack */
int in_eval;
I32 base;
} vmg_svt_free_cleanup_ud;
int in_eval;
I32 base;
} vmg_svt_free_cleanup_ud;
SV *sv = ud->sv;
MAGIC *mg;
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);
/* 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);
}
vmg_mg_del(sv, NULL, mg, mg->mg_moremagic);
mg_magical(sv);
}
+ SvREFCNT_dec(sv); /* Re-trigger destruction */
vmg_dispell_guard_oncroak(aTHX_ NULL);
vmg_dispell_guard_oncroak(aTHX_ NULL);
PUSHMARK(SP);
EXTEND(SP, 2);
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));
PUSHs(mg->mg_obj ? mg->mg_obj : &PL_sv_undef);
if (w->opinfo)
XPUSHs(vmg_op_info(w->opinfo));
+ /* 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);
+