avoid SEGVs on goto &xs_sub

GH #19936

When the sub which is being left gets freed, like:

    sub foo { *foo = sub {}; goto &xs_sub }

it can leave PL_op as a NULL pointer while the XS sub is being executed.
My recent commit  v5.37.1-83-g58cf04199f, which fixed the value of
GIMME_V in such XS subs, made the problem more noticeable, since it
caused PL_op to always be accessed.

The fix is to defer the freeing of the old sub when goto'ing an XS sub.

1 files changed, 10 insertions, 1 deletions

diff --git a/pp_ctl.c b/pp_ctl.c
index 026148940a..57cf98537f 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -2877,6 +2877,7 @@ PP(pp_goto)
             PERL_CONTEXT *cx;
             CV *cv = MUTABLE_CV(SvRV(sv));
             AV *arg = GvAV(PL_defgv);
+            CV *old_cv = NULL;
 
             while (!CvROOT(cv) && !CvXSUB(cv)) {
                 const GV * const gv = CvGV(cv);
@@ -2980,7 +2981,13 @@ PP(pp_goto)
 
             if (CxTYPE(cx) == CXt_SUB) {
                 CvDEPTH(cx->blk_sub.cv) = cx->blk_sub.olddepth;
-                SvREFCNT_dec_NN(cx->blk_sub.cv);
+                /*on XS calls defer freeing the old CV as it could
+                 * prematurely set PL_op to NULL, which could cause
+                 * e..g XS subs using GIMME_V to SEGV */
+                if (CvISXSUB(cv))
+                    old_cv = cx->blk_sub.cv;
+                else
+                    SvREFCNT_dec_NN(cx->blk_sub.cv);
             }
 
             /* Now do some callish stuff. */
@@ -2993,6 +3000,8 @@ PP(pp_goto)
                 ENTER;
                 SAVETMPS;
                 SAVEFREESV(cv); /* later, undo the 'avoid premature free' hack */
+                if (old_cv)
+                    SAVEFREESV(old_cv); /* ditto, deferred freeing of old CV */
 
                 /* put GvAV(defgv) back onto stack */
                 if (items) {