mderef_u: always lval run-time uoob

analog to av_fetch(,,1). i.e. return newSV(0) and
store it into the av, just faster than with av_fetch.

add mderef tests with the right aelem types, ref vs scalar,
and add t/perf/opcount.t better diagnostics.

Author: Reini Urban

op.c

@@ -14181,7 +14181,7 @@ S_maybe_multideref(pTHX_ OP *start, OP *orig_o, UV orig_action, U8 hints)
 
         while (!is_last) {
             /* look for another (rv2av/hv; get index;
-             * aelem/helem/exists/delele) sequence */
+             * aelem/helem/exists/delete) sequence */
 
             OP *kid;
             bool is_deref;
@@ -14305,7 +14305,7 @@ S_maybe_multideref(pTHX_ OP *start, OP *orig_o, UV orig_action, U8 hints)
                             && iv <= 127
                             && (   action == MDEREF_AV_padav_aelem
                                 || action == MDEREF_AV_gvav_aelem)
-                        )
+                           ) /* but still need to check for valid op_private */
                             maybe_aelemfast = TRUE;
 
                         if (PASS2) {
@@ -14393,7 +14393,6 @@ S_maybe_multideref(pTHX_ OP *start, OP *orig_o, UV orig_action, U8 hints)
 
             action |= index_type;
 
-
             /* at this point we have either:
              *   * detected what looks like a simple index expression,
              *     and expect the next op to be an [ah]elem, or
@@ -14415,10 +14414,10 @@ S_maybe_multideref(pTHX_ OP *start, OP *orig_o, UV orig_action, U8 hints)
             if (  o->op_type == OP_AELEM && PL_check[o->op_type] != Perl_ck_aelem)
                 return;
 
-            if (   o->op_type != OP_AELEM
-                || (o->op_private &
-		      (OPpLVAL_INTRO|OPpLVAL_DEFER|OPpDEREF|OPpMAYBE_LVSUB))
-                )
+            /* skip aelemfast if private cannot hold all bits */
+            if ( o->op_type != OP_AELEM
+                 || (o->op_private &
+                     (OPpLVAL_INTRO|OPpLVAL_DEFER|OPpDEREF|OPpMAYBE_LVSUB)))
                 maybe_aelemfast = FALSE;
 
             /* look for aelem/helem/exists/delete. If it's not the last elem
@@ -15229,7 +15228,8 @@ Perl_rpeep(pTHX_ OP *o)
                                    && strEQ(aname, PAD_COMPNAME_PV(o2->op_targ))) {
                             DEBUG_k(Perl_deb(aTHX_ "nyi multideref[%s] => MDEREF_INDEX_uoob\n",
                                              aname));
-                            /* TODO: find this padsv item and set MDEREF_INDEX_uoob */
+                            /* TODO: find this padsv item (the first)
+                               and set MDEREF_INDEX_uoob */
                         } else if (type == OP_AELEMFAST && SvPOK(kSVOP_sv)
                                    && strEQ(aname, SvPVX(kSVOP_sv))) {
                             /* TODO no magic in array allowed, array must be typed */

pp_hot.c

@@ -2451,10 +2451,10 @@ PP(pp_multideref)
 
                 if (!(actions & MDEREF_FLAG_last)) {
                     if (UNLIKELY((actions & MDEREF_INDEX_uoob) && !SvRMAGICAL(sv))) {
-                        sv = AvARRAY(sv)[elem];
-                        if (!sv) {
-                            const U32 lval = (PL_op->op_flags & OPf_MOD) || LVRET;
-                            sv = lval ? newSV(0) : &PL_sv_undef;
+                        SV* av = sv;
+                        sv = AvARRAY(av)[elem];
+                        if (!sv) { /* always lval */
+                            AvARRAY(av)[elem] = sv = newSV(0);
                         }
                     } else {
                         SV** svp = av_fetch((AV*)sv, elem, 1);

t/op/aelem_u.t

@@ -5,7 +5,7 @@ BEGIN {
     chdir 't' if -d 't';
     require './test.pl';
 }
-plan( tests => 16 );
+plan( tests => 22 );
 use coretypes;
 use cperl;
 use v5.22;
@@ -43,17 +43,37 @@ like ($@, qr/^Invalid modification of shaped array: unshift \@a/, "invalid unshi
 eval { splice @a; };
 like ($@, qr/^Invalid modification of shaped array: splice/, "invalid splice (run-time)");
 
+# aelemfast_lex_u
 $a[0] = 1;
 is($a[0], 1, "set const w/o read-only");
 $a[-1] = 2; # compile-time changed to 4
 is($a[4], 2, "negative constant index");
+
+# mderef_u:
 my $i = 0;
 $a[$i] = 1;
 is($a[$i], 1, "set");
 $i = -1;
 $a[$i] = 2; # run-time logic
 is($a[4], 2, "negative run-time index");
 
+# multi mderef_u
+$a[1]->[5] = 1;
+is($a[1]->[5], 1, "set mderef_u");
+$a[-2]->[0] = 2;
+is($a[3]->[0], 2, "negative mderef_u");
+eval '$a[5]->[1];';
+like ($@, qr/^Array index out of bounds \@a\[5\]/, "compile-time mderef oob");
+
+# multidim mderef_u
+$a[2][5] = 1;
+is($a[2][5], 1, "set multi mderef_u");
+$a[-2][0] = 2;
+is($a[3][0], 2, "negative multi mderef_u");
+
+eval '$a[5][1];';
+like ($@, qr/^Array index out of bounds \@a\[5\]/, "compile-time mderef oob");
+
 # eliminating loop out-of-bounds:
 my @b = (0..4);
 for (0..$#b) { $b[$_] };       # _u
@@ -67,10 +87,3 @@ for (0..$#b) { $b[$_+1] };     # wrong index: expr
   for $k (0..$#b) { $b[$k] };    # _u
   for $k (0..$#b) { $b[$j] };    # wrong index: glob
 }
-
-# TODO mderef_u
-
-# $a[0][1]; # set MDEREF_INDEX_noob to first index
-
-#eval '$a[5][1];'
-#like ($@, qr/^Array index out of bounds \@a\[5\]/, "compile-time mderef oob");

t/perf/opcount.t

@@ -49,7 +49,7 @@ use B ();
     # op counts for the sub.
 
     sub test_opcount {
-        my ($debug, $desc, $coderef, $expected_counts) = @_;
+        my ($debug, $desc, $coderef, $expected_counts, $code) = @_;
 
         %counts = ();
         B::walkoptree(B::svref_2object($coderef)->ROOT,
@@ -68,7 +68,8 @@ use B ();
         }
         ok(!@exp, $desc);
         if (@exp) {
-            diag($_) for @exp;
+            diag($code);
+            diag($_) for @exp; 0
         }
     }    
 }
@@ -182,7 +183,7 @@ test_opcount(0, "basic aelemfast",
                             $c{$top} = 1
                         }
 
-                        ::test_opcount(0, $sub, $coderef, \%c);
+                        ::test_opcount(0, $sub, $coderef, \%c, $sub);
                     }
                 }
             }