Thanks to visit codestin.com
Credit goes to github.com

Skip to content

Commit 8635e3c

Browse files
author
Father Chrysostomos
committed
[perl #77452] Deparse BEGIN blocks in the right place
In the op tree, a statement consists of a nextstate/dbstate op (of class cop) followed by the contents of the statement. This cop is created after the statement has been parsed. So if you have nested statements, the outermost statement has the highest sequence number (cop_seq). Every sub (including BEGIN blocks) has a sequence number indicating where it occurs in its containing sub. So BEGIN { } #1 # seq 2 { # seq 1 ... } is indistinguishable from # seq 2 { BEGIN { } #1 # seq 1 ... } because the sequence number of the BEGIN block is 1 in both examples. By reserving a sequence number at the start of every block and using it once the block has finished parsing, we can do this: BEGIN { } #1 # seq 1 { # seq 2 ... } # seq 1 { BEGIN { } #2 # seq 2 ... } and now B::Deparse can tell where to put the blocks. PL_compiling.cop_seq was unused, so this is where I am stashing the pending sequence number.
1 parent e13b632 commit 8635e3c

File tree

9 files changed

+576
-546
lines changed

9 files changed

+576
-546
lines changed

‎ext/B/B/Concise.pm

+1-1
Original file line numberDiff line numberDiff line change
@@ -1039,7 +1039,7 @@ sub tree {
10391039
# to update the corresponding magic number in the next line.
10401040
# Remember, this needs to stay the last things in the module.
10411041

1042-
my $cop_seq_mnum = 11;
1042+
my $cop_seq_mnum = 16;
10431043
$cop_seq_base = svref_2object(eval 'sub{0;}')->START->cop_seq + $cop_seq_mnum;
10441044

10451045
1;

‎lib/B/Deparse.pm

+5-3
Original file line numberDiff line numberDiff line change
@@ -1625,11 +1625,13 @@ sub find_scope {
16251625
sub cop_subs {
16261626
my ($self, $op, $out_seq) = @_;
16271627
my $seq = $op->cop_seq;
1628-
# If we have nephews, then our sequence number indicates
1629-
# the cop_seq of the end of some sort of scope.
1630-
if (class($op->sibling) ne "NULL" && $op->sibling->flags & OPf_KIDS
1628+
if ($] < 5.021006) {
1629+
# If we have nephews, then our sequence number indicates
1630+
# the cop_seq of the end of some sort of scope.
1631+
if (class($op->sibling) ne "NULL" && $op->sibling->flags & OPf_KIDS
16311632
and my $nseq = $self->find_scope_st($op->sibling) ) {
16321633
$seq = $nseq;
1634+
}
16331635
}
16341636
$seq = $out_seq if defined($out_seq) && $out_seq < $seq;
16351637
return $self->seq_subs($seq);

‎lib/B/Deparse.t

+39-1
Original file line numberDiff line numberDiff line change
@@ -13,7 +13,7 @@ use warnings;
1313
use strict;
1414
use Test::More;
1515

16-
my $tests = 26; # not counting those in the __DATA__ section
16+
my $tests = 27; # not counting those in the __DATA__ section
1717

1818
use B::Deparse;
1919
my $deparse = B::Deparse->new();
@@ -327,6 +327,44 @@ like($a, qr/my sub __DATA__;\n\(\);\nCORE::__DATA__/,
327327
$a = readpipe qq`$^X $path "-MO=Deparse" -e "sub foo{}" 2>&1`;
328328
like($a, qr/sub foo\s*\{\s+\}/, 'sub declarations');
329329

330+
# BEGIN blocks
331+
SKIP : {
332+
skip "BEGIN output is wrong on old perls", 1 if $] < 5.021006;
333+
my $prog = '
334+
BEGIN { pop }
335+
{
336+
BEGIN { pop }
337+
{
338+
no overloading;
339+
{
340+
BEGIN { pop }
341+
die
342+
}
343+
}
344+
}';
345+
$prog =~ s/\n//g;
346+
$a = readpipe qq`$^X $path "-MO=Deparse" -e "$prog" 2>&1`;
347+
$a =~ s/-e syntax OK\n//g;
348+
is($a, <<'EOCODJ', 'BEGIN blocks');
349+
sub BEGIN {
350+
pop @ARGV;
351+
}
352+
{
353+
sub BEGIN {
354+
pop @ARGV;
355+
}
356+
{
357+
no overloading;
358+
{
359+
sub BEGIN {
360+
pop @ARGV;
361+
}
362+
die;
363+
}
364+
}
365+
}
366+
EOCODJ
367+
}
330368

331369
done_testing($tests);
332370

‎op.c

+5
Original file line numberDiff line numberDiff line change
@@ -3677,11 +3677,16 @@ Perl_block_start(pTHX_ int full)
36773677
{
36783678
const int retval = PL_savestack_ix;
36793679

3680+
PL_compiling.cop_seq = PL_cop_seqmax++;
3681+
if (PL_cop_seqmax == PERL_PADSEQ_INTRO) /* not a legal value */
3682+
PL_cop_seqmax++;
36803683
pad_block_start(full);
36813684
SAVEHINTS();
36823685
PL_hints &= ~HINT_BLOCK_SCOPE;
36833686
SAVECOMPILEWARNINGS();
36843687
PL_compiling.cop_warnings = DUP_WARNINGS(PL_compiling.cop_warnings);
3688+
SAVEI32(PL_compiling.cop_seq);
3689+
PL_compiling.cop_seq = 0;
36853690

36863691
CALL_BLOCK_HOOKS(bhk_start, full);
36873692

‎pad.c

+7-2
Original file line numberDiff line numberDiff line change
@@ -1568,8 +1568,14 @@ Perl_intro_my(pTHX)
15681568
U32 seq;
15691569

15701570
ASSERT_CURPAD_ACTIVE("intro_my");
1571+
if (PL_compiling.cop_seq) {
1572+
seq = PL_compiling.cop_seq;
1573+
PL_compiling.cop_seq = 0;
1574+
}
1575+
else
1576+
seq = PL_cop_seqmax;
15711577
if (! PL_min_intro_pending)
1572-
return PL_cop_seqmax;
1578+
return seq;
15731579

15741580
svp = AvARRAY(PL_comppad_name);
15751581
for (i = PL_min_intro_pending; i <= PL_max_intro_pending; i++) {
@@ -1588,7 +1594,6 @@ Perl_intro_my(pTHX)
15881594
);
15891595
}
15901596
}
1591-
seq = PL_cop_seqmax;
15921597
PL_cop_seqmax++;
15931598
if (PL_cop_seqmax == PERL_PADSEQ_INTRO) /* not a legal value */
15941599
PL_cop_seqmax++;

0 commit comments

Comments
 (0)