diff options
author | David Mitchell <davem@iabyn.com> | 2020-01-02 14:00:23 +0000 |
---|---|---|
committer | David Mitchell <davem@iabyn.com> | 2020-01-02 14:42:28 +0000 |
commit | b790ed71bdb9ac73a66f9dc2639f19950391ed45 (patch) | |
tree | c82435c7c7558a253c62af723d7e18e85f95fae2 /ext | |
parent | 4eeaed3791af175b5840f626d4d1a4e3b4cb3543 (diff) | |
download | perl-b790ed71bdb9ac73a66f9dc2639f19950391ed45.tar.gz |
OP_MULTIDEREF: avoid trailing null aux byte
GH #17301
The aux array in an OP_MULTIDEREF op consists of an action word
containing as many actions as will fit shifted together, followed by
words containing the arguments for those actions. Then another action
word, and so on. The code in S_maybe_multideref() which creates those
ops was reserving a new slot in the aux array for a new action word when
the old one became full. If it then turned out that no more actions
were needed, this extra slot was harmlessly filled with a zero.
However it turns out that the B::UNOP_AUX::aux_list() introspection
method would, under those circumstances, claim to have returned one
more SV on the stack than it actually had, leading to SEGVs etc.
I could have fixed aux_list() directly to cope with an extra null word,
but instead I did the more general fix of ensuring that
S_maybe_multideref() never adds an extra null word in the first place.
The test added to ext/B/t/b.t fails before this commit; the new test
in lib/B/Deparse.t doesn't, but was added for completeness.
Diffstat (limited to 'ext')
-rw-r--r-- | ext/B/t/b.t | 14 |
1 files changed, 14 insertions, 0 deletions
diff --git a/ext/B/t/b.t b/ext/B/t/b.t index e1279ff935..d1dba06785 100644 --- a/ext/B/t/b.t +++ b/ext/B/t/b.t @@ -540,5 +540,19 @@ SKIP: { is $sub2->PADLIST->outid, $sub1->PADLIST->outid, 'padlist outid'; } +# GH #17301 aux_list() sometimes returned wrong #args + +{ + my $big = ($Config::Config{uvsize} > 4); + my $self; + my $sub = $big + ? sub { $self->{h1}{h2}{h3}{h4}{h5}{h6}{h7}{h8}{h9} } + : sub { $self->{h1}{h2}{h3}{h4} }; + my $cv = B::svref_2object($sub); + my $op = $cv->ROOT->first->first->next; + my @items = $op->aux_list($cv); + is +@items, $big ? 11 : 6, 'GH #17301'; +} + done_testing(); |