pp_ctl.c - move "UNITCHECK in an eval" JMPENV_PUSH() logic to a function

This creates S_try_run_unitcheck(), which is similar to S_try_yyparse(),
in that it runs the subs in PL_unitcheckav inside of a JMPENV_PUSH() and
JMPENV_POP wrapper so that any call to Perl_croak() inside of one of the
blocks ends back in the right place. This is used to handle UNITCHECK
blocks defined inside of an eval STRING which is compiled and executed
as part of doeval_compile() in pp_ctl.c

Both of these functions are private to pp_ctl.c and not listed in
embed.c and are used to trap the setjmp/longjmp calls and handle
exceptions during eval.

This fixes a cryptic warning about a variable being used across setjmp
in pp_ctl.c doeval_compile(), which turns out to be evalcv. By wrapping
the JMPENV_PUSH logic in a light wrapper these issues are moved one
layer down the stack and avoided.

1 files changed, 43 insertions, 43 deletions

diff --git a/pp_ctl.c b/pp_ctl.c
index 169b3ac6d5..4e43d9a719 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -3547,6 +3547,32 @@ S_try_yyparse(pTHX_ int gramtype)
     return ret;
 }
 
+/* Run PL_unitcheckav in a setjmp wrapper via call_list.
+ * Returns:
+ *   0: unitcheck blocks ran without error
+ *   3: a unitcheck block died
+ */
+STATIC int
+S_try_run_unitcheck(pTHX)
+{
+    int ret;
+    dJMPENV;
+    JMPENV_PUSH(ret);
+    switch (ret) {
+    case 0:
+        call_list(PL_scopestack_ix, PL_unitcheckav);
+        break;
+    case 3:
+        /* call_list die and threw an error */
+        break;
+    default:
+        JMPENV_POP;
+        JMPENV_JUMP(ret);
+        NOT_REACHED; /* NOTREACHED */
+    }
+    JMPENV_POP;
+    return ret;
+}
 
 /* Compile a require/do or an eval ''.
  *
@@ -3752,54 +3778,28 @@ S_doeval_compile(pTHX_ U8 gimme, CV* outside, U32 seq, HV *hh)
 
     if (PL_unitcheckav && av_count(PL_unitcheckav)>0) {
         OP *es = PL_eval_start;
+        /* TODO: are we sure we shouldn't do S_try_run_unitcheck()
+        * when `in_require` is true? */
         if (in_require) {
             call_list(PL_scopestack_ix, PL_unitcheckav);
-        } else {
-            /* TODO: are we sure we shouldn't do JMPENV_PUSH in
-             * when `in_require` is true? */
-            int ret=0;
-            dJMPENV;
-            JMPENV_PUSH(ret);
-            switch (ret) {
-            case 0:
-                /*
-                 * Doesn't seem like PUSHMARK(SP)/ENTER
-                 * is needed here. */
-
-                call_list(PL_scopestack_ix, PL_unitcheckav);
-                /* Nor LEAVE here. */
-                break;
-            case 3: {
-                /* call_list failed and threw an error */
-
-                /* Restore PL_OP */
-                PL_op = saveop;
-
-                SV *errsv = ERRSV;
-                if (!*(SvPV_nolen_const(errsv))) {
-                    /* This happens when using:
-                     * eval qq# UNITCHECK { die "\x00"; } #;
-                     */
-                    sv_setpvs(errsv, "Unit check error");
-                }
+        }
+        else if (S_try_run_unitcheck(aTHX)) {
+            /* there was an error! */
 
-                /* We're returning so POP our JMPENV */
-                /* NOTE: in `S_try_yyparse` the default for ret=3 is to
-                 *       break which falls back to the `JMPENV_POP`
-                 *       after the switch. In this code we're returning
-                 *       early so we must POP it outrself. */
-                JMPENV_POP;
+            /* Restore PL_OP */
+            PL_op = saveop;
 
-                if (gimme != G_LIST) PUSHs(&PL_sv_undef);
-                PUTBACK;
-                return FALSE;
-              }
-            default:
-                JMPENV_POP;
-                JMPENV_JUMP(ret);
-                NOT_REACHED; /* NOTREACHED */
+            SV *errsv = ERRSV;
+            if (!*(SvPV_nolen_const(errsv))) {
+                /* This happens when using:
+                 * eval qq# UNITCHECK { die "\x00"; } #;
+                 */
+                sv_setpvs(errsv, "Unit check error");
             }
-            JMPENV_POP;
+
+            if (gimme != G_LIST) PUSHs(&PL_sv_undef);
+            PUTBACK;
+            return FALSE;
         }
         PL_eval_start = es;
     }