Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

B::Deparse puts 'no overloading' in the wrong place #10578

Closed
p5pRT opened this issue Aug 26, 2010 · 18 comments
Closed

B::Deparse puts 'no overloading' in the wrong place #10578

p5pRT opened this issue Aug 26, 2010 · 18 comments

Comments

@p5pRT
Copy link

p5pRT commented Aug 26, 2010

Migrated from rt.perl.org#77452 (status was 'resolved')

Searchable as RT77452$

@p5pRT
Copy link
Author

p5pRT commented Aug 26, 2010

From @nwc10

Created by @nwc10

B​::Deparse is getting the positioning of no overloading wrong​:

$ ./perl -Ilib -MO=Deparse -e 'print; { no overloading; $a + $b}; print'
print $_;
no overloading;
{
  $a + $b;
}
print $_;
-e syntax OK
$ ./perl -Ilib -MO=Deparse -e 'print do { no overloading; $a + $b}; print'
no overloading;
print do {
  $a + $b
};
print $_;
-e syntax OK

In both cases, it should be inside the block.
I don't know if this bug just applies to the overloading pragma.

Nicholas Clark

Perl Info

Flags:
    category=library
    severity=low
    module=B::Deparse

Site configuration information for perl 5.13.3:

Configured by nick at Thu Aug 26 11:15:57 BST 2010.

Summary of my perl5 (revision 5 version 13 subversion 3) configuration:
  Derived from: 63cf24924effea6eabe5e1216348eea653365fda
  Platform:
    osname=linux, osvers=2.6.18.8-xenu, archname=x86_64-linux-thread-multi
    uname='linux eris 2.6.18.8-xenu #1 smp sat oct 3 10:27:42 bst 2009 x86_64 gnulinux '
    config_args='-Dusedevel=y -Dcc=ccache gcc -Dld=gcc -Ubincompat5005 -Uinstallusrbinperl -Dcf_email=nick@ccl4.org -Dperladmin=nick@ccl4.org -Dinc_version_list=  -Dinc_version_list_init=0 -Doptimize=-g -Dusethreads -Uuselongdouble -Uuse64bitall -Dusemymalloc -Duseperlio -Dprefix=~/Sandpit/snap5.9.x-v5.13.3-277-g63cf249 -Uusevendorprefix -Uvendorprefix=~/Sandpit/snap5.9.x-v5.13.3-277-g63cf249 -Dinstallman1dir=none -Dinstallman3dir=none -Uuserelocatableinc -Umad -Accccflags=-DPERL_GLOBAL_STRUCT -de'
    hint=recommended, useposix=true, d_sigaction=define
    useithreads=define, usemultiplicity=define
    useperlio=define, d_sfio=undef, uselargefiles=define, usesocks=undef
    use64bitint=define, use64bitall=undef, uselongdouble=undef
    usemymalloc=y, bincompat5005=undef
  Compiler:
    cc='ccache gcc', ccflags ='-D_REENTRANT -D_GNU_SOURCE -DDEBUGGING -fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
    optimize='-g',
    cppflags='-D_REENTRANT -D_GNU_SOURCE -DDEBUGGING -fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include'
    ccversion='', gccversion='4.3.2', gccosandvers=''
    intsize=4, longsize=8, ptrsize=8, doublesize=8, byteorder=12345678
    d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=16
    ivtype='long', ivsize=8, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
    alignbytes=8, prototype=define
  Linker and Libraries:
    ld='gcc', ldflags =' -fstack-protector -L/usr/local/lib'
    libpth=/usr/local/lib /lib /usr/lib /lib64 /usr/lib64
    libs=-lnsl -ldb -ldl -lm -lcrypt -lutil -lpthread -lc
    perllibs=-lnsl -ldl -lm -lcrypt -lutil -lpthread -lc
    libc=/lib/libc-2.7.so, so=so, useshrplib=false, libperl=libperl.a
    gnulibc_version='2.7'
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E'
    cccdlflags='-fPIC', lddlflags='-shared -g -L/usr/local/lib -fstack-protector'

Locally applied patches:
    


