This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
call_sv(), fold_const(): different CX pop test
authorDavid Mitchell <davem@iabyn.com>
Fri, 17 Jul 2015 13:44:32 +0000 (14:44 +0100)
committerDavid Mitchell <davem@iabyn.com>
Wed, 3 Feb 2016 08:59:37 +0000 (08:59 +0000)
Perl_call_sv() and S_fold_constants() both have similar code that:
pushes an EVAL context, does a JMPENV_PUSH() and CALLRUNOPS(), then
optionally pops the EVAL context.

The optionally part depends on whether what's doing the dying
has already popped the context before long-jumping. Currently the decision
on whether to pop is based on whether the scope stack has already been
popped.

This commit changes that to whether the context stack has already been
popped, since shortly we're going to change eval contexts so that the old
savestack_ix is stored in the CX struct rather than on the scope stack.

I ran this code with some asserts that the two conditions were identical,
and nothing failed.

op.c
perl.c

diff --git a/op.c b/op.c
index ecd6259..15ced90 100644 (file)
--- a/op.c
+++ b/op.c
@@ -4258,12 +4258,12 @@ S_fold_constants(pTHX_ OP *o)
     bool is_stringify;
     SV * VOL sv = NULL;
     int ret = 0;
-    I32 oldscope;
     OP *old_next;
     SV * const oldwarnhook = PL_warnhook;
     SV * const olddiehook  = PL_diehook;
     COP not_compiling;
     U8 oldwarn = PL_dowarn;
+    I32 old_cxix;
     dJMPENV;
 
     PERL_ARGS_ASSERT_FOLD_CONSTANTS;
@@ -4344,7 +4344,7 @@ S_fold_constants(pTHX_ OP *o)
     o->op_next = 0;
     PL_op = curop;
 
-    oldscope = PL_scopestack_ix;
+    old_cxix = cxstack_ix;
     create_eval_scope(G_FAKINGEVAL);
 
     /* Verify that we don't need to save it:  */
@@ -4396,9 +4396,13 @@ S_fold_constants(pTHX_ OP *o)
     PL_diehook  = olddiehook;
     PL_curcop = &PL_compiling;
 
-    if (PL_scopestack_ix > oldscope)
-       delete_eval_scope();
-
+    /* if we croaked, depending on how we croaked the eval scope
+     * may or may not have already been popped */
+    if (cxstack_ix > old_cxix) {
+        assert(cxstack_ix == old_cxix + 1);
+        assert(CxTYPE(&cxstack[cxstack_ix]) == CXt_EVAL);
+        delete_eval_scope();
+    }
     if (ret)
        goto nope;
 
diff --git a/perl.c b/perl.c
index 1d94b38..a7938bd 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -2711,7 +2711,6 @@ Perl_call_sv(pTHX_ SV *sv, VOL I32 flags)
     METHOP method_op;
     I32 oldmark;
     VOL I32 retval = 0;
-    I32 oldscope;
     bool oldcatch = CATCH_GET;
     int ret;
     OP* const oldop = PL_op;
@@ -2743,7 +2742,6 @@ Perl_call_sv(pTHX_ SV *sv, VOL I32 flags)
        PUTBACK;
     }
     oldmark = TOPMARK;
-    oldscope = PL_scopestack_ix;
 
     if (PERLDB_SUB && PL_curstash != PL_debstash
           /* Handle first BEGIN of -d. */
@@ -2777,8 +2775,10 @@ Perl_call_sv(pTHX_ SV *sv, VOL I32 flags)
        CATCH_SET(oldcatch);
     }
     else {
+        I32 old_cxix;
        myop.op_other = (OP*)&myop;
        (void)POPMARK;
+        old_cxix = cxstack_ix;
        create_eval_scope(flags|G_FAKINGEVAL);
        (void)INCMARK;
 
@@ -2820,8 +2820,13 @@ Perl_call_sv(pTHX_ SV *sv, VOL I32 flags)
            break;
        }
 
-       if (PL_scopestack_ix > oldscope)
+        /* if we croaked, depending on how we croaked the eval scope
+         * may or may not have already been popped */
+       if (cxstack_ix > old_cxix) {
+            assert(cxstack_ix == old_cxix + 1);
+            assert(CxTYPE(&cxstack[cxstack_ix]) == CXt_EVAL);
            delete_eval_scope();
+        }
        JMPENV_POP;
     }