[perl #132799] Fix goto within block within expr

When goto looks for a label, it builds up a list of ops to enter.  But
it begins its search a little too far out relative to the ‘goto’.
Hence, the first op gets skipped.

In 6d90e983841, I forbade same cases of inward goto-into-expression to
avoid stack corruption and crashes.  I did this by pushing a marker
on to the list of ops to enter, indicating that an error should be
thrown instead.

Because goto starts the search too far up the context stack, it would
sometimes end up looking inside an expression, which would cause the
first op on the entry list to be such a marker, meaning that the next
item, which should have been skipped, would not be.

That could really screw up the context stack for cases like:

    my $e = eval { goto label; label: }

because the entry list would be:

    <croak-marker> entertry

instead of the previous:

    entertry

Hence, entertry (which enters eval{}) would be executed from *within*
the eval, causing the exit of the eval to leave an eval on the context
stack.  Crashes ensued.

This commit fixes it by checking whether we have moved past the begin-
ning of the list of entry ops before pushing a croak-marker on to it.

Goto’s implementation is really complex, and always has been.  It
could be greatly simplified now thot ops have parent pointers.  But
that should wait for another developement cycle.

1 files changed, 6 insertions, 4 deletions

diff --git a/pp_ctl.c b/pp_ctl.c
index 4da40e39b3..89eca4b92a 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -2645,6 +2645,7 @@ PP(pp_redo)
 }
 
 #define UNENTERABLE (OP *)1
+#define GOTO_DEPTH 64
 
 STATIC OP *
 S_dofindlabel(pTHX_ OP *o, const char *label, STRLEN len, U32 flags, OP **opstack, OP **oplimit)
@@ -2665,11 +2666,12 @@ S_dofindlabel(pTHX_ OP *o, const char *label, STRLEN len, U32 flags, OP **opstac
     {
 	*ops++ = cUNOPo->op_first;
     }
-    else if (o->op_flags & OPf_KIDS
+    else if (oplimit - opstack < GOTO_DEPTH) {
+      if (o->op_flags & OPf_KIDS
 	  && cUNOPo->op_first->op_type == OP_PUSHMARK) {
 	*ops++ = UNENTERABLE;
-    }
-    else if (o->op_flags & OPf_KIDS && PL_opargs[o->op_type]
+      }
+      else if (o->op_flags & OPf_KIDS && PL_opargs[o->op_type]
 	  && OP_CLASS(o) != OA_LOGOP
 	  && o->op_type != OP_LINESEQ
 	  && o->op_type != OP_SREFGEN
@@ -2678,6 +2680,7 @@ S_dofindlabel(pTHX_ OP *o, const char *label, STRLEN len, U32 flags, OP **opstac
 	OP * const kid = cUNOPo->op_first;
 	if (OP_GIMME(kid, 0) != G_SCALAR || OpHAS_SIBLING(kid))
 	    *ops++ = UNENTERABLE;
+      }
     }
     if (ops >= oplimit)
 	Perl_croak(aTHX_ "%s", too_deep);
@@ -2752,7 +2755,6 @@ PP(pp_goto)
     OP *retop = NULL;
     I32 ix;
     PERL_CONTEXT *cx;
-#define GOTO_DEPTH 64
     OP *enterops[GOTO_DEPTH];
     const char *label = NULL;
     STRLEN label_len = 0;