In perl.git, the branch blead has been updated

<https://perl5.git.perl.org/perl.git/commitdiff/b4dcd72d7c1fd970030db81f13b3824d51aeb9b6?hp=d594884e1d755afc27a0fee39c2025cc581a3dc4>

- Log -----------------------------------------------------------------
commit b4dcd72d7c1fd970030db81f13b3824d51aeb9b6
Author: Father Chrysostomos <spr...@cpan.org>
Date:   Fri Feb 23 17:59:09 2018 -0800

    [perl #132854] Allow goto into first arg of bin op
    
    This particular case does not risk any stack corruption, and there is
    a CPAN module depending on it working (PerlX::AsyncAwait).

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

Summary of changes:
 pod/perldelta.pod |  7 ++++++-
 pod/perlfunc.pod  |  4 +++-
 pp_ctl.c          |  8 ++++++++
 t/op/goto.t       | 12 +++++++++++-
 4 files changed, 28 insertions(+), 3 deletions(-)

diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index e7260c7036..922c2a649f 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -284,7 +284,12 @@ XXX Changes (i.e. rewording) of diagnostic messages go here
 
 =item *
 
-XXX Describe change here
+The new (as of 5.27.8) restriction forbidding use of C<goto> to enter the
+argument of a binary or list expression (see L<perldiag/"Can't
+E<quot>gotoE<quot> into a binary or list expression">) has been relaxed to
+allow entering the I<first> argument of an operator that takes a fixed
+number of arguments, since this is a case that will not cause stack
+corruption.  [perl #132854]
 
 =back
 
diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod
index 53a19af531..ce989b0a0c 100644
--- a/pod/perlfunc.pod
+++ b/pod/perlfunc.pod
@@ -3458,7 +3458,9 @@ deprecated and will issue a warning.  Even then, it may 
not be used to
 go into any construct that requires initialization, such as a
 subroutine, a C<foreach> loop, or a C<given>
 block.  In general, it may not be used to jump into the parameter
-of a binary or list operator.  It also can't be used to go into a
+of a binary or list operator, but it may be used to jump into the
+I<first> parameter of a binary operator or other operator that takes
+a fixed number of arguments.  It also can't be used to go into a
 construct that is optimized away.
 
 The C<goto &NAME> form is quite different from the other forms of
diff --git a/pp_ctl.c b/pp_ctl.c
index 89eca4b92a..ddcbf7c0e3 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -2687,6 +2687,7 @@ S_dofindlabel(pTHX_ OP *o, const char *label, STRLEN len, 
U32 flags, OP **opstac
     *ops = 0;
     if (o->op_flags & OPf_KIDS) {
        OP *kid;
+       OP * const kid1 = cUNOPo->op_first;
        /* First try all the kids at this level, since that's likeliest. */
        for (kid = cUNOPo->op_first; kid; kid = OpSIBLING(kid)) {
            if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE) {
@@ -2709,6 +2710,7 @@ S_dofindlabel(pTHX_ OP *o, const char *label, STRLEN len, 
U32 flags, OP **opstac
            }
        }
        for (kid = cUNOPo->op_first; kid; kid = OpSIBLING(kid)) {
+           bool first_kid_of_binary = FALSE;
            if (kid == PL_lastgotoprobe)
                continue;
            if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE) {
@@ -2721,8 +2723,14 @@ S_dofindlabel(pTHX_ OP *o, const char *label, STRLEN 
len, U32 flags, OP **opstac
                else
                    *ops++ = kid;
            }
+           if (kid == kid1 && ops != opstack && ops[-1] == UNENTERABLE) {
+               first_kid_of_binary = TRUE;
+               ops--;
+           }
            if ((o = dofindlabel(kid, label, len, flags, ops, oplimit)))
                return o;
+           if (first_kid_of_binary)
+               *ops++ = UNENTERABLE;
        }
     }
     *ops = 0;
diff --git a/t/op/goto.t b/t/op/goto.t
index 2bd7972945..7f03bc00e4 100644
--- a/t/op/goto.t
+++ b/t/op/goto.t
@@ -10,7 +10,7 @@ BEGIN {
 
 use warnings;
 use strict;
-plan tests => 122;
+plan tests => 123;
 our $TODO;
 
 my $deprecated = 0;
@@ -870,3 +870,13 @@ sub _routine {
 }
 _routine();
 pass("bug 132799");
+
+# [perl #132854]
+# Goto the *first* parameter of a binary expression, which is harmless.
+eval {
+    goto __GEN_2;
+    my $sent = do {
+        __GEN_2:
+    };
+};
+is $@,'', 'goto the first parameter of a binary expression [perl #132854]';

-- 
Perl5 Master Repository

Reply via email to