[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.

diff --git a/pp_ctl.c b/pp_ctl.c
index 7e06281..2d93cc1 100644 (file)
--- 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 f2f9162..ad83c29 100644 (file)
--- 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