This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
OP_MULTIDEREF: avoid trailing null aux byte
authorDavid Mitchell <davem@iabyn.com>
Thu, 2 Jan 2020 14:00:23 +0000 (14:00 +0000)
committerDavid Mitchell <davem@iabyn.com>
Thu, 2 Jan 2020 14:42:28 +0000 (14:42 +0000)
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.

ext/B/t/b.t
lib/B/Deparse.t
op.c

index e1279ff..d1dba06 100644 (file)
@@ -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();
index 2406266..07c9150 100644 (file)
@@ -3062,3 +3062,18 @@ $#{$s;} = 1;
 # TODO doesn't preserve backslash
 my @a;
 my $s = "$a[0]\[1]";
+####
+# GH #17301 aux_list() sometimes returned wrong #args
+my($r, $h);
+$r = $h->{'i'};
+$r = $h->{'i'}{'j'};
+$r = $h->{'i'}{'j'}{'k'};
+$r = $h->{'i'}{'j'}{'k'}{'l'};
+$r = $h->{'i'}{'j'}{'k'}{'l'}{'m'};
+$r = $h->{'i'}{'j'}{'k'}{'l'}{'m'}{'n'};
+$r = $h->{'i'}{'j'}{'k'}{'l'}{'m'}{'n'}{'o'};
+$r = $h->{'i'}{'j'}{'k'}{'l'}{'m'}{'n'}{'o'}{'p'};
+$r = $h->{'i'}{'j'}{'k'}{'l'}{'m'}{'n'}{'o'}{'p'}{'q'};
+$r = $h->{'i'}{'j'}{'k'}{'l'}{'m'}{'n'}{'o'}{'p'}{'q'}{'r'};
+$r = $h->{'i'}{'j'}{'k'}{'l'}{'m'}{'n'}{'o'}{'p'}{'q'}{'r'}{'s'};
+$r = $h->{'i'}{'j'}{'k'}{'l'}{'m'}{'n'}{'o'}{'p'}{'q'}{'r'}{'s'}{'t'};
diff --git a/op.c b/op.c
index 0f14d7e..59144ec 100644 (file)
--- a/op.c
+++ b/op.c
@@ -15762,12 +15762,11 @@ S_maybe_multideref(pTHX_ OP *start, OP *orig_o, UV orig_action, U8 hints)
         bool next_is_hash    = FALSE; /* is the next lookup to be a hash? */
         bool is_last         = FALSE; /* no more derefs to follow */
         bool maybe_aelemfast = FALSE; /* we can replace with aelemfast? */
+        UV action_word       = 0;     /* all actions so far */
         UNOP_AUX_item *arg     = arg_buf;
         UNOP_AUX_item *action_ptr = arg_buf;
 
-        if (pass)
-            action_ptr->uv = 0;
-        arg++;
+        arg++; /* reserve slot for first action word */
 
         switch (action) {
         case MDEREF_HV_gvsv_vivify_rv2hv_helem:
@@ -16158,16 +16157,16 @@ S_maybe_multideref(pTHX_ OP *start, OP *orig_o, UV orig_action, U8 hints)
                     arg--;
             }
 
-            if (pass)
-                action_ptr->uv |= (action << (action_ix * MDEREF_SHIFT));
+            action_word |= (action << (action_ix * MDEREF_SHIFT));
             action_ix++;
             action_count++;
-            /* if there's no space for the next action, create a new slot
+            /* if there's no space for the next action, reserve a new slot
              * for it *before* we start adding args for that action */
             if ((action_ix + 1) * MDEREF_SHIFT > UVSIZE*8) {
-                action_ptr = arg;
                 if (pass)
-                    arg->uv = 0;
+                    action_ptr->uv = action_word;
+                action_word = 0;
+                action_ptr = arg;
                 arg++;
                 action_ix = 0;
             }
@@ -16175,6 +16174,12 @@ S_maybe_multideref(pTHX_ OP *start, OP *orig_o, UV orig_action, U8 hints)
 
         /* success! */
 
+        if (!action_ix)
+            /* slot reserved for next action word not now needed */
+            arg--;
+        else if (pass)
+            action_ptr->uv = action_word;
+
         if (pass) {
             OP *mderef;
             OP *p, *q;