develooper Front page | perl.perl5.porters | Postings from November 2016

Re: Confused by eval behavior

Thread Previous | Thread Next
Dave Mitchell
November 25, 2016 17:23
Re: Confused by eval behavior
Message ID:
On Mon, Nov 14, 2016 at 05:46:38PM -0200, Vincent Pit (VPIT) wrote:
> Sorry for the delay, I've been quite busy and completely forgot about your
> message.

No worries :-)

> > > And is it intended that the free anon sub should called exactly once?
> Yes.

Well, V::M currently calls the anon sub twice, while blead with my eval
FREETMPS patch goes into an infinite loop.

However, applying the proof-of-concept diff below makes it be called
only once.

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 };
     &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
    result of eval = []
    just after eval

The mortal RV that is created to temporarily point at the scalar being
freed (the IV(123) above) to apss 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 below 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.

I've only tested this patch on threaded (blead + my eval/FREETMPS patch)
and threaded 5.24.0. I don't fully understand all the code paths in V::M
so the patch may well require further work to make it robust and/or
work with older perls. Which hopefully you'll do rather than me.

diff --git a/Magic.xs b/Magic.xs
index 116eb8a..3cf8477 100644
--- a/Magic.xs
+++ b/Magic.xs
@@ -1416,6 +1416,7 @@ static MGVTBL vmg_propagate_errsv_vtbl = {
 typedef struct {
  SV  *sv;
+ SV  *rsv; /* temporary ref to sv */
  int  in_eval;
  I32  base;
 } vmg_svt_free_cleanup_ud;
@@ -1460,6 +1461,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 +1477,7 @@ static int vmg_svt_free_cleanup(pTHX_ void *ud_) {
    vmg_mg_del(sv, NULL, mg, mg->mg_moremagic);
-  SvREFCNT_dec(sv);
+  SvREFCNT_dec(sv); /* re-trigger destruction */
   vmg_dispell_guard_oncroak(aTHX_ NULL);
@@ -1517,7 +1527,9 @@ static int vmg_svt_free(pTHX_ SV *sv, MAGIC *mg) {
  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)
@@ -1544,6 +1556,15 @@ static int vmg_svt_free(pTHX_ SV *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) {
+  SvRV_set(ud.rsv, NULL);
+  SvROK_off(ud.rsv);
+  --SvREFCNT(sv); /* silent */
+ }
+ SvREFCNT_dec_NN(ud.rsv);

The crew of the Enterprise encounter an alien life form which is
surprisingly neither humanoid nor made from pure energy.
    -- Things That Never Happen in "Star Trek" #22

Thread Previous | Thread Next Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at | Group listing | About