Better fix for #8738 (Core dump in 'leavetry')

When in an inner runops loop (eg via a tie or sort), an eval
needs a new JMPENV pushing by S_docatch. If an exception is raised,
control is returned to S_docatch, and it must determine whether
the eval that trapped the exception is an inner eval or an outer
one. In the former case, restart the loop, in the latter case,
rethrow the exception. This is determined by whether we are still
at the same PL_curstackinfo level. This fails in the case of
SPLICE(), which pushes a new SETJMP and runops level, but not a
new stackinfo level. There may be other code which does similar.
The solution is to store the current value of PL_top_env in each
pushed CxEVAL, and see if it's still the same as PL_top_env when
the exception is handled.

p4raw-id: //depot/perl@24363

1 files changed, 14 insertions, 2 deletions

diff --git a/pp_ctl.c b/pp_ctl.c
index ea83d1805b..c4aa30ed72 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -2681,7 +2681,6 @@ S_docatch(pTHX_ OP *o)
 {
     int ret;
     OP * const oldop = PL_op;
-    volatile PERL_SI *cursi = PL_curstackinfo;
     dJMPENV;
 
 #ifdef DEBUGGING
@@ -2692,12 +2691,25 @@ S_docatch(pTHX_ OP *o)
     JMPENV_PUSH(ret);
     switch (ret) {
     case 0:
+	assert(cxstack_ix >= 0);
+	assert(CxTYPE(&cxstack[cxstack_ix]) == CXt_EVAL);
+	cxstack[cxstack_ix].blk_eval.cur_top_env = PL_top_env;
  redo_body:
 	docatch_body();
 	break;
     case 3:
 	/* die caught by an inner eval - continue inner loop */
-	if (PL_restartop && cursi == PL_curstackinfo) {
+
+	/* NB XXX we rely on the old popped CxEVAL still being at the top
+	 * of the stack; the way die_where() currently works, this
+	 * assumption is valid. In theory The cur_top_env value should be
+	 * returned in another global, the way retop (aka PL_restartop)
+	 * is. */
+	assert(CxTYPE(&cxstack[cxstack_ix+1]) == CXt_EVAL);
+
+	if (PL_restartop
+	    && cxstack[cxstack_ix+1].blk_eval.cur_top_env == PL_top_env)
+	{
 	    PL_op = PL_restartop;
 	    PL_restartop = 0;
 	    goto redo_body;