pp_ctl.c - handle UNITCHECK better

Make sure we actually return via pp_evalcomp() when UNITCHECK
inside of an eval dies.

Thanks to Bram for the work figuring this out.

1 files changed, 49 insertions, 1 deletions

diff --git a/pp_ctl.c b/pp_ctl.c
index 68c22ff490..fb09d4f6c5 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -3752,7 +3752,55 @@ S_doeval_compile(pTHX_ U8 gimme, CV* outside, U32 seq, HV *hh)
 
     if (PL_unitcheckav) {
         OP *es = PL_eval_start;
-        call_list(PL_scopestack_ix, PL_unitcheckav);
+        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");
+                }
+
+                /* 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;
+
+                if (gimme != G_LIST) PUSHs(&PL_sv_undef);
+                PUTBACK;
+                return FALSE;
+              }
+            default:
+                JMPENV_POP;
+                JMPENV_JUMP(ret);
+                NOT_REACHED; /* NOTREACHED */
+            }
+            JMPENV_POP;
+        }
         PL_eval_start = es;
     }