@INC for perl 5.13.3:
    lib
    /home/nick/Sandpit/snap5.9.x-v5.13.3-277-g63cf249/lib/perl5/site_perl/5.13.3/x86_64-linux-thread-multi
    /home/nick/Sandpit/snap5.9.x-v5.13.3-277-g63cf249/lib/perl5/site_perl/5.13.3
    /home/nick/Sandpit/snap5.9.x-v5.13.3-277-g63cf249/lib/perl5/5.13.3/x86_64-linux-thread-multi
    /home/nick/Sandpit/snap5.9.x-v5.13.3-277-g63cf249/lib/perl5/5.13.3
    .


Environment for perl 5.13.3:
    HOME=/home/nick
    LANG (unset)
    LANGUAGE (unset)
    LD_LIBRARY_PATH (unset)
    LOGDIR (unset)
    PATH=/home/nick/bin:/usr/local/bin:/usr/bin:/bin:/usr/games:/usr/local/sbin:/sbin:/usr/sbin
    PERL_BADLANG (unset)
    SHELL=/bin/bash

@p5pRT
Copy link
Author

p5pRT commented Aug 27, 2010

From @tonycoz

On Thu, Aug 26, 2010 at 06​:51​:35AM -0700, Nicholas Clark wrote​:

-----------------------------------------------------------------
[Please describe your issue here]

B​::Deparse is getting the positioning of no overloading wrong​:

$ ./perl -Ilib -MO=Deparse -e 'print; { no overloading; $a + $b}; print'
print $_;
no overloading;
{
$a + $b;
}
print $_;
-e syntax OK

This is a problem for all BEGIN blocks - it cheats for strict,
integer, feature, bytes and warnings.

Tony

@p5pRT
Copy link
Author

p5pRT commented Aug 27, 2010

The RT System itself - Status changed from 'new' to 'open'

@p5pRT
Copy link
Author

p5pRT commented May 22, 2011

From @cpansprout

On Thu Aug 26 17​:25​:02 2010, tonyc wrote​:

On Thu, Aug 26, 2010 at 06​:51​:35AM -0700, Nicholas Clark wrote​:

-----------------------------------------------------------------
[Please describe your issue here]

B​::Deparse is getting the positioning of no overloading wrong​:

$ ./perl -Ilib -MO=Deparse -e 'print; { no overloading; $a + $b}; print'
print $_;
no overloading;
{
$a + $b;
}
print $_;
-e syntax OK

This is a problem for all BEGIN blocks - it cheats for strict,
integer, feature, bytes and warnings.

I’m trying to understand how this works. I would appreciate some hints.
This is what I’ve ascertained so far​:

Every BEGIN block has a sequence number associated with it. That number
is the sequence number (cop_seq) of the next control op that will be
created. B​::Deparse uses that to determine before which control op to
place the BEGIN block.

The problem is that this code in perly.y​:

fullstmt​: barestmt
  {
  if($1) {
  $$ = newSTATEOP(0, NULL, $1);
  } else {
  $$ = IF_MAD(newOP(OP_NULL, 0), NULL);
  }
  }

creates the nextstate op (the control op) *after* the block has been
parsed. That means that in {{;}} the nextstate associated with the inner
block is created before the outer one. So the inner one has a lower
sequence number.

