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.

2 files changed, 26 insertions, 2 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) {
diff --git a/t/op/goto.t b/t/op/goto.t
index 31bf2b2f31..d951aefcdf 100644
--- a/t/op/goto.t
+++ b/t/op/goto.t
@@ -11,7 +11,7 @@ BEGIN {
 
 use warnings;
 use strict;
-plan tests => 131;
+plan tests => 133;
 our $TODO;
 
 my $deprecated = 0;
@@ -935,3 +935,18 @@ SKIP:
     @a = g_19188();
     is ($XS::APItest::GIMME_V, 3, 'xs_goto indirect list (#19188)');
 }
+
+# GH #19936 segfault on goto &xs_sub when calling sub is replaced
+SKIP:
+{
+    skip "No XS::APItest in miniperl", 2 if is_miniperl();
+
+    # utf8::is_utf8() is just an example of an XS sub
+    sub foo_19936 { *foo_19936 = {}; goto &utf8::is_utf8 }
+    ok(foo_19936("\x{100}"), "GH #19936 utf8 XS call");
+
+    # the gimme XS function accesses PL_op, which was null before the fix
+    sub bar_19936 { *bar_19936 = {}; goto &XS::APItest::gimme }
+    my @a = bar_19936();
+    is($XS::APItest::GIMME_V, 3, "GH #19936 gimme XS call");
+}