Blob Blame History Raw
From 695d6585affc8f13711f013329fb4810ab89d833 Mon Sep 17 00:00:00 2001
From: Father Chrysostomos <sprout@cpan.org>
Date: Tue, 14 Nov 2017 18:55:55 -0800
Subject: [PATCH] [perl #132442] Fix stack with do {my sub l; 1}
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

A block in perl usually compiles to a leave op with an enter inside
it, followed by the statements:

   leave
     enter
     nextstate
     ... expr ...
     nextstate
     ... expr ...

If a block contains only one statement, and that statement is suffic-
iently innocuous, then the enter/leave pair to create the scope at run
time get skipped, and instead we have a simple scope op which is not
even executed:

   scope
     ex-nextstate
     ... expr ...

The nextstate in this case also gets nulled.

In the case of do { my sub l; 1 } we were getting a variation of the
latter, that looked like this:

   scope
     introcv
     clonecv
     nextstate
     ... expr ...

The problem here is that nextstate resets the stack, even though a new
scope has not been pushed, so we end up with all existing stack items
from the *outer* scope getting clobbered.

One can have fun with this and erase everything pushed on to the stack
so far in a given statement:

$ ./perl -le 'print join "-", 1..10, do {my sub l; ","}, 11..20'
11,12,13,14,15,16,17,18,19,20

Here I replaced the first argument to join() from within the do{}
block, after having cleared the stack.

Why was the op tree was getting muddled up like this?  The ‘my sub’
declaration does not immediately add any ops to the op tree; those ops
get added when the current scope finishing compiling, since those ops
must be inserted at the beginning of the block.

I have not fully looked into the order that things happen, and why the
nextstate op does not get nulled; but it did not matter, because of
the simple fix: Treat lexical sub declarations as ‘not innocuous’ by
setting the HINT_BLOCK_SCOPE flag when a lexical sub is declared.
Thus, we end up with an enter/leave pair, which creates a
proper scope.

Signed-off-by: Petr Písař <ppisar@redhat.com>
---
 op.c          | 2 ++
 t/op/lexsub.t | 5 ++++-
 2 files changed, 6 insertions(+), 1 deletion(-)

diff --git a/op.c b/op.c
index 8fa5aad876..c617ad2a00 100644
--- a/op.c
+++ b/op.c
@@ -9243,6 +9243,8 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 
     PERL_ARGS_ASSERT_NEWMYSUB;
 
+    PL_hints |= HINT_BLOCK_SCOPE;
+
     /* Find the pad slot for storing the new sub.
        We cannot use PL_comppad, as it is the pad owned by the new sub.  We
        need to look in CvOUTSIDE and find the pad belonging to the enclos-
diff --git a/t/op/lexsub.t b/t/op/lexsub.t
index 3fa17acdda..f085cd97e8 100644
--- a/t/op/lexsub.t
+++ b/t/op/lexsub.t
@@ -7,7 +7,7 @@ BEGIN {
     *bar::is = *is;
     *bar::like = *like;
 }
-plan 149;
+plan 150;
 
 # -------------------- our -------------------- #
 
@@ -957,3 +957,6 @@ like runperl(
 {
   my sub h; sub{my $x; sub{h}}
 }
+
+is join("-", qw(aa bb), do { my sub lleexx; 123 }, qw(cc dd)),
+  "aa-bb-123-cc-dd", 'do { my sub...} in a list [perl #132442]';
-- 
2.13.6