(See the B​::Concise output for {{;}}​:

9 <@​> leave[1 ref] vKP/REFC ->(end)
1 <0> enter ->2
2 <;> nextstate(main 3 -e​:1) v​:{ ->3
8 <2> leaveloop vK/2 ->9
3 <{> enterloop(next->8 last->8 redo->4) v ->4
- <@​> lineseq vK ->8
4 <;> nextstate(main 2 -e​:1) v ->5
7 <2> leaveloop vK/2 ->8
5 <{> enterloop(next->7 last->7 redo->6) v ->6
6 <0> stub v ->7
-e syntax OK

Notice how the first nextstate has a 3 after main; the second one has a 2.)

That makes it impossible to distinguish between

{
  BEGIN {}
  {;}
}

and

BEGIN {}
{
  {;}
}

So, what I’m wondering is​: How does the nextstate op for the outer block
pick up the right hints? OK, they’re stored in PL_curcop or
PL_compiling. Where are those documented? When is it PL_curcop and when
is it PL_compiling? I don’t really understand the code that sets
PL_curcop, as it seems to be all over the place. I also don’t understand
the distinction between PL_curcop and PL_compiling.

Is it possible to store in the BEGIN block, not only the cop_seq, but
also a number indicating the nesting level? The value of PL_curcop is
presumably stored on a stack somewhere (haven’t found it yet).

Another idea has just popped into my head​: Is there any way to emit a
sequence number from the lexer when a bare ‘{’ is reported? That
sequence number could then be picked up by perly.y and passed on to
newSTATEOP, and all the sequence numbers would be in order.

@p5pRT
Copy link
Author

p5pRT commented May 23, 2011

From zefram@fysh.org

Father Chrysostomos via RT wrote​:

creates the nextstate op (the control op) *after* the block has been
parsed. That means that in {{;}} the nextstate associated with the inner
block is created before the outer one. So the inner one has a lower
sequence number.

An obvious possible solution is to emit a null statement, with nextstate
op, first thing in every block. That would work in the way that this
works​:

$ perl5.10.1 -MO=Deparse -e 'print; { 1; no overloading; $a + $b}; print'
print $_;
{
  '???';
  no overloading;
  $a + $b;
}
print $_;
-e syntax OK

However, there's a tension between deparse correctness and runtime
efficiency. You'd want the redundant nextstate op to be omitted from
the execution sequence, and indeed if you feed the above code to blead
it does elide the extra nextstate. The manner of elision is not merely
to thread the op_next pointers differently, but to overwrite the content
of the nextstate ops, so unfortunately the original ops are not even
visible in the op tree, where deparsing could see them.

               I don???t really understand the code that sets

PL_curcop, as it seems to be all over the place. I also don???t understand
the distinction between PL_curcop and PL_compiling.

PL_compiling is a static COP-shaped buffer, where the current COP-relevant
state is maintained during compilation. When a nextstate op is required,
the current state of PL_compiling is *copied* into a newly-allocated COP,
which then goes in the op tree.

PL_curcop has a dual use. During compilation, it points at PL_compiling,
so PL_curcop->whatever looks at the state at the current point of
compilation. During runtime, it points at the COP most recently executed
(see pp_nextstate), so PL_curcop->whatever looks at the state governing
the ops currently executing.

Is it possible to store in the BEGIN block, not only the cop_seq, but
also a number indicating the nesting level?

I'm dubious about building another nesting concept into the op tree,
and particularly about counting absolute nesting levels. Op tree munging
would tend to break it.

                                       The value of PL\_curcop is

presumably stored on a stack somewhere (haven???t found it yet).

The lexically-scoped items within the PL_compiling buffer are saved,
on the save stack, when a lexical block is entered at compile time
(block_start()), and restored when the block is exited (block_end()).

Another idea has just popped into my head​: Is there any way to emit a
sequence number from the lexer when a bare "{" is reported?

A sequence number could be allocated specially for this purpose, I
suppose. This is roughly equivalent to my initial suggestion of adding
an extra nextstate op, but you'd do it without any extra op.

-zefram

@p5pRT
Copy link
Author

p5pRT commented May 29, 2011

From @cpansprout

On Mon May 23 04​:13​:41 2011, zefram@​fysh.org wrote​:

The lexically-scoped items within the PL_compiling buffer are saved,
on the save stack, when a lexical block is entered at compile time
(block_start()), and restored when the block is exited (block_end()).

Thank you for your very clear explanations.

Attached is an attempt at renumbering ops. It doesn’t quite work yet.
But I need to ask​: Since PL_cop_seqmax is used to determine whether
variables are in scope, is this patch safe from that perspective? All
test pass (except B​::Concise’s, which is to be expected).

I have another question. intro_my begins like this​:

U32
Perl_intro_my(pTHX)
{
  dVAR;
  SV **svp;
  I32 i;
  U32 seq;

  ASSERT_CURPAD_ACTIVE("intro_my");
  if (! PL_min_intro_pending)
  return PL_cop_seqmax;

That means that when PL_min_intro_pending is 0 the same sequence number
will be returned on this invocation *and* on the next, because it does
not increment it. Is there any reason it should not increment PL_cop_seqmax?

@p5pRT
Copy link
Author

p5pRT commented May 29, 2011

From @cpansprout

Inline Patch
diff --git a/op.c b/op.c
index 0d4e1e6..5abb7c0 100644
--- a/op.c
+++ b/op.c
@@ -2387,11 +2387,16 @@ Perl_block_start(pTHX_ int full)
     dVAR;
     const int retval = PL_savestack_ix;
 
+    PL_compiling.cop_seq = PL_cop_seqmax++;
+    if (PL_cop_seqmax == PERL_PADSEQ_INTRO) /* not a legal value */
+	PL_cop_seqmax++;
     pad_block_start(full);
     SAVEHINTS();
     PL_hints &= ~HINT_BLOCK_SCOPE;
     SAVECOMPILEWARNINGS();
     PL_compiling.cop_warnings = DUP_WARNINGS(PL_compiling.cop_warnings);
+    SAVEI32(PL_compiling.cop_seq);
+    PL_compiling.cop_seq = 0;
 
     CALL_BLOCK_HOOKS(bhk_start, full);
 
@@ -4848,9 +4853,14 @@ OP *
 Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o)
 {
     dVAR;
-    const U32 seq = intro_my();
+    const U32 seq =
+      PL_compiling.cop_seq
+       ? (intro_my(), PL_compiling.cop_seq)
+       : intro_my();
     register COP *cop;
+/*Perl_warn(aTHX_ "%d",seq);*/
 
+    PL_compiling.cop_seq = 0;
     NewOp(1101, cop, 1, COP);
     if (PERLDB_LINE && CopLINE(PL_curcop) && PL_curstash != PL_debstash) {
 	cop->op_type = OP_DBSTATE;

@p5pRT
Copy link
Author

p5pRT commented Nov 6, 2014

From @cpansprout

On Sun May 29 15​:56​:58 2011, sprout wrote​:

I have another question. intro_my begins like this​:

U32
Perl_intro_my(pTHX)
{
dVAR;
SV **svp;
I32 i;
U32 seq;

ASSERT\_CURPAD\_ACTIVE\("intro\_my"\);
if \(\! PL\_min\_intro\_pending\)
return PL\_cop\_seqmax;

That means that when PL_min_intro_pending is 0 the same sequence number
will be returned on this invocation *and* on the next, because it does
not increment it. Is there any reason it should not increment PL_cop_seqmax?

For future readers, I now know enough to answer my own question​: Sequence numbers are primarily for lexical variables, to keep track of which variables are in scope for each statement. If multiple statements in a row contain no lexical declarations, then there is no need to increment the sequence number. For BEGIN blocks, however, the sequence number is incremented, even if no lexicals are declared around it, for the sake of B modules. The cost is infinitesimal.

--

Father Chrysostomos

@p5pRT
Copy link
Author

p5pRT commented Nov 7, 2014

From @cpansprout

On Sun May 29 15​:56​:58 2011, sprout wrote​:

Attached is an attempt at renumbering ops. It doesn’t quite work yet.

It was on the right track. It’s cleaner to have intro_my return the pending seq number itself, in case it starts being called from elsewhere.

I applied something based on it as 8635e3c.

--

Father Chrysostomos

@p5pRT
Copy link
Author

p5pRT commented Nov 7, 2014

@cpansprout - Status changed from 'open' to 'pending release'

@p5pRT
Copy link
Author

p5pRT commented Nov 7, 2014

From @cpansprout

On Thu Nov 06 22​:23​:09 2014, sprout wrote​:

On Sun May 29 15​:56​:58 2011, sprout wrote​:

Attached is an attempt at renumbering ops. It doesn’t quite work yet.

It was on the right track. It’s cleaner to have intro_my return the
pending seq number itself, in case it starts being called from
elsewhere.

I applied something based on it as 8635e3c.

And, in doing so, restored all those nice semicolons in perly.act. :-)

--

Father Chrysostomos

@p5pRT
Copy link
Author

p5pRT commented Nov 14, 2014

From @cpansprout

On Thu Nov 06 22​:23​:09 2014, sprout wrote​:

On Sun May 29 15​:56​:58 2011, sprout wrote​:

Attached is an attempt at renumbering ops. It doesn’t quite work yet.

It was on the right track. It’s cleaner to have intro_my return the
pending seq number itself, in case it starts being called from
elsewhere.

I applied something based on it as 8635e3c.

I need to reopen this ticket, because we still have the problem of BEGIN blocks falling out of the enclosing block​:

$ ./perl -Ilib -MO=Deparse -e '{ ...; no overloading } ...'
{
  die 'Unimplemented';
}
no overloading;
die 'Unimplemented';
-e syntax OK

In fact, I think 8635e3c introduced that bug. So now we have a regression that needs to be fixed before 5.22.

--

Father Chrysostomos

@p5pRT
Copy link
Author

p5pRT commented Nov 15, 2014

@cpansprout - Status changed from 'pending release' to 'open'

@p5pRT
Copy link
Author

p5pRT commented Nov 21, 2014

From @cpansprout

On Fri Nov 14 13​:14​:52 2014, sprout wrote​:

On Thu Nov 06 22​:23​:09 2014, sprout wrote​:

On Sun May 29 15​:56​:58 2011, sprout wrote​:

Attached is an attempt at renumbering ops. It doesn’t quite work
yet.

It was on the right track. It’s cleaner to have intro_my return the
pending seq number itself, in case it starts being called from
elsewhere.

I applied something based on it as 8635e3c.

I need to reopen this ticket, because we still have the problem of
BEGIN blocks falling out of the enclosing block​:

$ ./perl -Ilib -MO=Deparse -e '{ ...; no overloading } ...'
{
die 'Unimplemented';
}
no overloading;
die 'Unimplemented';
-e syntax OK

In fact, I think 8635e3c introduced that bug. So now we have a
regression that needs to be fixed before 5.22.

I’ve just fixed it in 34b5495. I did so by adding an extra null cop to the end of a block if the last thing in the block is a subroutine definition or use/no statement.

Another, failed, approach is attached here, in case future readers find it interesting.

--

Father Chrysostomos

@p5pRT
Copy link
Author

p5pRT commented Nov 21, 2014

From @cpansprout

From 70c40eb Mon Sep 17 00​:00​:00 2001
From​: Father Chrysostomos <sprout@​cpan.org>
Date​: Mon, 17 Nov 2014 19​:17​:29 -0800
Subject​: [PATCH 1/2] Localise PL_cop_seqmax when parsing subs
MIME-Version​: 1.0
Content-Type​: text/plain; charset=UTF-8
Content-Transfer-Encoding​: 8bit

This means that, in code like​:

my $x;
my $y;
sub foo {
  my $z;
  my $alef;
}
my $beth;
my $gimel;

The sequence numbers for the statements are reset when foo finishes
parsing, so the following statements end up with the same sequence
numbers is the statements in foo.

This will allow the differences between sequence numbers to become
meaningful in a future commit. I hope to use that to fix the remain-
ing issue in #77452, that BEGIN blocks may fall below the blocks that
were supposed to contain them.

It doesn’t matter that we end up with unrelated, non-sequential state-
ments with the same sequence numbers. Pads use sequence numbers to
determine which lexicals are in scope, but it only applies to lexical
declared within that very sub. Outer lexicals are in scope for the
whole sub and don’t use sequence numbers.

This should not affect B​::Deparse either (which uses sequence numbers
to determine where to deparse subs), because d88d1fe made it ensure
that subs are deparsed inside the correct outer sub.

Nevertheless, localising the sequence number does mean that we have to
increment it after parsing each sub, and not just after ‘use’ state-
ments. Also, we need to adjust the magic number in B​::Concise.


ext/B/B/Concise.pm | 2 +-
op.c | 3 ++-
toke.c | 1 +
3 files changed, 4 insertions(+), 2 deletions(-)

Inline Patch
diff --git a/ext/B/B/Concise.pm b/ext/B/B/Concise.pm
index 406327f..6cc3ce9 100644
--- a/ext/B/B/Concise.pm
+++ b/ext/B/B/Concise.pm
@@ -1039,7 +1039,7 @@ sub tree {
 # to update the corresponding magic number in the next line.
 # Remember, this needs to stay the last things in the module.
 
-my $cop_seq_mnum = 16;
+my $cop_seq_mnum = -411;
 $cop_seq_base = svref_2object(eval 'sub{0;}')->START->cop_seq + $cop_seq_mnum;
 
 1;
diff --git a/op.c b/op.c
index 00c1255..fd0e524 100644
--- a/op.c
+++ b/op.c
@@ -5888,7 +5888,6 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *idop, OP *arg)
 
     PL_hints |= HINT_BLOCK_SCOPE;
     PL_parser->copline = NOLINE;
-    COP_SEQMAX_INC; /* Purely for B::*'s benefit */
 }
 
 /*
@@ -8166,6 +8165,7 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
     if (PL_parser)
 	PL_parser->copline = NOLINE;
     LEAVE_SCOPE(floor);
+    COP_SEQMAX_INC; /* Purely for B::*'s benefit */ 
 #ifdef PERL_DEBUG_READONLY_OPS
     if (slab)
 	Slab_to_ro(slab);
@@ -8618,6 +8618,7 @@ Perl_newATTRSUB_x(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs,
     if (PL_parser)
 	PL_parser->copline = NOLINE;
     LEAVE_SCOPE(floor);
+    COP_SEQMAX_INC; /* Purely for B::*'s benefit */
 #ifdef PERL_DEBUG_READONLY_OPS
     /* Watch out for BEGIN blocks */
     if (!special && slab)
diff --git a/toke.c b/toke.c
index b6da013..63ce10f 100644
--- a/toke.c
+++ b/toke.c
@@ -10542,6 +10542,7 @@ Perl_start_subparse(pTHX_ I32 is_format, U32 flags)
     SAVEI32(PL_subline);
     save_item(PL_subname);
     SAVESPTR(PL_compcv);
+    SAVEI32(PL_cop_seqmax);
 
     PL_compcv = MUTABLE_CV(newSV_type(is_format ? SVt_PVFM : SVt_PVCV));
     CvFLAGS(PL_compcv) |= flags;
-- 
1.7.12.4 (Apple Git-37)

From d96f97d Mon Sep 17 00​:00​:00 2001
From​: Father Chrysostomos <sprout@​cpan.org>
Date​: Wed, 19 Nov 2014 20​:20​:48 -0800
Subject​: [PATCH 2/2] Abandoned attempt at deparsing BEGIN blocks in the right
spot
MIME-Version​: 1.0
Content-Type​: text/plain; charset=UTF-8
Content-Transfer-Encoding​: 8bit

This patch was trying to solve the problem of { foo(); BEGIN {} } deparsing
as { foo(); } BEGIN {}, by giving meaning to the differences between
sequence numbers. At scope end, the sequence number is incremented by
10, or maybe 9, or maybe 11, so subs that have outer sequence numbers
differing from the previous COP (statement) by less than 10 will be
put in the same block. The problem arises when you have multiple scope
ends and one BEGIN block that goes somewhere in there. I can’t control
the exact interval between sequence numbers, because different pieces
of code expect to be able to increment it for different reasons. And
rounding to the nearest 10 is not fail-proof, because enough blocks
will make it round the wrong way.

When I realised how fragile this approach was, I stopped writing the
patch. So far, it only works for { foo(); BEGIN {} }, not for
{ { foo(); } BEGIN {} }.


lib/B/Deparse.pm | 15 ++++++++++++---
lib/B/Deparse.t | 27 ++++++++++++++++++++++++++-
pad.c | 1 +
3 files changed, 39 insertions(+), 4 deletions(-)

Inline Patch
diff --git a/lib/B/Deparse.pm b/lib/B/Deparse.pm
index 1e42ef1..537ca0d 100644
--- a/lib/B/Deparse.pm
+++ b/lib/B/Deparse.pm
@@ -1352,7 +1352,7 @@ sub lineseq {
     my $body = join($sep, grep {length} @exprs);
     my $subs = "";
     if (defined $root && defined $limit_seq && !$self->{'in_format'}) {
-	$subs = join "\n", $self->seq_subs($limit_seq);
+	$subs = join "\n", $self->seq_subs($limit_seq, 1);
     }
     return join($sep, grep {length} $body, $subs);
 }
@@ -1640,14 +1640,22 @@ sub cop_subs {
 }
 
 sub seq_subs {
-    my ($self, $seq) = @_;
+    my ($self, $seq, $is_block_end) = @_;
     my @text;
 #push @text, "# ($seq)\n";
 
     return "" if !defined $seq;
     my @pending;
+    my($prev_seq, $this_seq) = $seq;
     while (scalar(@{$self->{'subs_todo'}})
-	   and $seq > $self->{'subs_todo'}[0][0]) {
+	   and $seq > ($this_seq = $self->{'subs_todo'}[0][0])
+	    # At the end of a block, we may have subs with sequence numbers
+	    # exceeding the target sequence number ($seq), but in incre-
+	    # ments of less that 10.  (Theoretically only increments
+	    # of 1, but we allow anything < 10 to be on the safe side.
+	    # op.c:block_end ensures that the next statement has a sequence
+	    # number at least 10 higher.)
+	    || ($is_block_end and $this_seq - $prev_seq < 10)) {
 	my $cv = $self->{'subs_todo'}[0][1];
 	my $outside = $cv && $cv->OUTSIDE;
 	if ($cv and ${$cv->OUTSIDE || \0} != ${$self->{'curcv'}}) {
@@ -1655,6 +1663,7 @@ sub seq_subs {
 	    next;
 	}
 	push @text, $self->next_todo;
+	$prev_seq = $this_seq;
     }
     unshift @{$self->{'subs_todo'}}, @pending;
     return @text;
diff --git a/lib/B/Deparse.t b/lib/B/Deparse.t
index 5b7d9cd..f160a14 100644
--- a/lib/B/Deparse.t
+++ b/lib/B/Deparse.t
@@ -13,7 +13,7 @@ BEGIN {
 use warnings;
 use strict;
 
-my $tests = 28; # not counting those in the __DATA__ section
+my $tests = 29; # not counting those in the __DATA__ section
 
 use B::Deparse;
 my $deparse = B::Deparse->new();
@@ -362,6 +362,31 @@ sub BEGIN {
 }
 EOCODJ
 }
+is runperl(stderr => 1, switches => [ '-MO=-qq,Deparse', $path ], prog => '
+      {
+        {
+          die;
+          BEGIN { pop }
+        }
+        BEGIN { pop }
+      }
+      BEGIN { pop }
+  '), <<'EOCODL', 'BEGIN blocks at the end of their enclosing blocks';
+{
+    {
+        die;
+        sub BEGIN {
+            pop @ARGV;
+        }
+    }
+    sub BEGIN {
+        pop @ARGV;
+    }
+}
+sub BEGIN {
+    pop @ARGV;
+}
+EOCODL
 
 # [perl #115066]
 my $prog = 'use constant FOO => do { 1 }; no overloading; die';
diff --git a/pad.c b/pad.c
index c9e16e5..379828c 100644
--- a/pad.c
+++ b/pad.c
@@ -1629,6 +1629,7 @@ Perl_pad_leavemy(pTHX)
 	    }
 	}
     }
+    PL_cop_seqmax += 8;
     COP_SEQMAX_INC;
     DEBUG_Xv(PerlIO_printf(Perl_debug_log,
 	    "Pad leavemy: seq = %ld\n", (long)PL_cop_seqmax));
-- 
1.7.12.4 (Apple Git-37)

@p5pRT
Copy link
Author

p5pRT commented Nov 21, 2014

@cpansprout - Status changed from 'open' to 'pending release'

@p5pRT
Copy link
Author

p5pRT commented Jun 2, 2015

From @khwilliamson

Thanks for submitting this ticket

The issue should be resolved with the release today of Perl v5.22. If you find that the problem persists, feel free to reopen this ticket

--
Karl Williamson for the Perl 5 porters team

@p5pRT p5pRT closed this as completed Jun 2, 2015
@p5pRT
Copy link
Author

p5pRT commented Jun 2, 2015

@khwilliamson - Status changed from 'pending release' to 'resolved'

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Projects
None yet
Development

No branches or pull requests

1 participant