[perl #99850] SEGV when destructor undefs goto &sub

If goto &sub triggers a destructor that undefines &sub, a
crash ensues.

This commit adds an extra check in pp_goto after the unwinding of the
previous sub’s scope.

2 files changed, 25 insertions, 1 deletions

diff --git a/pp_ctl.c b/pp_ctl.c
index 7e062810a6..2d93cc14cd 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -2879,6 +2879,19 @@ PP(pp_goto)
 	    oldsave = PL_scopestack[PL_scopestack_ix - 1];
 	    LEAVE_SCOPE(oldsave);
 
+	    /* A destructor called during LEAVE_SCOPE could have undefined
+	     * our precious cv.  See bug #99850. */
+	    if (!CvROOT(cv) && !CvXSUB(cv)) {
+		const GV * const gv = CvGV(cv);
+		if (gv) {
+		    SV * const tmpstr = sv_newmortal();
+		    gv_efullname3(tmpstr, gv, NULL);
+		    DIE(aTHX_ "Goto undefined subroutine &%"SVf"",
+			       SVfARG(tmpstr));
+		}
+		DIE(aTHX_ "Goto undefined subroutine");
+	    }
+
 	    /* Now do some callish stuff. */
 	    SAVETMPS;
 	    SAVEFREESV(cv); /* later, undo the 'avoid premature free' hack */
diff --git a/t/op/goto.t b/t/op/goto.t
index f2f91629ec..ad83c29e99 100644
--- a/t/op/goto.t
+++ b/t/op/goto.t
@@ -10,7 +10,7 @@ BEGIN {
 
 use warnings;
 use strict;
-plan tests => 78;
+plan tests => 79;
 our $TODO;
 
 my $deprecated = 0;
@@ -205,6 +205,17 @@ sub f1 {
 }
 f1();
 
+# bug #99850, which is similar - freeing the subroutine we are about to
+# go(in)to during a FREETMPS call should not crash perl.
+
+package _99850 {
+    sub reftype{}
+    DESTROY { undef &reftype }
+    eval { sub { my $guard = bless []; goto &reftype }->() };
+}
+like $@, qr/^Goto undefined subroutine &_99850::reftype at /,
+   'goto &foo undefining &foo on sub cleanup';
+
 # bug #22181 - this used to coredump or make $x undefined, due to
 # erroneous popping of the inner BLOCK context