develooper Front page | perl.perl5.changes | Postings from February 2018

[perl.git] branch blead updated. v5.27.8-154-g4bfb5532d3

From:
Father Chrysostomos
Date:
February 5, 2018 07:17
Subject:
[perl.git] branch blead updated. v5.27.8-154-g4bfb5532d3
Message ID:
E1eib20-0001F0-5K@git.dc.perl.space
In perl.git, the branch blead has been updated

<https://perl5.git.perl.org/perl.git/commitdiff/4bfb5532d393d56b18d13bc19f70f6f7a64ae781?hp=ae315a0a3c51e68887704d4907bb6a502a6d4e3f>

- Log -----------------------------------------------------------------
commit 4bfb5532d393d56b18d13bc19f70f6f7a64ae781
Author: Father Chrysostomos <sprout@cpan.org>
Date:   Sun Feb 4 22:50:15 2018 -0800

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

-----------------------------------------------------------------------

Summary of changes:
 pp_ctl.c    | 10 ++++++----
 t/op/goto.t | 14 +++++++++++++-
 2 files changed, 19 insertions(+), 5 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;
diff --git a/t/op/goto.t b/t/op/goto.t
index 9b7e5ec2f7..2bd7972945 100644
--- a/t/op/goto.t
+++ b/t/op/goto.t
@@ -10,7 +10,7 @@ BEGIN {
 
 use warnings;
 use strict;
-plan tests => 121;
+plan tests => 122;
 our $TODO;
 
 my $deprecated = 0;
@@ -858,3 +858,15 @@ is sub { goto z; exit do { z: return "foo" } }->(), 'foo',
    'goto into exit';
 is sub { goto z; eval do { z: "'foo'" } }->(), 'foo',
    'goto into eval';
+
+# [perl #132799]
+# Erroneous inward goto warning, followed by crash.
+# The eval must be in an assignment.
+sub _routine {
+    my $e = eval {
+        goto L2;
+      L2:
+    }
+}
+_routine();
+pass("bug 132799");

-- 
Perl5 Master Repository



nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About