Revert "FREETMPS when leaving eval, even when void/dying"

This reverts commit 214949f5cdc4164f25e32c1a6ce989286456c205.

It breaks Variable::Magic.

Temporarily revert while we work out what to do.

diff --git a/pp_ctl.c b/pp_ctl.c
index 3c20f88..5a66e26 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1598,7 +1598,7 @@ Perl_qerror(pTHX_ SV *err)
 static void
 S_pop_eval_context_maybe_croak(pTHX_ PERL_CONTEXT *cx, SV *errsv, int action)
 {
-    SV  *namesv = NULL; /* just to silence compiler warnings */
+    SV  *namesv;
     bool do_croak;
 
     CX_LEAVE_SCOPE(cx);
@@ -1654,13 +1654,7 @@ Perl_die_unwind(pTHX_ SV *msv)
     if (in_eval) {
        I32 cxix;
 
-        /* We need to keep this SV alive through all the stack unwinding
-         * and FREETMPSing below, while ensuing that it doesn't leak
-         * if we call out to something which then dies (e.g. sub STORE{die}
-         * when unlocalising a tied var). So we do a dance with
-         * mortalising and SAVEFREEing.
-         */
-        sv_2mortal(SvREFCNT_inc_simple_NN(exceptsv));
+        exceptsv = sv_2mortal(SvREFCNT_inc_simple_NN(exceptsv));
 
        /*
         * Historically, perl used to set ERRSV ($@) early in the die
@@ -1729,24 +1723,6 @@ Perl_die_unwind(pTHX_ SV *msv)
 
            restartjmpenv = cx->blk_eval.cur_top_env;
            restartop     = cx->blk_eval.retop;
-
-            /* We need a FREETMPS here to avoid late-called destructors
-             * clobbering $@ *after* we set it below, e.g.
-             *    sub DESTROY { eval { die "X" } }
-             *    eval { my $x = bless []; die $x = 0, "Y" };
-             *    is($@, "Y")
-             * Here the clearing of the $x ref mortalises the anon array,
-             * which needs to be freed *before* $& is set to "Y",
-             * otherwise it gets overwritten with "X".
-             *
-             * However, the FREETMPS will clobber exceptsv, so preserve it
-             * on the savestack for now.
-             */
-            SAVEFREESV(SvREFCNT_inc_simple_NN(exceptsv));
-            FREETMPS;
-            /* now we're about to pop the savestack, so re-mortalise it */
-            sv_2mortal(SvREFCNT_inc_simple_NN(exceptsv));
-
             /* Note that unlike pp_entereval, pp_require isn't supposed to
              * trap errors. So if we're a require, after we pop the
              * CXt_EVAL that pp_require pushed, rethrow the error with
@@ -4329,11 +4305,8 @@ PP(pp_leaveeval)
                     ? SvTRUE(*PL_stack_sp)
                     : PL_stack_sp > oldsp);
 
-    if (gimme == G_VOID) {
+    if (gimme == G_VOID)
         PL_stack_sp = oldsp;
-        /* free now to avoid late-called destructors clobbering $@ */
-        FREETMPS;
-    }
     else
         leave_adjust_stacks(oldsp, oldsp, gimme, 0);
 
@@ -4422,11 +4395,8 @@ PP(pp_leavetry)
     oldsp = PL_stack_base + cx->blk_oldsp;
     gimme = cx->blk_gimme;
 
-    if (gimme == G_VOID) {
+    if (gimme == G_VOID)
         PL_stack_sp = oldsp;
-        /* free now to avoid late-called destructors clobbering $@ */
-        FREETMPS;
-    }
     else
         leave_adjust_stacks(oldsp, oldsp, gimme, 1);
     CX_LEAVE_SCOPE(cx);

diff --git a/t/op/eval.t b/t/op/eval.t
index bb31f83..7b9fb17 100644 (file)
--- a/t/op/eval.t
+++ b/t/op/eval.t
@@ -6,7 +6,7 @@ BEGIN {
     set_up_inc('../lib');
 }
 
-plan(tests => 140);
+plan(tests => 134);
 
 eval 'pass();';
 
@@ -665,35 +665,3 @@ pass("eval in freed package does not crash");
     sub { $s; DB::f127786}->();
     pass("RT #127786");
 }
-
-# Late calling of destructors overwriting $@.
-# When leaving an eval scope (either by falling off the end or dying),
-# we must ensure that any temps are freed before the end of the eval
-# leave: in particular before $@ is set (to either "" or the error),
-# because otherwise the tmps freeing may call a destructor which
-# will change $@ (e.g. due to a successful eval) *after* its been set.
-# Some extra nested scopes are included in the tests to ensure they don't
-# affect the tmps freeing.
-
-{
-    package TMPS;
-    sub DESTROY { eval { die "died in DESTROY"; } } # alters $@
-
-    eval { { 1; { 1; bless []; } } };
-    ::is ($@, "", "FREETMPS: normal try exit");
-
-    eval q{ { 1; { 1; bless []; } } };
-    ::is ($@, "", "FREETMPS: normal string eval exit");
-
-    eval { { 1; { 1; return bless []; } } };
-    ::is ($@, "", "FREETMPS: return try exit");
-
-    eval q{ { 1; { 1; return bless []; } } };
-    ::is ($@, "", "FREETMPS: return string eval exit");
-
-    eval { { 1; { 1; my $x = bless []; die $x = 0, "die in eval"; } } };
-    ::like ($@, qr/die in eval/, "FREETMPS: die try exit");
-
-    eval q{ { 1; { 1; my $x = bless []; die $x = 0, "die in eval"; } } };
-    ::like ($@, qr/die in eval/, "FREETMPS: die eval string exit");
-}