summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Mitchell <davem@iabyn.com>2014-10-24 16:26:38 +0100
committerDavid Mitchell <davem@iabyn.com>2014-12-07 09:24:55 +0000
commitfedf30e1c349130b23648c022f5f3cb4ad7928f3 (patch)
tree59634b92647baec7686f67156a199f0f33ef19bb
parent2f7c6295c991839e20b09fbf3107b861d511de31 (diff)
downloadperl-fedf30e1c349130b23648c022f5f3cb4ad7928f3.tar.gz
Add OP_MULTIDEREF
This op is an optimisation for any series of one or more array or hash lookups and dereferences, where the key/index is a simple constant or package/lexical variable. If the first-level lookup is of a simple array/hash variable or scalar ref, then that is included in the op too. So all of the following are replaced with a single op: $h{foo} $a[$i] $a[5][$k][$i] $r->{$k} local $a[0][$i] exists $a[$i]{$k} delete $h{foo} while these aren't: $a[0] already handled by OP_AELEMFAST $a[$x+1] not a simple index and these are partially replaced: (expr)->[0]{$k} the bit following (expr) is replaced $h{foo}[$x+1][0] the first and third lookups are each done with a multideref op, while the $x+1 expression and middle lookup are done by existing add, aelem etc ops. Up until now, aggregate dereferencing has been very heavyweight in ops; for example, $r->[0]{$x} is compiled as: gv[*r] s rv2sv sKM/DREFAV,1 rv2av[t2] sKR/1 const[IV 0] s aelem sKM/DREFHV,2 rv2hv sKR/1 gvsv[*x] s helem vK/2 When executing this, in addition to the actual calls to av_fetch() and hv_fetch(), there is a lot of overhead of pushing SVs on and off the stack, and calling lots of little pp() functions from the runops loop (each with its potential indirect branch miss). The multideref op avoids that by running all the code in a loop in a switch statement. It makes use of the new UNOP_AUX type to hold an array of typedef union { PADOFFSET pad_offset; SV *sv; IV iv; UV uv; } UNOP_AUX_item; In something like $a[7][$i]{foo}, the GVs or pad offsets for @a and $i are stored as items in the array, along with a pointer to a const SV holding 'foo', and the UV 7 is stored directly. Along with this, some UVs are used to store a sequence of actions (several actions are squeezed into a single UV). Then the main body of pp_multideref is a big while loop round a switch, which reads actions and values from the AUX array. The two big branches in the switch are ones that are affectively unrolled (/DREFAV, rv2av, aelem) and (/DREFHV, rv2hv, helem) triplets. The other branches are various entry points that handle retrieving the different types of initial value; for example 'my %h; $h{foo}' needs to get %h from the pad, while '(expr)->{foo}' needs to pop expr off the stack. Note that there is a slight complication with /DEREF; in the example above of $r->[0]{$x}, the aelem op is actually aelem sKM/DREFHV,2 which means that the aelem, after having retrieved a (possibly undef) value from the array, is responsible for autovivifying it into a hash, ready for the next op. Similarly, the rv2sv that retrieves $r from the typeglob is responsible for autovivifying it into an AV. This action of doing the next op's work for it complicates matters somewhat. Within pp_multideref, the autovivification action is instead included as the first step of the current action. In terms of benchmarking with Porting/bench.pl, a simple lexical $a[$i][$j] shows a reduction of approx 40% in numbers of instructions executed, while $r->[0][0][0] uses 54% fewer. The speed-up for hash accesses is relatively more modest, since the actual hash lookup (i.e. hv_fetch()) is more expensive than an array lookup. A lexical $h{foo} uses 10% fewer, while $r->{foo}{bar}{baz} uses 34% fewer instructions. Overall, bench.pl --tests='/expr::(array|hash)/' ... gives: PRE POST ------ ------ Ir 100.00 145.00 Dr 100.00 165.30 Dw 100.00 175.74 COND 100.00 132.02 IND 100.00 171.11 COND_m 100.00 127.65 IND_m 100.00 203.90 with cache misses unchanged at 100%. In general, the more lookups done, the bigger the proportionate saving.
Diffstat
-rw-r--r--MANIFEST1
-rw-r--r--Porting/deparse-skips.txt2
-rw-r--r--dist/Safe/t/safeops.t3
-rw-r--r--dump.c193
-rw-r--r--embed.fnc4
-rw-r--r--embed.h3
-rw-r--r--embedvar.h1
-rw-r--r--ext/B/B.xs100
-rw-r--r--ext/B/B/Concise.pm2
-rw-r--r--ext/B/t/OptreeCheck.pm4
-rw-r--r--ext/B/t/concise-xs.t30
-rw-r--r--ext/B/t/f_sort.t52
-rw-r--r--ext/Opcode/Opcode.pm2
-rw-r--r--intrpvar.h3
-rw-r--r--lib/B/Deparse.pm200
-rw-r--r--lib/B/Deparse.t78
-rw-r--r--lib/B/Op_private.pm23
-rw-r--r--op.c891
-rw-r--r--op.h56
-rw-r--r--opcode.h262
-rw-r--r--opnames.h485
-rw-r--r--perl.h7
-rw-r--r--pp.c7
-rw-r--r--pp_hot.c436
-rw-r--r--pp_proto.h1
-rw-r--r--proto.h12
-rw-r--r--regen/op_private16
-rw-r--r--regen/opcodes4
-rw-r--r--sv.c226
-rw-r--r--t/lib/warnings/9uninit77
-rw-r--r--t/op/multideref.t187
-rw-r--r--t/op/svleak.t16
-rw-r--r--t/perf/benchmarks168
-rw-r--r--t/perf/opcount.t151
34 files changed, 3231 insertions, 472 deletions
diff --git a/MANIFEST b/MANIFEST
index 4775d8ee96..7d04e1f4a9 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -5269,6 +5269,7 @@ t/op/magic-27839.t Test for #27839, skipped for minitest
t/op/magic.t See if magic variables work
t/op/method.t See if method calls work
t/op/mkdir.t See if mkdir works
+t/op/multideref.t See if "$a[0]{foo}[$i]{$k}" etc works
t/op/mydef.t See if "my $_" works
t/op/my_stash.t See if my Package works
t/op/my.t See if lexical scoping works
diff --git a/Porting/deparse-skips.txt b/Porting/deparse-skips.txt
index c7aaf7e527..526bdc2ed4 100644
--- a/Porting/deparse-skips.txt
+++ b/Porting/deparse-skips.txt
@@ -434,7 +434,6 @@ op/closure.t
op/concat2.t
op/coreamp.t
op/crypt.t
-op/die.t
op/do.t
op/each.t
op/eval.t
@@ -455,7 +454,6 @@ op/lexsub.t
op/local.t
op/magic.t
op/method.t
-op/my.t
op/mydef.t
op/not.t
op/ord.t
diff --git a/dist/Safe/t/safeops.t b/dist/Safe/t/safeops.t
index cb37445c1d..2133bde16b 100644
--- a/dist/Safe/t/safeops.t
+++ b/dist/Safe/t/safeops.t
@@ -56,7 +56,7 @@ foreach (@op) {
if ($_->[2]) {
testop @$_;
} else {
- local our $TODO = "No test yet for $_->[1]";
+ local our $TODO = "No test yet for $_->[0] ($_->[1])";
fail();
}
}
@@ -235,6 +235,7 @@ exists exists $h{Key}
rv2hv %h
helem $h{kEy}
hslice @h{kEy}
+multideref SKIP (set by optimizer)
unpack unpack
pack pack
split split /foo/
diff --git a/dump.c b/dump.c
index daeedf493f..9abfbb12bc 100644
--- a/dump.c
+++ b/dump.c
@@ -952,6 +952,18 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
}
#endif
break;
+
+ case OP_MULTIDEREF:
+ {
+ UNOP_AUX_item *items = cUNOP_AUXo->op_aux;
+ UV i, count = items[-1].uv;
+
+ Perl_dump_indent(aTHX_ level, file, "ARGS = \n");
+ for (i=0; i < count; i++)
+ Perl_dump_indent(aTHX_ level+1, file, "%"UVuf" => 0x%"UVxf"\n",
+ i, items[i].uv);
+ }
+
case OP_CONST:
case OP_HINTSEVAL:
case OP_METHOD_NAMED:
@@ -2254,6 +2266,181 @@ S_deb_padvar(pTHX_ PADOFFSET off, int n, bool paren)
}
+/* append to the out SV, the name of the lexical at offset off in the CV
+ * cv */
+
+void
+S_append_padvar(pTHX_ PADOFFSET off, CV *cv, SV *out, int n,
+ bool paren, bool is_scalar)
+{
+ PADNAME *sv;
+ PADNAMELIST *namepad = NULL;
+ int i;
+
+ if (cv) {
+ PADLIST * const padlist = CvPADLIST(cv);
+ namepad = PadlistNAMES(padlist);
+ }
+
+ if (paren)
+ sv_catpvs_nomg(out, "(");
+ for (i = 0; i < n; i++) {
+ if (namepad && (sv = padnamelist_fetch(namepad, off + i)))
+ {
+ STRLEN cur = SvCUR(out);
+ Perl_sv_catpvf(aTHX_ out, "[%"PNf, PNfARG(sv));
+ if (is_scalar)
+ SvPVX(out)[cur] = '$';
+ }
+ else
+ Perl_sv_catpvf(aTHX_ out, "[%"UVuf"]", (UV)(off+i));
+ if (i < n - 1)
+ sv_catpvs_nomg(out, ",");
+ }
+ if (paren)
+ sv_catpvs_nomg(out, "(");
+}
+
+
+void
+S_print_gv_name(pTHX_ GV *gv, SV *out, char sigil)
+{
+ SV *sv;
+ if (!gv) {
+ sv_catpvs_nomg(out, "<NULLGV>");
+ return;
+ }
+ sv = newSV(0);
+ gv_fullname4(sv, gv, NULL, FALSE);
+ Perl_sv_catpvf(aTHX_ out, "%c%-p", sigil, sv);
+ SvREFCNT_dec_NN(sv);
+}
+
+#ifdef USE_ITHREADS
+# define ITEM_SV(item) *av_fetch(comppad, (item)->pad_offset, FALSE);
+#else
+# define ITEM_SV(item) UNOP_AUX_item_sv(item)
+#endif
+
+
+/* return a temporary SV containing a stringified representation of
+ * the op_aux field of a UNOP_AUX op, associated with CV cv
+ */
+
+SV*
+Perl_unop_aux_stringify(pTHX_ const OP *o, CV *cv)
+{
+ UNOP_AUX_item *items = cUNOP_AUXo->op_aux;
+ UV actions = items->uv;
+ SV *sv;
+ bool last = 0;
+ bool is_hash = FALSE;
+ int derefs = 0;
+ SV *out = sv_2mortal(newSVpv("",0));
+#ifdef USE_ITHREADS
+ PADLIST * const padlist = CvPADLIST(cv);
+ PAD *comppad = comppad = PadlistARRAY(padlist)[1];
+#endif
+
+ PERL_ARGS_ASSERT_UNOP_AUX_STRINGIFY;
+
+ while (!last) {
+ switch (actions & MDEREF_ACTION_MASK) {
+
+ case MDEREF_reload:
+ actions = (++items)->uv;
+ continue;
+
+ case MDEREF_HV_padhv_helem:
+ is_hash = TRUE;
+ case MDEREF_AV_padav_aelem:
+ derefs = 1;
+ S_append_padvar(aTHX_ (++items)->pad_offset, cv, out, 1, 0, 1);
+ goto do_elem;
+
+ case MDEREF_HV_gvhv_helem:
+ is_hash = TRUE;
+ case MDEREF_AV_gvav_aelem:
+ derefs = 1;
+ sv = ITEM_SV(++items);
+ S_print_gv_name(aTHX_ (GV*)sv, out, '$');
+ goto do_elem;
+
+ case MDEREF_HV_gvsv_vivify_rv2hv_helem:
+ is_hash = TRUE;
+ case MDEREF_AV_gvsv_vivify_rv2av_aelem:
+ sv = ITEM_SV(++items);
+ S_print_gv_name(aTHX_ (GV*)sv, out, '$');
+ goto do_vivify_rv2xv_elem;
+
+ case MDEREF_HV_padsv_vivify_rv2hv_helem:
+ is_hash = TRUE;
+ case MDEREF_AV_padsv_vivify_rv2av_aelem:
+ S_append_padvar(aTHX_ (++items)->pad_offset, cv, out, 1, 0, 1);
+ goto do_vivify_rv2xv_elem;
+
+ case MDEREF_HV_pop_rv2hv_helem:
+ case MDEREF_HV_vivify_rv2hv_helem:
+ is_hash = TRUE;
+ do_vivify_rv2xv_elem:
+ case MDEREF_AV_pop_rv2av_aelem:
+ case MDEREF_AV_vivify_rv2av_aelem:
+ if (!derefs++)
+ sv_catpvs_nomg(out, "->");
+ do_elem:
+ if ((actions & MDEREF_INDEX_MASK)== MDEREF_INDEX_none) {
+ sv_catpvs_nomg(out, "->");
+ last = 1;
+ break;
+ }
+
+ sv_catpvn_nomg(out, (is_hash ? "{" : "["), 1);
+ switch (actions & MDEREF_INDEX_MASK) {
+ case MDEREF_INDEX_const:
+ if (is_hash) {
+ STRLEN cur;
+ char *s;
+ sv = ITEM_SV(++items);
+ s = SvPV(sv, cur);
+ pv_pretty(out, s, cur, 30,
+ NULL, NULL,
+ (PERL_PV_PRETTY_NOCLEAR
+ |PERL_PV_PRETTY_QUOTE
+ |PERL_PV_PRETTY_ELLIPSES));
+ }
+ else
+ Perl_sv_catpvf(aTHX_ out, "%"IVdf, (++items)->iv);
+ break;
+ case MDEREF_INDEX_padsv:
+ S_append_padvar(aTHX_ (++items)->pad_offset, cv, out, 1, 0, 1);
+ break;
+ case MDEREF_INDEX_gvsv:
+ sv = ITEM_SV(++items);
+ S_print_gv_name(aTHX_ (GV*)sv, out, '$');
+ break;
+ }
+ sv_catpvn_nomg(out, (is_hash ? "}" : "]"), 1);
+
+ if (actions & MDEREF_FLAG_last)
+ last = 1;
+ is_hash = FALSE;
+
+ break;
+
+ default:
+ PerlIO_printf(Perl_debug_log, "UNKNOWN(%d)",
+ (int)(actions & MDEREF_ACTION_MASK));
+ last = 1;
+ break;
+
+ } /* switch */
+
+ actions >>= MDEREF_SHIFT;
+ } /* while */
+ return out;
+}
+
+
I32
Perl_debop(pTHX_ const OP *o)
{
@@ -2300,11 +2487,17 @@ Perl_debop(pTHX_ const OP *o)
case OP_PADHV:
S_deb_padvar(aTHX_ o->op_targ, 1, 1);
break;
+
case OP_PADRANGE:
S_deb_padvar(aTHX_ o->op_targ,
o->op_private & OPpPADRANGE_COUNTMASK, 1);
break;
+ case OP_MULTIDEREF:
+ PerlIO_printf(Perl_debug_log, "(%-p)",
+ unop_aux_stringify(o, deb_curcv(cxstack_ix)));
+ break;
+
default:
break;
}
diff --git a/embed.fnc b/embed.fnc
index 26d893d13d..c7b283b9f6 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -330,6 +330,7 @@ ApR |I32 |cxinc
Afp |void |deb |NN const char* pat|...
Ap |void |vdeb |NN const char* pat|NULLOK va_list* args
Ap |void |debprofdump
+EXp |SV* |unop_aux_stringify |NN const OP* o|NN CV *cv
Ap |I32 |debop |NN const OP* o
Ap |I32 |debstack
Ap |I32 |debstackptrs
@@ -2651,7 +2652,8 @@ s |SV * |find_hash_subscript|NULLOK const HV *const hv \
s |I32 |find_array_subscript|NULLOK const AV *const av \
|NN const SV *const val
sMd |SV* |find_uninit_var|NULLOK const OP *const obase \
- |NULLOK const SV *const uninit_sv|bool top
+ |NULLOK const SV *const uninit_sv|bool match \
+ |NN const char **desc_p
#endif
Ap |GV* |gv_fetchpvn_flags|NN const char* name|STRLEN len|I32 flags|const svtype sv_type
diff --git a/embed.h b/embed.h
index 7108b3e331..02d25be1cb 100644
--- a/embed.h
+++ b/embed.h
@@ -911,6 +911,7 @@
#define reg_temp_copy(a,b) Perl_reg_temp_copy(aTHX_ a,b)
#define report_uninit(a) Perl_report_uninit(aTHX_ a)
#define sv_magicext_mglob(a) Perl_sv_magicext_mglob(aTHX_ a)
+#define unop_aux_stringify(a,b) Perl_unop_aux_stringify(aTHX_ a,b)
#define validate_proto(a,b,c) Perl_validate_proto(aTHX_ a,b,c)
#define vivify_defelem(a) Perl_vivify_defelem(aTHX_ a)
#define yylex() Perl_yylex(aTHX)
@@ -1662,7 +1663,7 @@
#define expect_number(a) S_expect_number(aTHX_ a)
#define find_array_subscript(a,b) S_find_array_subscript(aTHX_ a,b)
#define find_hash_subscript(a,b) S_find_hash_subscript(aTHX_ a,b)
-#define find_uninit_var(a,b,c) S_find_uninit_var(aTHX_ a,b,c)
+#define find_uninit_var(a,b,c,d) S_find_uninit_var(aTHX_ a,b,c,d)
#define glob_2number(a) S_glob_2number(aTHX_ a)
#define glob_assign_glob(a,b,c) S_glob_assign_glob(aTHX_ a,b,c)
#define more_sv() S_more_sv(aTHX)
diff --git a/embedvar.h b/embedvar.h
index 9e4a910a57..32a8b9b327 100644
--- a/embedvar.h
+++ b/embedvar.h
@@ -205,6 +205,7 @@
#define PL_minus_p (vTHX->Iminus_p)
#define PL_modcount (vTHX->Imodcount)
#define PL_modglobal (vTHX->Imodglobal)
+#define PL_multideref_pc (vTHX->Imultideref_pc)
#define PL_my_cxt_keys (vTHX->Imy_cxt_keys)
#define PL_my_cxt_list (vTHX->Imy_cxt_list)
#define PL_my_cxt_size (vTHX->Imy_cxt_size)
diff --git a/ext/B/B.xs b/ext/B/B.xs
index 937ef2c43f..14bd7163b7 100644
--- a/ext/B/B.xs
+++ b/ext/B/B.xs
@@ -8,6 +8,7 @@
*/
#define PERL_NO_GET_CONTEXT
+#define PERL_EXT
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
@@ -1342,6 +1343,9 @@ string(o, cv)
SV *ret;
PPCODE:
switch (o->op_type) {
+ case OP_MULTIDEREF:
+ ret = unop_aux_stringify(o, cv);
+ break;
default:
ret = sv_2mortal(newSVpvn("", 0));
}
@@ -1359,9 +1363,105 @@ aux_list(o, cv)
B::OP o
B::CV cv
PPCODE:
+ PERL_UNUSED_VAR(cv); /* not needed on unthreaded builds */
switch (o->op_type) {
default:
XSRETURN(0); /* by default, an empty list */
+
+ case OP_MULTIDEREF:
+#ifdef USE_ITHREADS
+# define ITEM_SV(item) *av_fetch(comppad, (item)->pad_offset, FALSE);
+#else
+# define ITEM_SV(item) UNOP_AUX_item_sv(item)
+#endif
+ {
+ UNOP_AUX_item *items = cUNOP_AUXo->op_aux;
+ UV actions = items->uv;
+ UV len = items[-1].uv;
+ SV *sv;
+ bool last = 0;
+ bool is_hash = FALSE;
+#ifdef USE_ITHREADS
+ PADLIST * const padlist = CvPADLIST(cv);
+ PAD *comppad = comppad = PadlistARRAY(padlist)[1];
+#endif
+
+ EXTEND(SP, len);
+ PUSHs(sv_2mortal(newSViv(actions)));
+
+ while (!last) {
+ switch (actions & MDEREF_ACTION_MASK) {
+
+ case MDEREF_reload:
+ actions = (++items)->uv;
+ PUSHs(sv_2mortal(newSVuv(actions)));
+ continue;
+
+ case MDEREF_HV_padhv_helem:
+ is_hash = TRUE;
+ case MDEREF_AV_padav_aelem:
+ PUSHs(sv_2mortal(newSVuv((++items)->pad_offset)));
+ goto do_elem;
+
+ case MDEREF_HV_gvhv_helem:
+ is_hash = TRUE;
+ case MDEREF_AV_gvav_aelem:
+ sv = ITEM_SV(++items);
+ PUSHs(make_sv_object(aTHX_ sv));
+ goto do_elem;
+
+ case MDEREF_HV_gvsv_vivify_rv2hv_helem:
+ is_hash = TRUE;
+ case MDEREF_AV_gvsv_vivify_rv2av_aelem:
+ sv = ITEM_SV(++items);
+ PUSHs(make_sv_object(aTHX_ sv));
+ goto do_vivify_rv2xv_elem;
+
+ case MDEREF_HV_padsv_vivify_rv2hv_helem:
+ is_hash = TRUE;
+ case MDEREF_AV_padsv_vivify_rv2av_aelem:
+ PUSHs(sv_2mortal(newSVuv((++items)->pad_offset)));
+ goto do_vivify_rv2xv_elem;
+
+ case MDEREF_HV_pop_rv2hv_helem:
+ case MDEREF_HV_vivify_rv2hv_helem:
+ is_hash = TRUE;
+ do_vivify_rv2xv_elem:
+ case MDEREF_AV_pop_rv2av_aelem:
+ case MDEREF_AV_vivify_rv2av_aelem:
+ do_elem:
+ switch (actions & MDEREF_INDEX_MASK) {
+ case MDEREF_INDEX_none:
+ last = 1;
+ break;
+ case MDEREF_INDEX_const:
+ if (is_hash) {
+ sv = ITEM_SV(++items);
+ PUSHs(make_sv_object(aTHX_ sv));
+ }
+ else
+ PUSHs(sv_2mortal(newSViv((++items)->iv)));
+ break;
+ case MDEREF_INDEX_padsv:
+ PUSHs(sv_2mortal(newSVuv((++items)->pad_offset)));
+ break;
+ case MDEREF_INDEX_gvsv:
+ sv = ITEM_SV(++items);
+ PUSHs(make_sv_object(aTHX_ sv));
+ break;
+ }
+ if (actions & MDEREF_FLAG_last)
+ last = 1;
+ is_hash = FALSE;
+
+ break;
+ } /* switch */
+
+ actions >>= MDEREF_SHIFT;
+ } /* while */
+ XSRETURN(len);
+
+ } /* OP_MULTIDEREF */
} /* switch */
diff --git a/ext/B/B/Concise.pm b/ext/B/B/Concise.pm
index 381181e6d2..311e0e738a 100644
--- a/ext/B/B/Concise.pm
+++ b/ext/B/B/Concise.pm
@@ -916,7 +916,7 @@ sub concise_op {
}
}
elsif ($h{class} eq "UNOP_AUX") {
- $h{arg} = "(" . $op->string . ")";
+ $h{arg} = "(" . $op->string($curcv) . ")";
}
$h{seq} = $h{hyphseq} = seq($op);
diff --git a/ext/B/t/OptreeCheck.pm b/ext/B/t/OptreeCheck.pm
index 0537a8d7a8..eac73baa73 100644
--- a/ext/B/t/OptreeCheck.pm
+++ b/ext/B/t/OptreeCheck.pm
@@ -5,7 +5,7 @@ use warnings;
use vars qw($TODO $Level $using_open);
require "test.pl";
-our $VERSION = '0.11';
+our $VERSION = '0.12';
# now export checkOptree, and those test.pl functions used by tests
our @EXPORT = qw( checkOptree plan skip skip_all pass is like unlike
@@ -669,6 +669,8 @@ sub mkCheckRex {
$tc->{wantstr} = $str;
+ # make UNOP_AUX flag type literal
+ $str =~ s/<\+>/<\\+>/;
# make targ args wild
$str =~ s/\[t\d+\]/[t\\d+]/msg;
diff --git a/ext/B/t/concise-xs.t b/ext/B/t/concise-xs.t
index 365951d0bc..289f909cc9 100644
--- a/ext/B/t/concise-xs.t
+++ b/ext/B/t/concise-xs.t
@@ -159,6 +159,7 @@ my $testpkgs = {
constant => [qw/ ASSIGN CVf_LVALUE
CVf_METHOD LIST_CONTEXT OP_CONST OP_LIST OP_RV2SV
OP_AELEM OP_CUSTOM OP_NEXTSTATE OP_DBSTATE
+ OP_HELEM OP_RV2AV OP_RV2HV
OP_STRINGIFY OPf_KIDS OPf_MOD OPf_REF OPf_SPECIAL
OPf_PARENS
OPf_STACKED OPf_WANT OPf_WANT_LIST OPf_WANT_SCALAR
@@ -169,6 +170,8 @@ my $testpkgs = {
OPpSORT_REVERSE OPpREVERSE_INPLACE OPpTARGET_MY
OPpTRANS_COMPLEMENT OPpTRANS_DELETE OPpTRANS_SQUASH
OPpREPEAT_DOLIST
+ OPpMULTIDEREF_EXISTS
+ OPpMULTIDEREF_DELETE
PMf_CONTINUE PMf_EVAL PMf_EXTENDED PMf_EXTENDED_MORE
PMf_FOLD PMf_GLOBAL
PMf_KEEP PMf_NONDESTRUCT
@@ -176,7 +179,32 @@ my $testpkgs = {
POSTFIX SVf_FAKE SVf_IOK SVf_NOK SVf_POK SVf_ROK
SVpad_STATE
SVpad_OUR SVs_RMG SVs_SMG SWAP_CHILDREN OPpPAD_STATE
- OPpCONST_ARYBASE RXf_SKIPWHITE SVpad_TYPED/,
+ OPpCONST_ARYBASE RXf_SKIPWHITE SVpad_TYPED
+
+ MDEREF_reload
+ MDEREF_AV_pop_rv2av_aelem
+ MDEREF_AV_gvsv_vivify_rv2av_aelem
+ MDEREF_AV_padsv_vivify_rv2av_aelem
+ MDEREF_AV_vivify_rv2av_aelem
+ MDEREF_AV_padav_aelem
+ MDEREF_AV_gvav_aelem
+ MDEREF_HV_pop_rv2hv_helem
+ MDEREF_HV_gvsv_vivify_rv2hv_helem
+ MDEREF_HV_padsv_vivify_rv2hv_helem
+ MDEREF_HV_vivify_rv2hv_helem
+ MDEREF_HV_padhv_helem
+ MDEREF_HV_gvhv_helem
+ MDEREF_ACTION_MASK
+ MDEREF_INDEX_none
+ MDEREF_INDEX_const
+ MDEREF_INDEX_padsv
+ MDEREF_INDEX_gvsv
+ MDEREF_INDEX_MASK
+ MDEREF_FLAG_last
+ MDEREF_MASK
+ MDEREF_SHIFT
+ /,
+
$] >= 5.015 ? qw(
OP_GLOB PMf_SKIPWHITE RXf_PMf_CHARSET RXf_PMf_KEEPCOPY
OPpEVAL_BYTES OPpSUBSTR_REPL_FIRST) : (),
diff --git a/ext/B/t/f_sort.t b/ext/B/t/f_sort.t
index 7205a94e44..55811eda93 100644
--- a/ext/B/t/f_sort.t
+++ b/ext/B/t/f_sort.t
@@ -510,10 +510,8 @@ checkOptree(name => q{Compound sort/map Expression },
# 5 <0> pushmark s
# 6 <#> gv[*old] s
# 7 <1> rv2av[t19] lKM/1
-# 8 <@> mapstart lK* < 5.017002
-# 8 <@> mapstart lK >=5.017002
-# 9 <|> mapwhile(other->a)[t20] lK < 5.019002
-# 9 <|> mapwhile(other->a)[t20] lKM >=5.019002
+# 8 <@> mapstart lK
+# 9 <|> mapwhile(other->a)[t20] lKM
# a <0> enter l
# b <;> nextstate(main 608 (eval 34):2) v:{
# c <0> pushmark s
@@ -525,21 +523,15 @@ checkOptree(name => q{Compound sort/map Expression },
# i <@> leave lKP
# goto 9
# j <@> sort lKMS*
-# k <@> mapstart lK* < 5.017002
-# k <@> mapstart lK >=5.017002
+# k <@> mapstart lK
# l <|> mapwhile(other->m)[t26] lK
-# m <#> gv[*_] s
-# n <1> rv2sv sKM/DREFAV,1
-# o <1> rv2av[t4] sKR/1
-# p <$> const[IV 0] s
-# q <2> aelem sK/2
-# - <@> scope lK < 5.017002
+# m <+> multideref($_->[0]) sK
# goto l
-# r <0> pushmark s
-# s <#> gv[*new] s
-# t <1> rv2av[t2] lKRM*/1
-# u <2> aassign[t27] KS/COMMON
-# v <1> leavesub[1 ref] K/REFC,1
+# n <0> pushmark s
+# o <#> gv[*new] s
+# p <1> rv2av[t2] lKRM*/1
+# q <2> aassign[t22] KS/COMMON
+# r <1> leavesub[1 ref] K/REFC,1
EOT_EOT
# 1 <;> nextstate(main 609 (eval 34):3) v:{
# 2 <0> pushmark s
@@ -548,10 +540,8 @@ EOT_EOT
# 5 <0> pushmark s
# 6 <$> gv(*old) s
# 7 <1> rv2av[t10] lKM/1
-# 8 <@> mapstart lK* < 5.017002
-# 8 <@> mapstart lK >=5.017002
-# 9 <|> mapwhile(other->a)[t11] lK < 5.019002
-# 9 <|> mapwhile(other->a)[t11] lKM >=5.019002
+# 8 <@> mapstart lK
+# 9 <|> mapwhile(other->a)[t11] lKM
# a <0> enter l
# b <;> nextstate(main 608 (eval 34):2) v:{
# c <0> pushmark s
@@ -563,21 +553,15 @@ EOT_EOT
# i <@> leave lKP
# goto 9
# j <@> sort lKMS*
-# k <@> mapstart lK* < 5.017002
-# k <@> mapstart lK >=5.017002
+# k <@> mapstart lK
# l <|> mapwhile(other->m)[t12] lK
-# m <$> gv(*_) s
-# n <1> rv2sv sKM/DREFAV,1
-# o <1> rv2av[t2] sKR/1
-# p <$> const(IV 0) s
-# q <2> aelem sK/2
-# - <@> scope lK < 5.017002
+# m <+> multideref($_->[0]) sK
# goto l
-# r <0> pushmark s
-# s <$> gv(*new) s
-# t <1> rv2av[t1] lKRM*/1
-# u <2> aassign[t13] KS/COMMON
-# v <1> leavesub[1 ref] K/REFC,1
+# n <0> pushmark s
+# o <$> gv(*new) s
+# p <1> rv2av[t1] lKRM*/1
+# q <2> aassign[t13] KS/COMMON
+# r <1> leavesub[1 ref] K/REFC,1
EONT_EONT
diff --git a/ext/Opcode/Opcode.pm b/ext/Opcode/Opcode.pm
index b1813e072c..b9f67dd324 100644
--- a/ext/Opcode/Opcode.pm
+++ b/ext/Opcode/Opcode.pm
@@ -312,7 +312,7 @@ invert_opset function.
av2arylen
rv2hv helem hslice kvhslice each values keys exists delete
- aeach akeys avalues reach rvalues rkeys
+ aeach akeys avalues reach rvalues rkeys multideref
preinc i_preinc predec i_predec postinc i_postinc
postdec i_postdec int hex oct abs pow multiply i_multiply
diff --git a/intrpvar.h b/intrpvar.h
index 39eac06454..ffb1172c9f 100644
--- a/intrpvar.h
+++ b/intrpvar.h
@@ -70,6 +70,9 @@ PERLVARI(I, hash_rand_bits_enabled, U8, 1) /* used to randomize hash stuff 0 ==
PERLVARI(I, hash_rand_bits, UV, 0) /* used to randomize hash stuff */
#endif
PERLVAR(I, strtab, HV *) /* shared string table */
+/* prog counter for the currently executing OP_MULTIDEREF Used to signal
+ * to S_find_uninit_var() where we are */
+PERLVAR(I, multideref_pc, UNOP_AUX_item *)
/* Fields used by magic variables such as $@, $/ and so on */
PERLVAR(I, curpm, PMOP *) /* what to do \ interps in REs from */
diff --git a/lib/B/Deparse.pm b/lib/B/Deparse.pm
index 74562c58e3..267c0cdb6a 100644
--- a/lib/B/Deparse.pm
+++ b/lib/B/Deparse.pm
@@ -15,12 +15,36 @@ use B qw(class main_root main_start main_cv svref_2object opnumber perlstring
OPpLVAL_INTRO OPpOUR_INTRO OPpENTERSUB_AMPER OPpSLICE OPpCONST_BARE
OPpTRANS_SQUASH OPpTRANS_DELETE OPpTRANS_COMPLEMENT OPpTARGET_MY
OPpEXISTS_SUB OPpSORT_NUMERIC OPpSORT_INTEGER OPpREPEAT_DOLIST
- OPpSORT_REVERSE
+ OPpSORT_REVERSE OPpMULTIDEREF_EXISTS OPpMULTIDEREF_DELETE
SVf_IOK SVf_NOK SVf_ROK SVf_POK SVpad_OUR SVf_FAKE SVs_RMG SVs_SMG
SVpad_TYPED
CVf_METHOD CVf_LVALUE
PMf_KEEP PMf_GLOBAL PMf_CONTINUE PMf_EVAL PMf_ONCE
- PMf_MULTILINE PMf_SINGLELINE PMf_FOLD PMf_EXTENDED PMf_EXTENDED_MORE);
+ PMf_MULTILINE PMf_SINGLELINE PMf_FOLD PMf_EXTENDED PMf_EXTENDED_MORE
+ MDEREF_reload
+ MDEREF_AV_pop_rv2av_aelem
+ MDEREF_AV_gvsv_vivify_rv2av_aelem
+ MDEREF_AV_padsv_vivify_rv2av_aelem
+ MDEREF_AV_vivify_rv2av_aelem
+ MDEREF_AV_padav_aelem
+ MDEREF_AV_gvav_aelem
+ MDEREF_HV_pop_rv2hv_helem
+ MDEREF_HV_gvsv_vivify_rv2hv_helem
+ MDEREF_HV_padsv_vivify_rv2hv_helem
+ MDEREF_HV_vivify_rv2hv_helem
+ MDEREF_HV_padhv_helem
+ MDEREF_HV_gvhv_helem
+ MDEREF_ACTION_MASK
+ MDEREF_INDEX_none
+ MDEREF_INDEX_const
+ MDEREF_INDEX_padsv
+ MDEREF_INDEX_gvsv
+ MDEREF_INDEX_MASK
+ MDEREF_FLAG_last
+ MDEREF_MASK
+ MDEREF_SHIFT
+ );
+
$VERSION = '1.31';
use strict;
use vars qw/$AUTOLOAD/;
@@ -334,7 +358,7 @@ BEGIN {
BEGIN { for (qw[ const stringify rv2sv list glob pushmark null aelem
- custom nextstate dbstate ]) {
+ nextstate dbstate rv2av rv2hv helem custom ]) {
eval "sub OP_\U$_ () { " . opnumber($_) . "}"
}}
@@ -3729,7 +3753,7 @@ sub pp_rv2av {
sub is_subscriptable {
my $op = shift;
- if ($op->name =~ /^[ahg]elem/) {
+ if ($op->name =~ /^([ahg]elem|multideref$)/) {
return 1;
} elsif ($op->name eq "entersub") {
my $kid = $op->first;
@@ -3834,6 +3858,145 @@ sub elem {
}
+# a simplified version of elem_or_slice_array_name()
+# for the use of pp_multideref
+
+sub multideref_var_name {
+ my $self = shift;
+ my ($gv, $is_hash) = @_;
+
+ my ($name, $quoted) =
+ $self->stash_variable_name( $is_hash ? '%' : '@', $gv);
+ return $quoted ? "$name->"
+ : $name eq '#'
+ ? '${#}' # avoid ${#}[1] => $#[1]
+ : '$' . $name;
+}
+
+
+sub pp_multideref {
+ my $self = shift;
+ my($op, $cx) = @_;
+ my $text = "";
+
+ if ($op->private & OPpMULTIDEREF_EXISTS) {
+ $text = $self->keyword("exists"). " ";
+ }
+ elsif ($op->private & OPpMULTIDEREF_DELETE) {
+ $text = $self->keyword("delete"). " ";
+ }
+ elsif ($op->private & OPpLVAL_INTRO) {
+ $text = $self->keyword("local"). " ";
+ }
+
+ if ($op->first && ($op->first->flags & OPf_KIDS)) {
+ # arbitrary initial expression, e.g. f(1,2,3)->[...]
+ $text .= $self->deparse($op->first, 24);
+ }
+
+ my @items = $op->aux_list($self->{curcv});
+ my $actions = shift @items;
+
+ my $is_hash;
+ my $derefs = 0;
+
+ while (1) {
+ if (($actions & MDEREF_ACTION_MASK) == MDEREF_reload) {
+ $actions = shift @items;
+ next;
+ }
+
+ $is_hash = (
+ ($actions & MDEREF_ACTION_MASK) == MDEREF_HV_pop_rv2hv_helem
+ || ($actions & MDEREF_ACTION_MASK) == MDEREF_HV_gvsv_vivify_rv2hv_helem
+ || ($actions & MDEREF_ACTION_MASK) == MDEREF_HV_padsv_vivify_rv2hv_helem
+ || ($actions & MDEREF_ACTION_MASK) == MDEREF_HV_vivify_rv2hv_helem
+ || ($actions & MDEREF_ACTION_MASK) == MDEREF_HV_padhv_helem
+ || ($actions & MDEREF_ACTION_MASK) == MDEREF_HV_gvhv_helem
+ );
+
+ if ( ($actions & MDEREF_ACTION_MASK) == MDEREF_AV_padav_aelem
+ || ($actions & MDEREF_ACTION_MASK) == MDEREF_HV_padhv_helem)
+ {
+ $derefs = 1;
+ $text .= '$' . substr($self->padname(shift @items), 1);
+ }
+ elsif ( ($actions & MDEREF_ACTION_MASK) == MDEREF_AV_gvav_aelem
+ || ($actions & MDEREF_ACTION_MASK) == MDEREF_HV_gvhv_helem)
+ {
+ $derefs = 1;
+ $text .= $self->multideref_var_name(shift @items, $is_hash);
+ }
+ else {
+ if ( ($actions & MDEREF_ACTION_MASK) ==
+ MDEREF_AV_padsv_vivify_rv2av_aelem
+ || ($actions & MDEREF_ACTION_MASK) ==
+ MDEREF_HV_padsv_vivify_rv2hv_helem)
+ {
+ $text .= $self->padname(shift @items);
+ }
+ elsif ( ($actions & MDEREF_ACTION_MASK) ==
+ MDEREF_AV_gvsv_vivify_rv2av_aelem
+ || ($actions & MDEREF_ACTION_MASK) ==
+ MDEREF_HV_gvsv_vivify_rv2hv_helem)
+ {
+ $text .= $self->multideref_var_name(shift @items, $is_hash);
+ }
+ elsif ( ($actions & MDEREF_ACTION_MASK) ==
+ MDEREF_AV_pop_rv2av_aelem
+ || ($actions & MDEREF_ACTION_MASK) ==
+ MDEREF_HV_pop_rv2hv_helem)
+ {
+ if ( ($op->flags & OPf_KIDS)
+ && ( _op_is_or_was($op->first, OP_RV2AV)
+ || _op_is_or_was($op->first, OP_RV2HV))
+ && ($op->first->flags & OPf_KIDS)
+ && ( _op_is_or_was($op->first->first, OP_AELEM)
+ || _op_is_or_was($op->first->first, OP_HELEM))
+ )
+ {
+ $derefs++;
+ }
+ }
+
+ $text .= '->' if !$derefs++;
+ }
+
+
+ if (($actions & MDEREF_INDEX_MASK) == MDEREF_INDEX_none) {
+ last;
+ }
+
+ $text .= $is_hash ? '{' : '[';
+
+ if (($actions & MDEREF_INDEX_MASK) == MDEREF_INDEX_const) {
+ my $key = shift @items;
+ if ($is_hash) {
+ $text .= $self->const($key, $cx);
+ }
+ else {
+ $text .= $key;
+ }
+ }
+ elsif (($actions & MDEREF_INDEX_MASK) == MDEREF_INDEX_padsv) {
+ $text .= $self->padname(shift @items);
+ }
+ elsif (($actions & MDEREF_INDEX_MASK) == MDEREF_INDEX_gvsv) {
+ $text .= '$' . ($self->stash_variable_name('$', shift @items))[0];
+ }
+
+ $text .= $is_hash ? '}' : ']';
+
+ if ($actions & MDEREF_FLAG_last) {
+ last;
+ }
+ $actions >>= MDEREF_SHIFT;
+ }
+
+ return $text;
+}
+
+
sub pp_aelem { maybe_local(@_, elem(@_, "[", "]", "padav")) }
sub pp_helem { maybe_local(@_, elem(@_, "{", "}", "padhv")) }
@@ -4727,7 +4890,7 @@ sub pp_stringify {
while ($kid->name eq 'null' && !null($kid->first)) {
$kid = $kid->first;
}
- if ($kid->name =~ /^(?:const|padsv|rv2sv|av2arylen|gvsv
+ if ($kid->name =~ /^(?:const|padsv|rv2sv|av2arylen|gvsv|multideref
|aelemfast(?:_lex)?|[ah]elem|join|concat)\z/x) {
maybe_targmy(@_, \&dquote);
}
@@ -5075,20 +5238,23 @@ sub pure_string {
elsif (is_scalar($op) || $type =~ /^[ah]elem$/) {
return 1;
}
- elsif ($type eq "null" and $op->can('first') and not null $op->first and
- ($op->first->name eq "null" and $op->first->can('first')
- and not null $op->first->first and
- $op->first->first->name eq "aelemfast"
- or
- $op->first->name =~ /^aelemfast(?:_lex)?\z/
- )) {
- return 1;
- }
- else {
- return 0;
+ elsif ($type eq "null" and $op->can('first') and not null $op->first) {
+ my $first = $op->first;
+
+ return 1 if $first->name eq "multideref";
+ return 1 if $first->name eq "aelemfast_lex";
+
+ if ( $first->name eq "null"
+ and $first->can('first')
+ and not null $first->first
+ and $first->first->name eq "aelemfast"
+ )
+ {
+ return 1;
+ }
}
- return 1;
+ return 0;
}
sub code_list {
diff --git a/lib/B/Deparse.t b/lib/B/Deparse.t
index f14c2abf1f..ef19f7163e 100644
--- a/lib/B/Deparse.t
+++ b/lib/B/Deparse.t
@@ -2088,3 +2088,81 @@ $_ = join $foo, pos
>>>>
my $foo;
$_ = join('???', pos $_);
+####
+# exists $a[0]
+our @a;
+exists $a[0];
+####
+# my @a; exists $a[0]
+my @a;
+exists $a[0];
+####
+# delete $a[0]
+our @a;
+delete $a[0];
+####
+# my @a; delete $a[0]
+my @a;
+delete $a[0];
+####
+# $_[0][$_[1]]
+$_[0][$_[1]];
+####
+# f($a[0]);
+my @a;
+f($a[0]);
+####
+#qr/\Q$h{'key'}\E/;
+my %h;
+qr/\Q$h{'key'}\E/;
+####
+# my $x = "$h{foo}";
+my %h;
+my $x = "$h{'foo'}";
+####
+# weird constant hash key
+my %h;
+my $x = $h{"\000\t\x{100}"};
+####
+# multideref and packages
+package foo;
+my(%bar) = ('a', 'b');
+our(@bar) = (1, 2);
+$bar{'k'} = $bar[200];
+$main::bar{'k'} = $main::bar[200];
+$foo::bar{'k'} = $foo::bar[200];
+package foo2;
+$bar{'k'} = $bar[200];
+$main::bar{'k'} = $main::bar[200];
+$foo::bar{'k'} = $foo::bar[200];
+>>>>
+package foo;
+my(%bar) = ('a', 'b');
+our(@bar) = (1, 2);
+$bar{'k'} = $bar[200];
+$main::bar{'k'} = $main::bar[200];
+$foo::bar{'k'} = $bar[200];
+package foo2;
+$bar{'k'} = $foo::bar[200];
+$main::bar{'k'} = $main::bar[200];
+$foo::bar{'k'} = $foo::bar[200];
+####
+# multideref and local
+my %h;
+local $h{'foo'}[0] = 1;
+####
+# multideref and exists
+my(%h, $i);
+my $e = exists $h{'foo'}[$i];
+####
+# multideref and delete
+my(%h, $i);
+my $e = delete $h{'foo'}[$i];
+####
+# multideref with leading expression
+my $r;
+my $x = ($r // [])->{'foo'}[0];
+####
+# multideref with complex middle index
+my(%h, $i, $j, $k);
+my $x = $h{'foo'}[$i + $j]{$k};
diff --git a/lib/B/Op_private.pm b/lib/B/Op_private.pm
index e8e63a2e32..e7383644b7 100644
--- a/lib/B/Op_private.pm
+++ b/lib/B/Op_private.pm
@@ -129,15 +129,15 @@ $bits{$_}{4} = 'OPpFT_AFTER_t' for qw(ftatime ftbinary ftblk ftchr ftctime ftdir
$bits{$_}{2} = 'OPpFT_STACKED' for qw(ftatime ftbinary ftblk ftchr ftctime ftdir fteexec fteowned fteread ftewrite ftfile ftis ftlink ftmtime ftpipe ftrexec ftrowned ftrread ftrwrite ftsgid ftsize ftsock ftsuid ftsvtx fttext fttty ftzero);
$bits{$_}{3} = 'OPpFT_STACKING' for qw(ftatime ftbinary ftblk ftchr ftctime ftdir fteexec fteowned fteread ftewrite ftfile ftis ftlink ftmtime ftpipe ftrexec ftrowned ftrread ftrwrite ftsgid ftsize ftsock ftsuid ftsvtx fttext fttty ftzero);
$bits{$_}{1} = 'OPpGREP_LEX' for qw(grepstart grepwhile mapstart mapwhile);
-$bits{$_}{1} = 'OPpHINT_STRICT_REFS' for qw(entersub rv2av rv2cv rv2gv rv2hv rv2sv);
+$bits{$_}{1} = 'OPpHINT_STRICT_REFS' for qw(entersub multideref rv2av rv2cv rv2gv rv2hv rv2sv);
$bits{$_}{5} = 'OPpHUSH_VMSISH' for qw(dbstate nextstate);
$bits{$_}{2} = 'OPpITER_REVERSED' for qw(enteriter iter);
$bits{$_}{7} = 'OPpLVALUE' for qw(leave leaveloop);
-$bits{$_}{6} = 'OPpLVAL_DEFER' for qw(aelem helem);
-$bits{$_}{7} = 'OPpLVAL_INTRO' for qw(aelem aslice cond_expr delete enteriter entersub gvsv helem hslice list lvavref lvref lvrefslice padav padhv padrange padsv pushmark refassign rv2av rv2gv rv2hv rv2sv);
+$bits{$_}{6} = 'OPpLVAL_DEFER' for qw(aelem helem multideref);
+$bits{$_}{7} = 'OPpLVAL_INTRO' for qw(aelem aslice cond_expr delete enteriter entersub gvsv helem hslice list lvavref lvref lvrefslice multideref padav padhv padrange padsv pushmark refassign rv2av rv2gv rv2hv rv2sv);
$bits{$_}{2} = 'OPpLVREF_ELEM' for qw(lvref refassign);
$bits{$_}{3} = 'OPpLVREF_ITER' for qw(lvref refassign);
-$bits{$_}{3} = 'OPpMAYBE_LVSUB' for qw(aassign aelem aslice av2arylen helem hslice keys kvaslice kvhslice padav padhv pos rkeys rv2av rv2gv rv2hv substr vec);
+$bits{$_}{3} = 'OPpMAYBE_LVSUB' for qw(aassign aelem aslice av2arylen helem hslice keys kvaslice kvhslice multideref padav padhv pos rkeys rv2av rv2gv rv2hv substr vec);
$bits{$_}{4} = 'OPpMAYBE_TRUEBOOL' for qw(padhv rv2hv);
$bits{$_}{7} = 'OPpOFFBYONE' for qw(caller runcv wantarray);
$bits{$_}{5} = 'OPpOPEN_IN_CRLF' for qw(backtick open);
@@ -415,6 +415,7 @@ $bits{method_super}{0} = $bf[0];
@{$bits{msgget}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]);
@{$bits{msgrcv}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]);
@{$bits{msgsnd}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]);
+@{$bits{multideref}}{5,4,0} = ('OPpMULTIDEREF_DELETE', 'OPpMULTIDEREF_EXISTS', $bf[0]);
@{$bits{multiply}}{1,0} = ($bf[1], $bf[1]);
@{$bits{ncmp}}{1,0} = ($bf[1], $bf[1]);
@{$bits{ne}}{1,0} = ($bf[1], $bf[1]);
@@ -610,6 +611,8 @@ our %defines = (
OPpMAYBE_LVSUB => 8,
OPpMAYBE_TRUEBOOL => 16,
OPpMAY_RETURN_CONSTANT => 32,
+ OPpMULTIDEREF_DELETE => 32,
+ OPpMULTIDEREF_EXISTS => 16,
OPpOFFBYONE => 128,
OPpOPEN_IN_CRLF => 32,
OPpOPEN_IN_RAW => 16,
@@ -699,6 +702,8 @@ our %labels = (
OPpMAYBE_LVSUB => 'LVSUB',
OPpMAYBE_TRUEBOOL => 'BOOL?',
OPpMAY_RETURN_CONSTANT => 'CONST',
+ OPpMULTIDEREF_DELETE => 'DELETE',
+ OPpMULTIDEREF_EXISTS => 'EXISTS',
OPpOFFBYONE => '+1',
OPpOPEN_IN_CRLF => 'INCR',
OPpOPEN_IN_RAW => 'INBIN',
@@ -750,17 +755,18 @@ our %ops_using = (
OPpFT_ACCESS => [qw(fteexec fteread ftewrite ftrexec ftrread ftrwrite)],
OPpFT_AFTER_t => [qw(ftatime ftbinary ftblk ftchr ftctime ftdir fteexec fteowned fteread ftewrite ftfile ftis ftlink ftmtime ftpipe ftrexec ftrowned ftrread ftrwrite ftsgid ftsize ftsock ftsuid ftsvtx fttext fttty ftzero)],
OPpGREP_LEX => [qw(grepstart grepwhile mapstart mapwhile)],
- OPpHINT_STRICT_REFS => [qw(entersub rv2av rv2cv rv2gv rv2hv rv2sv)],
+ OPpHINT_STRICT_REFS => [qw(entersub multideref rv2av rv2cv rv2gv rv2hv rv2sv)],
OPpHUSH_VMSISH => [qw(dbstate nextstate)],
OPpITER_DEF => [qw(enteriter)],
OPpITER_REVERSED => [qw(enteriter iter)],
OPpLIST_GUESSED => [qw(list)],
OPpLVALUE => [qw(leave leaveloop)],
- OPpLVAL_DEFER => [qw(aelem helem)],
- OPpLVAL_INTRO => [qw(aelem aslice cond_expr delete enteriter entersub gvsv helem hslice list lvavref lvref lvrefslice padav padhv padrange padsv pushmark refassign rv2av rv2gv rv2hv rv2sv)],
+ OPpLVAL_DEFER => [qw(aelem helem multideref)],
+ OPpLVAL_INTRO => [qw(aelem aslice cond_expr delete enteriter entersub gvsv helem hslice list lvavref lvref lvrefslice multideref padav padhv padrange padsv pushmark refassign rv2av rv2gv rv2hv rv2sv)],
OPpLVREF_ELEM => [qw(lvref refassign)],
- OPpMAYBE_LVSUB => [qw(aassign aelem aslice av2arylen helem hslice keys kvaslice kvhslice padav padhv pos rkeys rv2av rv2gv rv2hv substr vec)],
+ OPpMAYBE_LVSUB => [qw(aassign aelem aslice av2arylen helem hslice keys kvaslice kvhslice multideref padav padhv pos rkeys rv2av rv2gv rv2hv substr vec)],
OPpMAYBE_TRUEBOOL => [qw(padhv rv2hv)],
+ OPpMULTIDEREF_DELETE => [qw(multideref)],
OPpOFFBYONE => [qw(caller runcv wantarray)],
OPpOPEN_IN_CRLF => [qw(backtick open)],
OPpOUR_INTRO => [qw(enteriter gvsv rv2av rv2hv rv2sv split)],
@@ -798,6 +804,7 @@ $ops_using{OPpFT_STACKED} = $ops_using{OPpFT_AFTER_t};
$ops_using{OPpFT_STACKING} = $ops_using{OPpFT_AFTER_t};
$ops_using{OPpLVREF_ITER} = $ops_using{OPpLVREF_ELEM};
$ops_using{OPpMAY_RETURN_CONSTANT} = $ops_using{OPpENTERSUB_NOPAREN};
+$ops_using{OPpMULTIDEREF_EXISTS} = $ops_using{OPpMULTIDEREF_DELETE};
$ops_using{OPpOPEN_IN_RAW} = $ops_using{OPpOPEN_IN_CRLF};
$ops_using{OPpOPEN_OUT_CRLF} = $ops_using{OPpOPEN_IN_CRLF};
$ops_using{OPpOPEN_OUT_RAW} = $ops_using{OPpOPEN_IN_CRLF};
diff --git a/op.c b/op.c
index f34e9326f7..16ebd4244b 100644
--- a/op.c
+++ b/op.c
@@ -797,7 +797,8 @@ void S_op_clear_gv(pTHX_ OP *o, SV**svp)
#endif
{
- GV *gv = (o->op_type == OP_GV || o->op_type == OP_GVSV)
+ GV *gv = (o->op_type == OP_GV || o->op_type == OP_GVSV
+ || o->op_type == OP_MULTIDEREF)
#ifdef USE_ITHREADS
&& PL_curpad
? ((GV*)PAD_SVl(*ixp)) : NULL;
@@ -975,6 +976,109 @@ clear_pmop:
#endif
break;
+
+ case OP_MULTIDEREF:
+ {
+ UNOP_AUX_item *items = cUNOP_AUXo->op_aux;
+ UV actions = items->uv;
+ bool last = 0;
+ bool is_hash = FALSE;
+
+ while (!last) {
+ switch (actions & MDEREF_ACTION_MASK) {
+
+ case MDEREF_reload:
+ actions = (++items)->uv;
+ continue;
+
+ case MDEREF_HV_padhv_helem:
+ is_hash = TRUE;
+ case MDEREF_AV_padav_aelem:
+ pad_free((++items)->pad_offset);
+ goto do_elem;
+
+ case MDEREF_HV_gvhv_helem:
+ is_hash = TRUE;
+ case MDEREF_AV_gvav_aelem:
+#ifdef USE_ITHREADS
+ S_op_clear_gv(aTHX_ o, &((++items)->pad_offset));
+#else
+ S_op_clear_gv(aTHX_ o, &((++items)->sv));
+#endif
+ goto do_elem;
+
+ case MDEREF_HV_gvsv_vivify_rv2hv_helem:
+ is_hash = TRUE;
+ case MDEREF_AV_gvsv_vivify_rv2av_aelem:
+#ifdef USE_ITHREADS
+ S_op_clear_gv(aTHX_ o, &((++items)->pad_offset));
+#else
+ S_op_clear_gv(aTHX_ o, &((++items)->sv));
+#endif
+ goto do_vivify_rv2xv_elem;
+
+ case MDEREF_HV_padsv_vivify_rv2hv_helem:
+ is_hash = TRUE;
+ case MDEREF_AV_padsv_vivify_rv2av_aelem:
+ pad_free((++items)->pad_offset);
+ goto do_vivify_rv2xv_elem;
+
+ case MDEREF_HV_pop_rv2hv_helem:
+ case MDEREF_HV_vivify_rv2hv_helem:
+ is_hash = TRUE;
+ do_vivify_rv2xv_elem:
+ case MDEREF_AV_pop_rv2av_aelem:
+ case MDEREF_AV_vivify_rv2av_aelem:
+ do_elem:
+ switch (actions & MDEREF_INDEX_MASK) {
+ case MDEREF_INDEX_none:
+ last = 1;
+ break;
+ case MDEREF_INDEX_const:
+ if (is_hash) {
+#ifdef USE_ITHREADS
+ /* see RT #15654 */
+ pad_swipe((++items)->pad_offset, 1);
+#else
+ SvREFCNT_dec((++items)->sv);
+#endif
+ }
+ else
+ items++;
+ break;
+ case MDEREF_INDEX_padsv:
+ pad_free((++items)->pad_offset);
+ break;
+ case MDEREF_INDEX_gvsv:
+#ifdef USE_ITHREADS
+ S_op_clear_gv(aTHX_ o, &((++items)->pad_offset));
+#else
+ S_op_clear_gv(aTHX_ o, &((++items)->sv));
+#endif
+ break;
+ }
+
+ if (actions & MDEREF_FLAG_last)
+ last = 1;
+ is_hash = FALSE;
+
+ break;
+
+ default:
+ assert(0);
+ last = 1;
+ break;
+
+ } /* switch */
+
+ actions >>= MDEREF_SHIFT;
+ } /* while */
+
+ /* start of malloc is at op_aux[-1], where the length is
+ * stored */
+ PerlMemShared_free(cUNOP_AUXo->op_aux - 1);
+ }
+ break;
}
if (o->op_targ > 0) {
@@ -2171,7 +2275,7 @@ S_modkids(pTHX_ OP *o, I32 type)
*/
void
-S_check_hash_fields(pTHX_ UNOP *rop, SVOP *key_op)
+S_check_hash_fields_and_hekify(pTHX_ UNOP *rop, SVOP *key_op)
{
PADNAME *lexname;
GV **fields;
@@ -2379,7 +2483,7 @@ S_finalize_op(pTHX_ OP* o)
check_keys:
if (o->op_private & OPpLVAL_INTRO || rop->op_type != OP_RV2HV)
rop = NULL;
- S_check_hash_fields(aTHX_ rop, key_op);
+ S_check_hash_fields_and_hekify(aTHX_ rop, key_op);
break;
}
case OP_ASLICE:
@@ -4705,7 +4809,7 @@ Perl_newUNOP(pTHX_ I32 type, I32 flags, OP *first)
}
/*
-=for apidoc
+=for apidoc newUNOP_AUX
Similar to C<newUNOP>, but creates an UNOP_AUX struct instead, with op_aux
initialised to aux
@@ -12065,6 +12169,608 @@ S_inplace_aassign(pTHX_ OP *o) {
+/* S_maybe_multideref(): given an op_next chain of ops beginning at 'start'
+ * that potentially represent a series of one or more aggregate derefs
+ * (such as $a->[1]{$key}), examine the chain, and if appropriate, convert
+ * the whole chain to a single OP_MULTIDEREF op (maybe with a few
+ * additional ops left in too).
+ *
+ * The caller will have already verified that the first few ops in the
+ * chain following 'start' indicate a multideref candidate, and will have
+ * set 'orig_o' to the point further on in the chain where the first index
+ * expression (if any) begins. 'orig_action' specifies what type of
+ * beginning has already been determined by the ops between start..orig_o
+ * (e.g. $lex_ary[], $pkg_ary->{}, expr->[], etc).
+ *
+ * 'hints' contains any hints flags that need adding (currently just
+ * OPpHINT_STRICT_REFS) as found in any rv2av/hv skipped by the caller.
+ */
+
+void
+S_maybe_multideref(pTHX_ OP *start, OP *orig_o, UV orig_action, U8 hints)
+{
+ dVAR;
+ int pass;
+ UNOP_AUX_item *arg_buf = NULL;
+ bool reset_start_targ = FALSE; /* start->op_targ needs zeroing */
+ int index_skip = -1; /* don't output index arg on this action */
+
+ /* similar to regex compiling, do two passes; the first pass
+ * determines whether the op chain is convertible and calculates the
+ * buffer size; the second pass populates the buffer and makes any
+ * changes necessary to ops (such as moving consts to the pad on
+ * threaded builds)
+ */
+ for (pass = 0; pass < 2; pass++) {
+ OP *o = orig_o;
+ UV action = orig_action;
+ OP *first_elem_op = NULL; /* first seen aelem/helem */
+ OP *top_op = NULL; /* highest [ah]elem/exists/del/rv2[ah]v */
+ int action_count = 0; /* number of actions seen so far */
+ int action_ix = 0; /* action_count % (actions per IV) */
+ 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? */
+ UNOP_AUX_item *arg = arg_buf;
+ UNOP_AUX_item *action_ptr = arg_buf;
+
+ if (pass)
+ action_ptr->uv = 0;
+ arg++;
+
+ switch (action) {
+ case MDEREF_HV_gvsv_vivify_rv2hv_helem:
+ case MDEREF_HV_gvhv_helem:
+ next_is_hash = TRUE;
+ /* FALLTHROUGH */
+ case MDEREF_AV_gvsv_vivify_rv2av_aelem:
+ case MDEREF_AV_gvav_aelem:
+ if (pass) {
+#ifdef USE_ITHREADS
+ arg->pad_offset = cPADOPx(start)->op_padix;
+ /* stop it being swiped when nulled */
+ cPADOPx(start)->op_padix = 0;
+#else
+ arg->sv = cSVOPx(start)->op_sv;
+ cSVOPx(start)->op_sv = NULL;
+#endif
+ }
+ arg++;
+ break;
+
+ case MDEREF_HV_padhv_helem:
+ case MDEREF_HV_padsv_vivify_rv2hv_helem:
+ next_is_hash = TRUE;
+ /* FALLTHROUGH */
+ case MDEREF_AV_padav_aelem:
+ case MDEREF_AV_padsv_vivify_rv2av_aelem:
+ if (pass) {
+ arg->pad_offset = start->op_targ;
+ /* we skip setting op_targ = 0 for now, since the intact
+ * OP_PADXV is needed by S_check_hash_fields_and_hekify */
+ reset_start_targ = TRUE;
+ }
+ arg++;
+ break;
+
+ case MDEREF_HV_pop_rv2hv_helem:
+ next_is_hash = TRUE;
+ /* FALLTHROUGH */
+ case MDEREF_AV_pop_rv2av_aelem:
+ break;
+
+ default:
+ assert(0);
+ return;
+ }
+
+ while (!is_last) {
+ /* look for another (rv2av/hv; get index;
+ * aelem/helem/exists/delele) sequence */
+
+ IV iv;
+ OP *kid;
+ bool is_deref;
+ bool ok;
+ UV index_type = MDEREF_INDEX_none;
+
+ if (action_count) {
+ /* if this is not the first lookup, consume the rv2av/hv */
+
+ /* for N levels of aggregate lookup, we normally expect
+ * that the first N-1 [ah]elem ops will be flagged as
+ * /DEREF (so they autovivifiy if necessary), and the last
+ * lookup op not to be.
+ * For other things (like @{$h{k1}{k2}}) extra scope or
+ * leave ops can appear, so abandon the effort in that
+ * case */
+ if (o->op_type != OP_RV2AV && o->op_type != OP_RV2HV)
+ return;
+
+ /* rv2av or rv2hv sKR/1 */
+
+ assert(!(o->op_flags & ~(OPf_WANT|OPf_KIDS|OPf_PARENS
+ |OPf_REF|OPf_MOD|OPf_SPECIAL)));
+ if (o->op_flags != (OPf_WANT_SCALAR|OPf_KIDS|OPf_REF))
+ return;
+
+ /* at this point, we wouldn't expect any of these
+ * possible private flags:
+ * OPpMAYBE_LVSUB, OPpOUR_INTRO, OPpLVAL_INTRO
+ * OPpTRUEBOOL, OPpMAYBE_TRUEBOOL (rv2hv only)
+ */
+ assert(!(o->op_private &
+ ~(OPpHINT_STRICT_REFS|OPpARG1_MASK|OPpSLICEWARNING)));
+
+ hints = (o->op_private & OPpHINT_STRICT_REFS);
+
+ /* make sure the type of the previous /DEREF matches the
+ * type of the next lookup */
+ assert(o->op_type == (next_is_hash ? OP_RV2HV : OP_RV2AV));
+ top_op = o;
+
+ action = next_is_hash
+ ? MDEREF_HV_vivify_rv2hv_helem
+ : MDEREF_AV_vivify_rv2av_aelem;
+ o = o->op_next;
+ }
+
+ /* if this is the second pass, and we're at the depth where
+ * previously we encountered a non-simple index expression,
+ * stop processing the index at this point */
+ if (action_count != index_skip) {
+
+ /* look for one or more simple ops that return an array
+ * index or hash key */
+
+ switch (o->op_type) {
+ case OP_PADSV:
+ /* it may be a lexical var index */
+ assert(!(o->op_flags & ~(OPf_WANT|OPf_PARENS
+ |OPf_REF|OPf_MOD|OPf_SPECIAL)));
+ assert(!(o->op_private &
+ ~(OPpPAD_STATE|OPpDEREF|OPpLVAL_INTRO)));
+
+ if ( o->op_flags == OPf_WANT_SCALAR
+ && o->op_private == 0)
+ {
+ if (pass)
+ arg->pad_offset = o->op_targ;
+ arg++;
+ index_type = MDEREF_INDEX_padsv;
+ o = o->op_next;
+ }
+ break;
+
+ case OP_CONST:
+ if (next_is_hash) {
+ /* it's a constant hash index */
+ if (!(SvFLAGS(cSVOPo_sv) & (SVf_IOK|SVf_NOK|SVf_POK)))
+ /* "use constant foo => FOO; $h{+foo}" for
+ * some weird FOO, can leave you with constants
+ * that aren't simple strings. It's not worth
+ * the extra hassle for those edge cases */
+ break;
+
+ if (pass) {
+ UNOP *rop = NULL;
+ OP * helem_op = o->op_next;
+
+ assert( helem_op->op_type == OP_HELEM
+ || helem_op->op_type == OP_NULL);
+ if (helem_op->op_type == OP_HELEM) {
+ rop = (UNOP*)(((BINOP*)helem_op)->op_first);
+ if ( helem_op->op_private & OPpLVAL_INTRO
+ || rop->op_type != OP_RV2HV
+ )
+ rop = NULL;
+ }
+ S_check_hash_fields_and_hekify(aTHX_ rop, cSVOPo);
+
+#ifdef USE_ITHREADS
+ /* Relocate sv to the pad for thread safety */
+ op_relocate_sv(&cSVOPo->op_sv, &o->op_targ);
+ arg->pad_offset = o->op_targ;
+ o->op_targ = 0;
+#else
+ arg->sv = cSVOPx_sv(o);
+#endif
+ }
+ }
+ else {
+ /* it's a constant array index */
+ SV *ix_sv = cSVOPo->op_sv;
+ if (UNLIKELY(SvROK(ix_sv) && !SvGAMAGIC(ix_sv)
+ && ckWARN(WARN_MISC)))
+ Perl_warner(aTHX_ packWARN(WARN_MISC),
+ "Use of reference \"%"SVf"\" as array index",
+ SVfARG(ix_sv));
+ iv = SvIV(ix_sv);
+
+ if ( action_count == 0
+ && iv >= -128
+ && iv <= 127
+ && ( action == MDEREF_AV_padav_aelem
+ || action == MDEREF_AV_gvav_aelem)
+ )
+ maybe_aelemfast = TRUE;
+
+ if (pass) {
+ arg->iv = iv;
+ SvREFCNT_dec_NN(cSVOPo->op_sv);
+ }
+ }
+ if (pass)
+ /* we've taken ownership of the SV */
+ cSVOPo->op_sv = NULL;
+ arg++;
+ index_type = MDEREF_INDEX_const;
+ o = o->op_next;
+ break;
+
+ case OP_GV:
+ /* it may be a package var index */
+
+ assert(!(o->op_flags & ~(OPf_WANT)));
+ assert(!(o->op_private & ~(OPpEARLY_CV)));
+ if ( o->op_flags != OPf_WANT_SCALAR
+ || o->op_private != 0
+ )
+ break;
+
+ kid = o->op_next;
+ if (kid->op_type != OP_RV2SV)
+ break;
+
+ assert(!(kid->op_flags &
+ ~(OPf_WANT|OPf_KIDS|OPf_MOD|OPf_REF|OPf_SPECIAL)));
+ assert(!(kid->op_private &
+ ~(OPpARG1_MASK
+ |OPpHINT_STRICT_REFS|OPpOUR_INTRO
+ |OPpDEREF|OPpLVAL_INTRO)));
+ if( kid->op_flags != (OPf_WANT_SCALAR|OPf_KIDS)
+ || (kid->op_private & ~(OPpARG1_MASK|HINT_STRICT_REFS))
+ )
+ break;
+
+ if (pass) {
+#ifdef USE_ITHREADS
+ arg->pad_offset = cPADOPx(o)->op_padix;
+ /* stop it being swiped when nulled */
+ cPADOPx(o)->op_padix = 0;
+#else
+ arg->sv = cSVOPx(o)->op_sv;
+ cSVOPo->op_sv = NULL;
+#endif
+ }
+ arg++;
+ index_type = MDEREF_INDEX_gvsv;
+ o = kid->op_next;
+ break;
+
+ } /* switch */
+ } /* action_count != index_skip */
+
+ 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
+ * an nulled [ah]elem followed by a delete or exists;
+ * * found a more complex expression, so something other
+ * than the above follows.
+ */
+
+ /* possibly an optimised away [ah]elem (where op_next is
+ * exists or delete) */
+ if (o->op_type == OP_NULL)
+ o = o->op_next;
+
+ /* at this point we're looking for an OP_AELEM, OP_HELEM,
+ * OP_EXISTS or OP_DELETE */
+
+ /* if something like arybase (a.k.a $[ ) is in scope,
+ * abandon optimisation attempt */
+ if (o->op_type == OP_AELEM && PL_check[OP_AELEM] != Perl_ck_null)
+ return;
+
+ 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
+ * lookup, it *must* have OPpDEREF_AV/HV, but not many other
+ * flags; if it's the last, then it mustn't have
+ * OPpDEREF_AV/HV, but may have lots of other flags, like
+ * OPpLVAL_INTRO etc
+ */
+
+ if ( index_type == MDEREF_INDEX_none
+ || ( o->op_type != OP_AELEM && o->op_type != OP_HELEM
+ && o->op_type != OP_EXISTS && o->op_type != OP_DELETE)
+ )
+ ok = FALSE;
+ else {
+ /* we have aelem/helem/exists/delete with valid simple index */
+
+ is_deref = (o->op_type == OP_AELEM || o->op_type == OP_HELEM)
+ && ( (o->op_private & OPpDEREF) == OPpDEREF_AV
+ || (o->op_private & OPpDEREF) == OPpDEREF_HV);
+
+ if (is_deref) {
+ assert(!(o->op_flags & ~(OPf_WANT|OPf_KIDS|OPf_MOD)));
+ assert(!(o->op_private & ~(OPpARG2_MASK|OPpDEREF)));
+
+ ok = o->op_flags == (OPf_WANT_SCALAR|OPf_KIDS|OPf_MOD)
+ && !(o->op_private & ~(OPpDEREF|OPpARG2_MASK));
+ }
+ else if (o->op_type == OP_EXISTS) {
+ assert(!(o->op_flags & ~(OPf_WANT|OPf_KIDS|OPf_PARENS
+ |OPf_REF|OPf_MOD|OPf_SPECIAL)));
+ assert(!(o->op_private & ~(OPpARG1_MASK|OPpEXISTS_SUB)));
+ ok = !(o->op_private & ~OPpARG1_MASK);
+ }
+ else if (o->op_type == OP_DELETE) {
+ assert(!(o->op_flags & ~(OPf_WANT|OPf_KIDS|OPf_PARENS
+ |OPf_REF|OPf_MOD|OPf_SPECIAL)));
+ assert(!(o->op_private &
+ ~(OPpARG1_MASK|OPpSLICE|OPpLVAL_INTRO)));
+ /* don't handle slices or 'local delete'; the latter
+ * is fairly rare, and has a complex runtime */
+ ok = !(o->op_private & ~OPpARG1_MASK);
+ if (OP_TYPE_IS_OR_WAS(cUNOPo->op_first, OP_AELEM))
+ /* skip handling run-tome error */
+ ok = (ok && cBOOL(o->op_flags & OPf_SPECIAL));
+ }
+ else {
+ assert(o->op_type == OP_AELEM || o->op_type == OP_HELEM);
+ assert(!(o->op_flags & ~(OPf_WANT|OPf_KIDS|OPf_MOD
+ |OPf_PARENS|OPf_REF|OPf_SPECIAL)));
+ assert(!(o->op_private & ~(OPpARG2_MASK|OPpMAYBE_LVSUB
+ |OPpLVAL_DEFER|OPpDEREF|OPpLVAL_INTRO)));
+ ok = (o->op_private & OPpDEREF) != OPpDEREF_SV;
+ }
+ }
+
+ if (ok) {
+ if (!first_elem_op)
+ first_elem_op = o;
+ top_op = o;
+ if (is_deref) {
+ next_is_hash = cBOOL((o->op_private & OPpDEREF) == OPpDEREF_HV);
+ o = o->op_next;
+ }
+ else {
+ is_last = TRUE;
+ action |= MDEREF_FLAG_last;
+ }
+ }
+ else {
+ /* at this point we have something that started
+ * promisingly enough (with rv2av or whatever), but failed
+ * to find a simple index followed by an
+ * aelem/helem/exists/delete. If this is the first action,
+ * give up; but if we've already seen at least one
+ * aelem/helem, then keep them and add a new action with
+ * MDEREF_INDEX_none, which causes it to do the vivify
+ * from the end of the previous lookup, and do the deref,
+ * but stop at that point. So $a[0][expr] will do one
+ * av_fetch, vivify and deref, then continue executing at
+ * expr */
+ if (!action_count)
+ return;
+ is_last = TRUE;
+ index_skip = action_count;
+ action |= MDEREF_FLAG_last;
+ }
+
+ if (pass)
+ action_ptr->uv |= (action << (action_ix * MDEREF_SHIFT));
+ action_ix++;
+ action_count++;
+ /* if there's no space for the next action, create 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;
+ arg++;
+ action_ix = 0;
+ }
+ } /* while !is_last */
+
+ /* success! */
+
+ if (pass) {
+ OP *mderef;
+ OP *p;
+
+ mderef = newUNOP_AUX(OP_MULTIDEREF, 0, NULL, arg_buf);
+ if (index_skip == -1) {
+ mderef->op_flags = o->op_flags
+ & (OPf_WANT|OPf_MOD|(next_is_hash ? OPf_SPECIAL : 0));
+ if (o->op_type == OP_EXISTS)
+ mderef->op_private = OPpMULTIDEREF_EXISTS;
+ else if (o->op_type == OP_DELETE)
+ mderef->op_private = OPpMULTIDEREF_DELETE;
+ else
+ mderef->op_private = o->op_private
+ & (OPpMAYBE_LVSUB|OPpLVAL_DEFER|OPpLVAL_INTRO);
+ }
+ /* accumulate strictness from every level (although I don't think
+ * they can actually vary) */
+ mderef->op_private |= hints;
+
+ /* integrate the new multideref op into the optree and the
+ * op_next chain.
+ *
+ * In general an op like aelem or helem has two child
+ * sub-trees: the aggregate expression (a_expr) and the
+ * index expression (i_expr):
+ *
+ * aelem
+ * |
+ * a_expr - i_expr
+ *
+ * The a_expr returns an AV or HV, while the i-expr returns an
+ * index. In general a multideref replaces most or all of a
+ * multi-level tree, e.g.
+ *
+ * exists
+ * |
+ * ex-aelem
+ * |
+ * rv2av - i_expr1
+ * |
+ * helem
+ * |
+ * rv2hv - i_expr2
+ * |
+ * aelem
+ * |
+ * a_expr - i_expr3
+ *
+ * With multideref, all the i_exprs will be simple vars or
+ * constants, except that i_expr1 may be arbitrary in the case
+ * of MDEREF_INDEX_none.
+ *
+ * The bottom-most a_expr will be either:
+ * 1) a simple var (so padXv or gv+rv2Xv);
+ * 2) a simple scalar var dereferenced (e.g. $r->[0]):
+ * so a simple var with an extra rv2Xv;
+ * 3) or an arbitrary expression.
+ *
+ * 'start', the first op in the execution chain, will point to
+ * 1),2): the padXv or gv op;
+ * 3): the rv2Xv which forms the last op in the a_expr
+ * execution chain, and the top-most op in the a_expr
+ * subtree.
+ *
+ * For all cases, the 'start' node is no longer required,
+ * but we can't free it since one or more external nodes
+ * may point to it. E.g. consider
+ * $h{foo} = $a ? $b : $c
+ * Here, both the op_next and op_other branches of the
+ * cond_expr point to the gv[*h] of the hash expression, so
+ * we can't free the 'start' op.
+ *
+ * For expr->[...], we need to save the subtree containing the
+ * expression; for the other cases, we just need to save the
+ * start node.
+ * So in all cases, we null the start op and keep it around by
+ * making it the child of the multideref op; for the expr->
+ * case, the expr will be a subtree of the start node.
+ *
+ * So in the simple 1,2 case the optree above changes to
+ *
+ * ex-exists
+ * |
+ * multideref
+ * |
+ * ex-gv (or ex-padxv)
+ *
+ * with the op_next chain being
+ *
+ * -> ex-gv -> multideref -> op-following-ex-exists ->
+ *
+ * In the 3 case, we have
+ *
+ * ex-exists
+ * |
+ * multideref
+ * |
+ * ex-rv2xv
+ * |
+ * rest-of-a_expr
+ * subtree
+ *
+ * and
+ *
+ * -> rest-of-a_expr subtree ->
+ * ex-rv2xv -> multideref -> op-following-ex-exists ->
+ *
+ *
+ * Where the last i_expr is non-simple (i.e. MDEREF_INDEX_none,
+ * e.g. $a[0]{foo}[$x+1], the next rv2xv is nulled and the
+ * multideref attached as the child, e.g.
+ *
+ * exists
+ * |
+ * ex-aelem
+ * |
+ * ex-rv2av - i_expr1
+ * |
+ * multideref
+ * |
+ * ex-whatever
+ *
+ */
+
+ /* if we free this op, don't free the pad entry */
+ if (reset_start_targ)
+ start->op_targ = 0;
+
+
+ /* Cut the bit we need to save out of the tree and attach to
+ * the multideref op, then free the rest of the tree */
+
+ /* find parent of node to be detached (for use by splice) */
+ p = first_elem_op;
+ if ( orig_action == MDEREF_AV_pop_rv2av_aelem
+ || orig_action == MDEREF_HV_pop_rv2hv_helem)
+ {
+ /* there is an arbitrary expression preceding us, e.g.
+ * expr->[..]? so we need to save the 'expr' subtree */
+ if (p->op_type == OP_EXISTS || p->op_type == OP_DELETE)
+ p = cUNOPx(p)->op_first;
+ assert( start->op_type == OP_RV2AV
+ || start->op_type == OP_RV2HV);
+ }
+ else {
+ /* either a padXv or rv2Xv+gv, maybe with an ex-Xelem
+ * above for exists/delete. */
+ while ( (p->op_flags & OPf_KIDS)
+ && cUNOPx(p)->op_first != start
+ )
+ p = cUNOPx(p)->op_first;
+ }
+ assert(cUNOPx(p)->op_first == start);
+
+ /* detach from main tree, and re-attach under the multideref */
+ op_sibling_splice(mderef, NULL, 0,
+ op_sibling_splice(p, NULL, 1, NULL));
+ op_null(start);
+
+ start->op_next = mderef;
+
+ mderef->op_next = index_skip == -1 ? o->op_next : o;
+
+ /* excise and free the original tree, and replace with
+ * the multideref op */
+ op_free(op_sibling_splice(top_op, NULL, -1, mderef));
+ op_null(top_op);
+ }
+ else {
+ Size_t size = arg - arg_buf;
+
+ if (maybe_aelemfast && action_count == 1)
+ return;
+
+ arg_buf = (UNOP_AUX_item*)PerlMemShared_malloc(
+ sizeof(UNOP_AUX_item) * (size + 1));
+ /* for dumping etc: store the length in a hidden first slot;
+ * we set the op_aux pointer to the second slot */
+ arg_buf->uv = size;
+ arg_buf++;
+ }
+ } /* for (pass = ...) */
+}
+
+
+
/* mechanism for deferring recursion in rpeep() */
#define MAX_DEFERRED 4
@@ -12125,6 +12831,183 @@ Perl_rpeep(pTHX_ OP *o)
o->op_opt = 1;
PL_op = o;
+ /* look for a series of 1 or more aggregate derefs, e.g.
+ * $a[1]{foo}[$i]{$k}
+ * and replace with a single OP_MULTIDEREF op.
+ * Each index must be either a const, or a simple variable,
+ *
+ * First, look for likely combinations of starting ops,
+ * corresponding to (global and lexical variants of)
+ * $a[...] $h{...}
+ * $r->[...] $r->{...}
+ * (preceding expression)->[...]
+ * (preceding expression)->{...}
+ * and if so, call maybe_multideref() to do a full inspection
+ * of the op chain and if appropriate, replace with an
+ * OP_MULTIDEREF
+ */
+ {
+ UV action;
+ OP *o2 = o;
+ U8 hints = 0;
+
+ switch (o2->op_type) {
+ case OP_GV:
+ /* $pkg[..] : gv[*pkg]
+ * $pkg->[...]: gv[*pkg]; rv2sv sKM/DREFAV */
+
+ /* Fail if there are new op flag combinations that we're
+ * not aware of, rather than:
+ * * silently failing to optimise, or
+ * * silently optimising the flag away.
+ * If this assert starts failing, examine what new flag
+ * has been added to the op, and decide whether the
+ * optimisation should still occur with that flag, then
+ * update the code accordingly. This applies to all the
+ * other asserts in the block of code too.
+ */
+ assert(!(o2->op_flags & ~(OPf_WANT|OPf_MOD)));
+ assert(!(o2->op_private & ~OPpEARLY_CV));
+
+ o2 = o2->op_next;
+
+ if (o2->op_type == OP_RV2AV) {
+ action = MDEREF_AV_gvav_aelem;
+ goto do_deref;
+ }
+
+ if (o2->op_type == OP_RV2HV) {
+ action = MDEREF_HV_gvhv_helem;
+ goto do_deref;
+ }
+
+ if (o2->op_type != OP_RV2SV)
+ break;
+
+ /* at this point we've seen gv,rv2sv, so the only valid
+ * construct left is $pkg->[] or $pkg->{} */
+
+ assert(!(o2->op_flags & OPf_STACKED));
+ if ((o2->op_flags & (OPf_WANT|OPf_REF|OPf_MOD|OPf_SPECIAL))
+ != (OPf_WANT_SCALAR|OPf_MOD))
+ break;
+
+ assert(!(o2->op_private & ~(OPpARG1_MASK|HINT_STRICT_REFS
+ |OPpOUR_INTRO|OPpDEREF|OPpLVAL_INTRO)));
+ if (o2->op_private & (OPpOUR_INTRO|OPpLVAL_INTRO))
+ break;
+ if ( (o2->op_private & OPpDEREF) != OPpDEREF_AV
+ && (o2->op_private & OPpDEREF) != OPpDEREF_HV)
+ break;
+
+ o2 = o2->op_next;
+ if (o2->op_type == OP_RV2AV) {
+ action = MDEREF_AV_gvsv_vivify_rv2av_aelem;
+ goto do_deref;
+ }
+ if (o2->op_type == OP_RV2HV) {
+ action = MDEREF_HV_gvsv_vivify_rv2hv_helem;
+ goto do_deref;
+ }
+ break;
+
+ case OP_PADSV:
+ /* $lex->[...]: padsv[$lex] sM/DREFAV */
+
+ assert(!(o2->op_flags &
+ ~(OPf_WANT|OPf_PARENS|OPf_REF|OPf_MOD|OPf_SPECIAL)));
+ if ((o2->op_flags &
+ (OPf_WANT|OPf_REF|OPf_MOD|OPf_SPECIAL))
+ != (OPf_WANT_SCALAR|OPf_MOD))
+ break;
+
+ assert(!(o2->op_private &
+ ~(OPpPAD_STATE|OPpDEREF|OPpLVAL_INTRO)));
+ /* skip if state or intro, or not a deref */
+ if ( o2->op_private != OPpDEREF_AV
+ && o2->op_private != OPpDEREF_HV)
+ break;
+
+ o2 = o2->op_next;
+ if (o2->op_type == OP_RV2AV) {
+ action = MDEREF_AV_padsv_vivify_rv2av_aelem;
+ goto do_deref;
+ }
+ if (o2->op_type == OP_RV2HV) {
+ action = MDEREF_HV_padsv_vivify_rv2hv_helem;
+ goto do_deref;
+ }
+ break;
+
+ case OP_PADAV:
+ case OP_PADHV:
+ /* $lex[..]: padav[@lex:1,2] sR *
+ * or $lex{..}: padhv[%lex:1,2] sR */
+ assert(!(o2->op_flags & ~(OPf_WANT|OPf_MOD|OPf_PARENS|
+ OPf_REF|OPf_SPECIAL)));
+ if ((o2->op_flags &
+ (OPf_WANT|OPf_REF|OPf_MOD|OPf_SPECIAL))
+ != (OPf_WANT_SCALAR|OPf_REF))
+ break;
+ if (o2->op_flags != (OPf_WANT_SCALAR|OPf_REF))
+ break;
+ /* OPf_PARENS isn't currently used in this case;
+ * if that changes, let us know! */
+ assert(!(o2->op_flags & OPf_PARENS));
+
+ /* at this point, we wouldn't expect any of the remaining
+ * possible private flags:
+ * OPpPAD_STATE, OPpLVAL_INTRO, OPpTRUEBOOL,
+ * OPpMAYBE_TRUEBOOL, OPpMAYBE_LVSUB
+ *
+ * OPpSLICEWARNING shouldn't affect runtime
+ */
+ assert(!(o2->op_private & ~(OPpSLICEWARNING)));
+
+ action = o2->op_type == OP_PADAV
+ ? MDEREF_AV_padav_aelem
+ : MDEREF_HV_padhv_helem;
+ o2 = o2->op_next;
+ S_maybe_multideref(aTHX_ o, o2, action, 0);
+ break;
+
+
+ case OP_RV2AV:
+ case OP_RV2HV:
+ action = o2->op_type == OP_RV2AV
+ ? MDEREF_AV_pop_rv2av_aelem
+ : MDEREF_HV_pop_rv2hv_helem;
+ /* FALLTHROUGH */
+ do_deref:
+ /* (expr)->[...]: rv2av sKR/1;
+ * (expr)->{...}: rv2hv sKR/1; */
+
+ assert(o2->op_type == OP_RV2AV || o2->op_type == OP_RV2HV);
+
+ assert(!(o2->op_flags & ~(OPf_WANT|OPf_KIDS|OPf_PARENS
+ |OPf_REF|OPf_MOD|OPf_STACKED|OPf_SPECIAL)));
+ if (o2->op_flags != (OPf_WANT_SCALAR|OPf_KIDS|OPf_REF))
+ break;
+
+ /* at this point, we wouldn't expect any of these
+ * possible private flags:
+ * OPpMAYBE_LVSUB, OPpOUR_INTRO, OPpLVAL_INTRO
+ * OPpTRUEBOOL, OPpMAYBE_TRUEBOOL, (rv2hv only)
+ */
+ assert(!(o2->op_private &
+ ~(OPpHINT_STRICT_REFS|OPpARG1_MASK|OPpSLICEWARNING)));
+ hints |= (o2->op_private & OPpHINT_STRICT_REFS);
+
+ o2 = o2->op_next;
+
+ S_maybe_multideref(aTHX_ o, o2, action, hints);
+ break;
+
+ default:
+ break;
+ }
+ }
+
switch (o->op_type) {
case OP_DBSTATE:
diff --git a/op.h b/op.h
index 61a382fb76..9e60beb64d 100644
--- a/op.h
+++ b/op.h
@@ -124,9 +124,10 @@ Deprecated. Use C<GIMME_V> instead.
/* On OP_SMARTMATCH, an implicit smartmatch */
/* On OP_ANONHASH and OP_ANONLIST, create a
reference to the new anon hash or array */
- /* On OP_HELEM and OP_HSLICE, localization will be followed
- by assignment, so do not wipe the target if it is special
- (e.g. a glob or a magic SV) */
+ /* On OP_HELEM, OP_MULTIDEREF and OP_HSLICE,
+ localization will be followed by assignment,
+ so do not wipe the target if it is special
+ (e.g. a glob or a magic SV) */
/* On OP_MATCH, OP_SUBST & OP_TRANS, the
operand of a logical or conditional
that was optimised away, so it should
@@ -177,6 +178,14 @@ typedef union {
UV uv;
} UNOP_AUX_item;
+#ifdef USE_ITHREADS
+# define UNOP_AUX_item_sv(item) PAD_SVl((item)->pad_offset);
+#else
+# define UNOP_AUX_item_sv(item) ((item)->sv);
+#endif
+
+
+
struct op {
BASEOP
@@ -988,6 +997,47 @@ Sets the sibling of o to sib
# define OP_CHECK_MUTEX_TERM NOOP
#endif
+
+/* Stuff for OP_MULTDEREF/pp_multideref. */
+
+/* actions */
+
+/* Load another word of actions/flag bits. Must be 0 */
+#define MDEREF_reload 0
+
+#define MDEREF_AV_pop_rv2av_aelem 1
+#define MDEREF_AV_gvsv_vivify_rv2av_aelem 2
+#define MDEREF_AV_padsv_vivify_rv2av_aelem 3
+#define MDEREF_AV_vivify_rv2av_aelem 4
+#define MDEREF_AV_padav_aelem 5
+#define MDEREF_AV_gvav_aelem 6
+
+#define MDEREF_HV_pop_rv2hv_helem 8
+#define MDEREF_HV_gvsv_vivify_rv2hv_helem 9
+#define MDEREF_HV_padsv_vivify_rv2hv_helem 10
+#define MDEREF_HV_vivify_rv2hv_helem 11
+#define MDEREF_HV_padhv_helem 12
+#define MDEREF_HV_gvhv_helem 13
+
+#define MDEREF_ACTION_MASK 0xf
+
+/* key / index type */
+
+#define MDEREF_INDEX_none 0x00 /* run external ops to generate index */
+#define MDEREF_INDEX_const 0x10 /* index is const PV/UV */
+#define MDEREF_INDEX_padsv 0x20 /* index is lexical var */
+#define MDEREF_INDEX_gvsv 0x30 /* index is GV */
+
+#define MDEREF_INDEX_MASK 0x30
+
+/* bit flags */
+
+#define MDEREF_FLAG_last 0x40 /* the last [ah]elem; PL_op flags apply */
+
+#define MDEREF_MASK 0x7F
+#define MDEREF_SHIFT 7
+
+
/*
* Local variables:
* c-indentation-style: bsd
diff --git a/opcode.h b/opcode.h
index e67318ffc8..4266c49cf6 100644
--- a/opcode.h
+++ b/opcode.h
@@ -293,6 +293,7 @@ EXTCONST char* const PL_op_name[] = {
"helem",
"hslice",
"kvhslice",
+ "multideref",
"unpack",
"pack",
"split",
@@ -687,6 +688,7 @@ EXTCONST char* const PL_op_desc[] = {
"hash element",
"hash slice",
"key/value hash slice",
+ "array or hash lookup",
"unpack",
"pack",
"split",
@@ -1095,6 +1097,7 @@ EXT Perl_ppaddr_t PL_ppaddr[] /* or perlvars.h */
Perl_pp_helem,
Perl_pp_hslice,
Perl_pp_kvhslice,
+ Perl_pp_multideref,
Perl_pp_unpack,
Perl_pp_pack,
Perl_pp_split,
@@ -1499,6 +1502,7 @@ EXT Perl_check_t PL_check[] /* or perlvars.h */
Perl_ck_null, /* helem */
Perl_ck_null, /* hslice */
Perl_ck_null, /* kvhslice */
+ Perl_ck_null, /* multideref */
Perl_ck_fun, /* unpack */
Perl_ck_fun, /* pack */
Perl_ck_split, /* split */
@@ -1897,6 +1901,7 @@ EXTCONST U32 PL_opargs[] = {
0x00014204, /* helem */
0x00024401, /* hslice */
0x00024401, /* kvhslice */
+ 0x00000f44, /* multideref */
0x00091480, /* unpack */
0x0002140f, /* pack */
0x00111418, /* split */
@@ -2190,6 +2195,7 @@ END_EXTERN_C
#define OPpFT_AFTER_t 0x10
#define OPpLVREF_AV 0x10
#define OPpMAYBE_TRUEBOOL 0x10
+#define OPpMULTIDEREF_EXISTS 0x10
#define OPpOPEN_IN_RAW 0x10
#define OPpSORT_DESCEND 0x10
#define OPpSUBSTR_REPL_FIRST 0x10
@@ -2200,6 +2206,7 @@ END_EXTERN_C
#define OPpHUSH_VMSISH 0x20
#define OPpLVREF_HV 0x20
#define OPpMAY_RETURN_CONSTANT 0x20
+#define OPpMULTIDEREF_DELETE 0x20
#define OPpOPEN_IN_CRLF 0x20
#define OPpSORT_QSORT 0x20
#define OPpTRANS_COMPLEMENT 0x20
@@ -2282,6 +2289,7 @@ EXTCONST char PL_op_private_labels[] = {
'D','B','G','\0',
'D','E','F','\0',
'D','E','L','\0',
+ 'D','E','L','E','T','E','\0',
'D','E','R','E','F','1','\0',
'D','E','R','E','F','2','\0',
'D','E','S','C','\0',
@@ -2292,6 +2300,7 @@ EXTCONST char PL_op_private_labels[] = {
'E','A','R','L','Y','C','V','\0',
'E','L','E','M','\0',
'E','N','T','E','R','E','D','\0',
+ 'E','X','I','S','T','S','\0',
'F','A','K','E','\0',
'F','T','A','C','C','E','S','S','\0',
'F','T','A','F','T','E','R','t','\0',
@@ -2366,8 +2375,8 @@ EXTCONST I16 PL_op_private_bitfields[] = {
0, 8, -1,
0, 8, -1,
0, 8, -1,
- 4, -1, 1, 130, 2, 137, 3, 144, -1,
- 4, -1, 0, 481, 1, 26, 2, 250, 3, 83, -1,
+ 4, -1, 1, 137, 2, 144, 3, 151, -1,
+ 4, -1, 0, 495, 1, 26, 2, 264, 3, 83, -1,
};
@@ -2521,11 +2530,12 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = {
94, /* helem */
99, /* hslice */
102, /* kvhslice */
+ 116, /* multideref */
48, /* unpack */
48, /* pack */
- 116, /* split */
+ 123, /* split */
48, /* join */
- 119, /* list */
+ 126, /* list */
12, /* lslice */
48, /* anonlist */
48, /* anonhash */
@@ -2534,48 +2544,48 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = {
0, /* pop */
0, /* shift */
79, /* unshift */
- 121, /* sort */
- 128, /* reverse */
- 130, /* grepstart */
- 131, /* grepwhile */
- 130, /* mapstart */
- 131, /* mapwhile */
+ 128, /* sort */
+ 135, /* reverse */
+ 137, /* grepstart */
+ 138, /* grepwhile */
+ 137, /* mapstart */
+ 138, /* mapwhile */
0, /* range */
- 133, /* flip */
- 133, /* flop */
+ 140, /* flip */
+ 140, /* flop */
0, /* and */
0, /* or */
12, /* xor */
0, /* dor */
- 135, /* cond_expr */
+ 142, /* cond_expr */
0, /* andassign */
0, /* orassign */
0, /* dorassign */
0, /* method */
- 137, /* entersub */
- 144, /* leavesub */
- 144, /* leavesublv */
- 146, /* caller */
+ 144, /* entersub */
+ 151, /* leavesub */
+ 151, /* leavesublv */
+ 153, /* caller */
48, /* warn */
48, /* die */
48, /* reset */
-1, /* lineseq */
- 148, /* nextstate */
- 148, /* dbstate */
+ 155, /* nextstate */
+ 155, /* dbstate */
-1, /* unstack */
-1, /* enter */
- 149, /* leave */
+ 156, /* leave */
-1, /* scope */
- 151, /* enteriter */
- 155, /* iter */
+ 158, /* enteriter */
+ 162, /* iter */
-1, /* enterloop */
- 156, /* leaveloop */
+ 163, /* leaveloop */
-1, /* return */
- 158, /* last */
- 158, /* next */
- 158, /* redo */
- 158, /* dump */
- 158, /* goto */
+ 165, /* last */
+ 165, /* next */
+ 165, /* redo */
+ 165, /* dump */
+ 165, /* goto */
48, /* exit */
0, /* method_named */
0, /* method_super */
@@ -2587,7 +2597,7 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = {
0, /* leavewhen */
-1, /* break */
-1, /* continue */
- 160, /* open */
+ 167, /* open */
48, /* close */
48, /* pipe_op */
48, /* fileno */
@@ -2603,7 +2613,7 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = {
48, /* getc */
48, /* read */
48, /* enterwrite */
- 144, /* leavewrite */
+ 151, /* leavewrite */
-1, /* prtf */
-1, /* print */
-1, /* say */
@@ -2633,33 +2643,33 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = {
0, /* getpeername */
0, /* lstat */
0, /* stat */
- 165, /* ftrread */
- 165, /* ftrwrite */
- 165, /* ftrexec */
- 165, /* fteread */
- 165, /* ftewrite */
- 165, /* fteexec */
- 170, /* ftis */
- 170, /* ftsize */
- 170, /* ftmtime */
- 170, /* ftatime */
- 170, /* ftctime */
- 170, /* ftrowned */
- 170, /* fteowned */
- 170, /* ftzero */
- 170, /* ftsock */
- 170, /* ftchr */
- 170, /* ftblk */
- 170, /* ftfile */
- 170, /* ftdir */
- 170, /* ftpipe */
- 170, /* ftsuid */
- 170, /* ftsgid */
- 170, /* ftsvtx */
- 170, /* ftlink */
- 170, /* fttty */
- 170, /* fttext */
- 170, /* ftbinary */
+ 172, /* ftrread */
+ 172, /* ftrwrite */
+ 172, /* ftrexec */
+ 172, /* fteread */
+ 172, /* ftewrite */
+ 172, /* fteexec */
+ 177, /* ftis */
+ 177, /* ftsize */
+ 177, /* ftmtime */
+ 177, /* ftatime */
+ 177, /* ftctime */
+ 177, /* ftrowned */
+ 177, /* fteowned */
+ 177, /* ftzero */
+ 177, /* ftsock */
+ 177, /* ftchr */
+ 177, /* ftblk */
+ 177, /* ftfile */
+ 177, /* ftdir */
+ 177, /* ftpipe */
+ 177, /* ftsuid */
+ 177, /* ftsgid */
+ 177, /* ftsvtx */
+ 177, /* ftlink */
+ 177, /* fttty */
+ 177, /* fttext */
+ 177, /* ftbinary */
79, /* chdir */
79, /* chown */
72, /* chroot */
@@ -2679,17 +2689,17 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = {
0, /* rewinddir */
0, /* closedir */
-1, /* fork */
- 174, /* wait */
+ 181, /* wait */
79, /* waitpid */
79, /* system */
79, /* exec */
79, /* kill */
- 174, /* getppid */
+ 181, /* getppid */
79, /* getpgrp */
79, /* setpgrp */
79, /* getpriority */
79, /* setpriority */
- 174, /* time */
+ 181, /* time */
-1, /* tms */
0, /* localtime */
48, /* gmtime */
@@ -2709,8 +2719,8 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = {
0, /* require */
0, /* dofile */
-1, /* hintseval */
- 175, /* entereval */
- 144, /* leaveeval */
+ 182, /* entereval */
+ 151, /* leaveeval */
0, /* entertry */
-1, /* leavetry */
0, /* ghbyname */
@@ -2751,17 +2761,17 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = {
0, /* reach */
39, /* rkeys */
0, /* rvalues */
- 181, /* coreargs */
+ 188, /* coreargs */
3, /* runcv */
0, /* fc */
-1, /* padcv */
-1, /* introcv */
-1, /* clonecv */
- 185, /* padrange */
- 187, /* refassign */
- 193, /* lvref */
- 199, /* lvrefslice */
- 200, /* lvavref */
+ 192, /* padrange */
+ 194, /* refassign */
+ 200, /* lvref */
+ 206, /* lvrefslice */
+ 207, /* lvavref */
};
@@ -2781,69 +2791,70 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = {
EXTCONST U16 PL_op_private_bitdefs[] = {
0x0003, /* scalar, prototype, refgen, srefgen, ref, readline, regcmaybe, regcreset, regcomp, chop, schop, defined, undef, study, preinc, i_preinc, predec, i_predec, postinc, i_postinc, postdec, i_postdec, negate, i_negate, not, complement, ucfirst, lcfirst, uc, lc, quotemeta, aeach, akeys, avalues, each, values, pop, shift, range, and, or, dor, andassign, orassign, dorassign, method, method_named, method_super, method_redir, method_redir_super, entergiven, leavegiven, enterwhen, leavewhen, untie, tied, dbmclose, getsockname, getpeername, lstat, stat, readlink, readdir, telldir, rewinddir, closedir, localtime, alarm, require, dofile, entertry, ghbyname, gnbyname, gpbyname, shostent, snetent, sprotoent, sservent, gpwnam, gpwuid, ggrnam, ggrgid, lock, once, reach, rvalues, fc */
- 0x281c, 0x3a19, /* pushmark */
+ 0x29dc, 0x3bd9, /* pushmark */
0x00bd, /* wantarray, runcv */
- 0x03b8, 0x1490, 0x3acc, 0x3588, 0x2be5, /* const */
- 0x281c, 0x2d39, /* gvsv */
- 0x12f5, /* gv */
+ 0x03b8, 0x1570, 0x3c8c, 0x3748, 0x2da5, /* const */
+ 0x29dc, 0x2ef9, /* gvsv */
+ 0x13d5, /* gv */
0x0067, /* gelem, lt, i_lt, gt, i_gt, le, i_le, ge, i_ge, eq, i_eq, ne, i_ne, ncmp, i_ncmp, slt, sgt, sle, sge, seq, sne, scmp, bit_and, bit_xor, bit_or, smartmatch, lslice, xor */
- 0x281c, 0x3a18, 0x0257, /* padsv */
- 0x281c, 0x3a18, 0x290c, 0x3709, /* padav */
- 0x281c, 0x3a18, 0x0534, 0x05d0, 0x290c, 0x3709, /* padhv */
- 0x34d9, /* pushre, qr */
- 0x281c, 0x1598, 0x0256, 0x290c, 0x2b08, 0x3ac4, 0x0003, /* rv2gv */
- 0x281c, 0x2d38, 0x0256, 0x3ac4, 0x0003, /* rv2sv */
- 0x290c, 0x0003, /* av2arylen, pos, keys, rkeys */
- 0x2a7c, 0x0b98, 0x08f4, 0x028c, 0x3c88, 0x3ac4, 0x0003, /* rv2cv */
+ 0x29dc, 0x3bd8, 0x0257, /* padsv */
+ 0x29dc, 0x3bd8, 0x2acc, 0x38c9, /* padav */
+ 0x29dc, 0x3bd8, 0x0534, 0x05d0, 0x2acc, 0x38c9, /* padhv */
+ 0x3699, /* pushre, qr */
+ 0x29dc, 0x1758, 0x0256, 0x2acc, 0x2cc8, 0x3c84, 0x0003, /* rv2gv */
+ 0x29dc, 0x2ef8, 0x0256, 0x3c84, 0x0003, /* rv2sv */
+ 0x2acc, 0x0003, /* av2arylen, pos, keys, rkeys */
+ 0x2c3c, 0x0b98, 0x08f4, 0x028c, 0x3e48, 0x3c84, 0x0003, /* rv2cv */
0x012f, /* bless, glob, sprintf, formline, unpack, pack, join, anonlist, anonhash, splice, warn, die, reset, exit, close, pipe_op, fileno, umask, binmode, tie, dbmopen, sselect, select, getc, read, enterwrite, sysopen, sysseek, sysread, syswrite, eof, tell, seek, truncate, fcntl, ioctl, send, recv, socket, sockpair, bind, connect, listen, accept, shutdown, gsockopt, ssockopt, open_dir, seekdir, gmtime, shmget, shmctl, shmread, shmwrite, msgget, msgctl, msgsnd, msgrcv, semop, semget, semctl, ghbyaddr, gnbyaddr, gpbynumber, gsbyname, gsbyport, syscall */
- 0x2f1c, 0x2e38, 0x22f4, 0x2230, 0x0003, /* backtick */
- 0x34d8, 0x3d31, /* match, subst */
- 0x34d8, 0x0003, /* substcont */
- 0x0c9c, 0x1c18, 0x0834, 0x3d30, 0x384c, 0x1fa8, 0x01e4, 0x0141, /* trans, transr */
+ 0x30dc, 0x2ff8, 0x24b4, 0x23f0, 0x0003, /* backtick */
+ 0x3698, 0x3ef1, /* match, subst */
+ 0x3698, 0x0003, /* substcont */
+ 0x0c9c, 0x1dd8, 0x0834, 0x3ef0, 0x3a0c, 0x2168, 0x01e4, 0x0141, /* trans, transr */
0x0adc, 0x0458, 0x0067, /* sassign */
- 0x0758, 0x290c, 0x0067, /* aassign */
- 0x3d30, 0x0003, /* chomp, schomp, sin, cos, exp, log, sqrt, int, hex, oct, abs, length, ord, chr, chroot, rmdir */
- 0x3d30, 0x0067, /* pow, multiply, i_multiply, divide, i_divide, modulo, i_modulo, add, i_add, subtract, i_subtract, concat, left_shift, right_shift */
- 0x0f78, 0x3d30, 0x0067, /* repeat */
- 0x3d30, 0x012f, /* stringify, atan2, rand, srand, index, rindex, crypt, push, unshift, flock, chdir, chown, unlink, chmod, utime, rename, link, symlink, mkdir, waitpid, system, exec, kill, getpgrp, setpgrp, getpriority, setpriority, sleep */
- 0x3230, 0x290c, 0x00cb, /* substr */
- 0x3d30, 0x290c, 0x0067, /* vec */
- 0x281c, 0x2d38, 0x290c, 0x3708, 0x3ac4, 0x0003, /* rv2av */
+ 0x0758, 0x2acc, 0x0067, /* aassign */
+ 0x3ef0, 0x0003, /* chomp, schomp, sin, cos, exp, log, sqrt, int, hex, oct, abs, length, ord, chr, chroot, rmdir */
+ 0x3ef0, 0x0067, /* pow, multiply, i_multiply, divide, i_divide, modulo, i_modulo, add, i_add, subtract, i_subtract, concat, left_shift, right_shift */
+ 0x1058, 0x3ef0, 0x0067, /* repeat */
+ 0x3ef0, 0x012f, /* stringify, atan2, rand, srand, index, rindex, crypt, push, unshift, flock, chdir, chown, unlink, chmod, utime, rename, link, symlink, mkdir, waitpid, system, exec, kill, getpgrp, setpgrp, getpriority, setpriority, sleep */
+ 0x33f0, 0x2acc, 0x00cb, /* substr */
+ 0x3ef0, 0x2acc, 0x0067, /* vec */
+ 0x29dc, 0x2ef8, 0x2acc, 0x38c8, 0x3c84, 0x0003, /* rv2av */
0x01ff, /* aelemfast, aelemfast_lex */
- 0x281c, 0x2718, 0x0256, 0x290c, 0x0067, /* aelem, helem */
- 0x281c, 0x290c, 0x3709, /* aslice, hslice */
- 0x290d, /* kvaslice, kvhslice */
- 0x281c, 0x3658, 0x0003, /* delete */
- 0x3bb8, 0x0003, /* exists */
- 0x281c, 0x2d38, 0x0534, 0x05d0, 0x290c, 0x3708, 0x3ac4, 0x0003, /* rv2hv */
- 0x207c, 0x2d38, 0x3d31, /* split */
- 0x281c, 0x1cd9, /* list */
- 0x3938, 0x2fd4, 0x0ed0, 0x238c, 0x3328, 0x2484, 0x2ca1, /* sort */
- 0x238c, 0x0003, /* reverse */
- 0x1b05, /* grepstart, mapstart */
- 0x1b04, 0x0003, /* grepwhile, mapwhile */
- 0x25b8, 0x0003, /* flip, flop */
- 0x281c, 0x0003, /* cond_expr */
- 0x281c, 0x0b98, 0x0256, 0x028c, 0x3c88, 0x3ac4, 0x2141, /* entersub */
- 0x3098, 0x0003, /* leavesub, leavesublv, leavewrite, leaveeval */
+ 0x29dc, 0x28d8, 0x0256, 0x2acc, 0x0067, /* aelem, helem */
+ 0x29dc, 0x2acc, 0x38c9, /* aslice, hslice */
+ 0x2acd, /* kvaslice, kvhslice */
+ 0x29dc, 0x3818, 0x0003, /* delete */
+ 0x3d78, 0x0003, /* exists */
+ 0x29dc, 0x2ef8, 0x0534, 0x05d0, 0x2acc, 0x38c8, 0x3c84, 0x0003, /* rv2hv */
+ 0x29dc, 0x28d8, 0x0d14, 0x1670, 0x2acc, 0x3c84, 0x0003, /* multideref */
+ 0x223c, 0x2ef8, 0x3ef1, /* split */
+ 0x29dc, 0x1e99, /* list */
+ 0x3af8, 0x3194, 0x0fb0, 0x254c, 0x34e8, 0x2644, 0x2e61, /* sort */
+ 0x254c, 0x0003, /* reverse */
+ 0x1cc5, /* grepstart, mapstart */
+ 0x1cc4, 0x0003, /* grepwhile, mapwhile */
+ 0x2778, 0x0003, /* flip, flop */
+ 0x29dc, 0x0003, /* cond_expr */
+ 0x29dc, 0x0b98, 0x0256, 0x028c, 0x3e48, 0x3c84, 0x2301, /* entersub */
+ 0x3258, 0x0003, /* leavesub, leavesublv, leavewrite, leaveeval */
0x00bc, 0x012f, /* caller */
- 0x1eb5, /* nextstate, dbstate */
- 0x26bc, 0x3099, /* leave */
- 0x281c, 0x2d38, 0x0c0c, 0x33a9, /* enteriter */
- 0x33a9, /* iter */
- 0x26bc, 0x0067, /* leaveloop */
- 0x3e9c, 0x0003, /* last, next, redo, dump, goto */
- 0x2f1c, 0x2e38, 0x22f4, 0x2230, 0x012f, /* open */
- 0x1750, 0x19ac, 0x1868, 0x1624, 0x0003, /* ftrread, ftrwrite, ftrexec, fteread, ftewrite, fteexec */
- 0x1750, 0x19ac, 0x1868, 0x0003, /* ftis, ftsize, ftmtime, ftatime, ftctime, ftrowned, fteowned, ftzero, ftsock, ftchr, ftblk, ftfile, ftdir, ftpipe, ftsuid, ftsgid, ftsvtx, ftlink, fttty, fttext, ftbinary */
- 0x3d31, /* wait, getppid, time */
- 0x3134, 0x09b0, 0x068c, 0x3e08, 0x1dc4, 0x0003, /* entereval */
- 0x29dc, 0x0018, 0x0de4, 0x0d01, /* coreargs */
- 0x281c, 0x019b, /* padrange */
- 0x281c, 0x3a18, 0x0376, 0x250c, 0x13e8, 0x0067, /* refassign */
- 0x281c, 0x3a18, 0x0376, 0x250c, 0x13e8, 0x0003, /* lvref */
- 0x281d, /* lvrefslice */
- 0x281c, 0x3a18, 0x0003, /* lvavref */
+ 0x2075, /* nextstate, dbstate */
+ 0x287c, 0x3259, /* leave */
+ 0x29dc, 0x2ef8, 0x0c0c, 0x3569, /* enteriter */
+ 0x3569, /* iter */
+ 0x287c, 0x0067, /* leaveloop */
+ 0x405c, 0x0003, /* last, next, redo, dump, goto */
+ 0x30dc, 0x2ff8, 0x24b4, 0x23f0, 0x012f, /* open */
+ 0x1910, 0x1b6c, 0x1a28, 0x17e4, 0x0003, /* ftrread, ftrwrite, ftrexec, fteread, ftewrite, fteexec */
+ 0x1910, 0x1b6c, 0x1a28, 0x0003, /* ftis, ftsize, ftmtime, ftatime, ftctime, ftrowned, fteowned, ftzero, ftsock, ftchr, ftblk, ftfile, ftdir, ftpipe, ftsuid, ftsgid, ftsvtx, ftlink, fttty, fttext, ftbinary */
+ 0x3ef1, /* wait, getppid, time */
+ 0x32f4, 0x09b0, 0x068c, 0x3fc8, 0x1f84, 0x0003, /* entereval */
+ 0x2b9c, 0x0018, 0x0ec4, 0x0de1, /* coreargs */
+ 0x29dc, 0x019b, /* padrange */
+ 0x29dc, 0x3bd8, 0x0376, 0x26cc, 0x14c8, 0x0067, /* refassign */
+ 0x29dc, 0x3bd8, 0x0376, 0x26cc, 0x14c8, 0x0003, /* lvref */
+ 0x29dd, /* lvrefslice */
+ 0x29dc, 0x3bd8, 0x0003, /* lvavref */
};
@@ -2997,6 +3008,7 @@ EXTCONST U8 PL_op_private_valid[] = {
/* HELEM */ (OPpARG2_MASK|OPpMAYBE_LVSUB|OPpDEREF|OPpLVAL_DEFER|OPpLVAL_INTRO),
/* HSLICE */ (OPpSLICEWARNING|OPpMAYBE_LVSUB|OPpLVAL_INTRO),
/* KVHSLICE */ (OPpMAYBE_LVSUB),
+ /* MULTIDEREF */ (OPpARG1_MASK|OPpHINT_STRICT_REFS|OPpMAYBE_LVSUB|OPpMULTIDEREF_EXISTS|OPpMULTIDEREF_DELETE|OPpLVAL_DEFER|OPpLVAL_INTRO),
/* UNPACK */ (OPpARG4_MASK),
/* PACK */ (OPpARG4_MASK),
/* SPLIT */ (OPpTARGET_MY|OPpOUR_INTRO|OPpSPLIT_IMPLIM),
diff --git a/opnames.h b/opnames.h
index dce44f19e9..1d259a15dd 100644
--- a/opnames.h
+++ b/opnames.h
@@ -159,251 +159,252 @@ typedef enum opcode {
OP_HELEM = 142,
OP_HSLICE = 143,
OP_KVHSLICE = 144,
- OP_UNPACK = 145,
- OP_PACK = 146,
- OP_SPLIT = 147,
- OP_JOIN = 148,
- OP_LIST = 149,
- OP_LSLICE = 150,
- OP_ANONLIST = 151,
- OP_ANONHASH = 152,
- OP_SPLICE = 153,
- OP_PUSH = 154,
- OP_POP = 155,
- OP_SHIFT = 156,
- OP_UNSHIFT = 157,
- OP_SORT = 158,
- OP_REVERSE = 159,
- OP_GREPSTART = 160,
- OP_GREPWHILE = 161,
- OP_MAPSTART = 162,
- OP_MAPWHILE = 163,
- OP_RANGE = 164,
- OP_FLIP = 165,
- OP_FLOP = 166,
- OP_AND = 167,
- OP_OR = 168,
- OP_XOR = 169,
- OP_DOR = 170,
- OP_COND_EXPR = 171,
- OP_ANDASSIGN = 172,
- OP_ORASSIGN = 173,
- OP_DORASSIGN = 174,
- OP_METHOD = 175,
- OP_ENTERSUB = 176,
- OP_LEAVESUB = 177,
- OP_LEAVESUBLV = 178,
- OP_CALLER = 179,
- OP_WARN = 180,
- OP_DIE = 181,
- OP_RESET = 182,
- OP_LINESEQ = 183,
- OP_NEXTSTATE = 184,
- OP_DBSTATE = 185,
- OP_UNSTACK = 186,
- OP_ENTER = 187,
- OP_LEAVE = 188,
- OP_SCOPE = 189,
- OP_ENTERITER = 190,
- OP_ITER = 191,
- OP_ENTERLOOP = 192,
- OP_LEAVELOOP = 193,
- OP_RETURN = 194,
- OP_LAST = 195,
- OP_NEXT = 196,
- OP_REDO = 197,
- OP_DUMP = 198,
- OP_GOTO = 199,
- OP_EXIT = 200,
- OP_METHOD_NAMED = 201,
- OP_METHOD_SUPER = 202,
- OP_METHOD_REDIR = 203,
- OP_METHOD_REDIR_SUPER = 204,
- OP_ENTERGIVEN = 205,
- OP_LEAVEGIVEN = 206,
- OP_ENTERWHEN = 207,
- OP_LEAVEWHEN = 208,
- OP_BREAK = 209,
- OP_CONTINUE = 210,
- OP_OPEN = 211,
- OP_CLOSE = 212,
- OP_PIPE_OP = 213,
- OP_FILENO = 214,
- OP_UMASK = 215,
- OP_BINMODE = 216,
- OP_TIE = 217,
- OP_UNTIE = 218,
- OP_TIED = 219,
- OP_DBMOPEN = 220,
- OP_DBMCLOSE = 221,
- OP_SSELECT = 222,
- OP_SELECT = 223,
- OP_GETC = 224,
- OP_READ = 225,
- OP_ENTERWRITE = 226,
- OP_LEAVEWRITE = 227,
- OP_PRTF = 228,
- OP_PRINT = 229,
- OP_SAY = 230,
- OP_SYSOPEN = 231,
- OP_SYSSEEK = 232,
- OP_SYSREAD = 233,
- OP_SYSWRITE = 234,
- OP_EOF = 235,
- OP_TELL = 236,
- OP_SEEK = 237,
- OP_TRUNCATE = 238,
- OP_FCNTL = 239,
- OP_IOCTL = 240,
- OP_FLOCK = 241,
- OP_SEND = 242,
- OP_RECV = 243,
- OP_SOCKET = 244,
- OP_SOCKPAIR = 245,
- OP_BIND = 246,
- OP_CONNECT = 247,
- OP_LISTEN = 248,
- OP_ACCEPT = 249,
- OP_SHUTDOWN = 250,
- OP_GSOCKOPT = 251,
- OP_SSOCKOPT = 252,
- OP_GETSOCKNAME = 253,
- OP_GETPEERNAME = 254,
- OP_LSTAT = 255,
- OP_STAT = 256,
- OP_FTRREAD = 257,
- OP_FTRWRITE = 258,
- OP_FTREXEC = 259,
- OP_FTEREAD = 260,
- OP_FTEWRITE = 261,
- OP_FTEEXEC = 262,
- OP_FTIS = 263,
- OP_FTSIZE = 264,
- OP_FTMTIME = 265,
- OP_FTATIME = 266,
- OP_FTCTIME = 267,
- OP_FTROWNED = 268,
- OP_FTEOWNED = 269,
- OP_FTZERO = 270,
- OP_FTSOCK = 271,
- OP_FTCHR = 272,
- OP_FTBLK = 273,
- OP_FTFILE = 274,
- OP_FTDIR = 275,
- OP_FTPIPE = 276,
- OP_FTSUID = 277,
- OP_FTSGID = 278,
- OP_FTSVTX = 279,
- OP_FTLINK = 280,
- OP_FTTTY = 281,
- OP_FTTEXT = 282,
- OP_FTBINARY = 283,
- OP_CHDIR = 284,
- OP_CHOWN = 285,
- OP_CHROOT = 286,
- OP_UNLINK = 287,
- OP_CHMOD = 288,
- OP_UTIME = 289,
- OP_RENAME = 290,
- OP_LINK = 291,
- OP_SYMLINK = 292,
- OP_READLINK = 293,
- OP_MKDIR = 294,
- OP_RMDIR = 295,
- OP_OPEN_DIR = 296,
- OP_READDIR = 297,
- OP_TELLDIR = 298,
- OP_SEEKDIR = 299,
- OP_REWINDDIR = 300,
- OP_CLOSEDIR = 301,
- OP_FORK = 302,
- OP_WAIT = 303,
- OP_WAITPID = 304,
- OP_SYSTEM = 305,
- OP_EXEC = 306,
- OP_KILL = 307,
- OP_GETPPID = 308,
- OP_GETPGRP = 309,
- OP_SETPGRP = 310,
- OP_GETPRIORITY = 311,
- OP_SETPRIORITY = 312,
- OP_TIME = 313,
- OP_TMS = 314,
- OP_LOCALTIME = 315,
- OP_GMTIME = 316,
- OP_ALARM = 317,
- OP_SLEEP = 318,
- OP_SHMGET = 319,
- OP_SHMCTL = 320,
- OP_SHMREAD = 321,
- OP_SHMWRITE = 322,
- OP_MSGGET = 323,
- OP_MSGCTL = 324,
- OP_MSGSND = 325,
- OP_MSGRCV = 326,
- OP_SEMOP = 327,
- OP_SEMGET = 328,
- OP_SEMCTL = 329,
- OP_REQUIRE = 330,
- OP_DOFILE = 331,
- OP_HINTSEVAL = 332,
- OP_ENTEREVAL = 333,
- OP_LEAVEEVAL = 334,
- OP_ENTERTRY = 335,
- OP_LEAVETRY = 336,
- OP_GHBYNAME = 337,
- OP_GHBYADDR = 338,
- OP_GHOSTENT = 339,
- OP_GNBYNAME = 340,
- OP_GNBYADDR = 341,
- OP_GNETENT = 342,
- OP_GPBYNAME = 343,
- OP_GPBYNUMBER = 344,
- OP_GPROTOENT = 345,
- OP_GSBYNAME = 346,
- OP_GSBYPORT = 347,
- OP_GSERVENT = 348,
- OP_SHOSTENT = 349,
- OP_SNETENT = 350,
- OP_SPROTOENT = 351,
- OP_SSERVENT = 352,
- OP_EHOSTENT = 353,
- OP_ENETENT = 354,
- OP_EPROTOENT = 355,
- OP_ESERVENT = 356,
- OP_GPWNAM = 357,
- OP_GPWUID = 358,
- OP_GPWENT = 359,
- OP_SPWENT = 360,
- OP_EPWENT = 361,
- OP_GGRNAM = 362,
- OP_GGRGID = 363,
- OP_GGRENT = 364,
- OP_SGRENT = 365,
- OP_EGRENT = 366,
- OP_GETLOGIN = 367,
- OP_SYSCALL = 368,
- OP_LOCK = 369,
- OP_ONCE = 370,
- OP_CUSTOM = 371,
- OP_REACH = 372,
- OP_RKEYS = 373,
- OP_RVALUES = 374,
- OP_COREARGS = 375,
- OP_RUNCV = 376,
- OP_FC = 377,
- OP_PADCV = 378,
- OP_INTROCV = 379,
- OP_CLONECV = 380,
- OP_PADRANGE = 381,
- OP_REFASSIGN = 382,
- OP_LVREF = 383,
- OP_LVREFSLICE = 384,
- OP_LVAVREF = 385,
+ OP_MULTIDEREF = 145,
+ OP_UNPACK = 146,
+ OP_PACK = 147,
+ OP_SPLIT = 148,
+ OP_JOIN = 149,
+ OP_LIST = 150,
+ OP_LSLICE = 151,
+ OP_ANONLIST = 152,
+ OP_ANONHASH = 153,
+ OP_SPLICE = 154,
+ OP_PUSH = 155,
+ OP_POP = 156,
+ OP_SHIFT = 157,
+ OP_UNSHIFT = 158,
+ OP_SORT = 159,
+ OP_REVERSE = 160,
+ OP_GREPSTART = 161,
+ OP_GREPWHILE = 162,
+ OP_MAPSTART = 163,
+ OP_MAPWHILE = 164,
+ OP_RANGE = 165,
+ OP_FLIP = 166,
+ OP_FLOP = 167,
+ OP_AND = 168,
+ OP_OR = 169,
+ OP_XOR = 170,
+ OP_DOR = 171,
+ OP_COND_EXPR = 172,
+ OP_ANDASSIGN = 173,
+ OP_ORASSIGN = 174,
+ OP_DORASSIGN = 175,
+ OP_METHOD = 176,
+ OP_ENTERSUB = 177,
+ OP_LEAVESUB = 178,
+ OP_LEAVESUBLV = 179,
+ OP_CALLER = 180,
+ OP_WARN = 181,
+ OP_DIE = 182,
+ OP_RESET = 183,
+ OP_LINESEQ = 184,
+ OP_NEXTSTATE = 185,
+ OP_DBSTATE = 186,
+ OP_UNSTACK = 187,
+ OP_ENTER = 188,
+ OP_LEAVE = 189,
+ OP_SCOPE = 190,
+ OP_ENTERITER = 191,
+ OP_ITER = 192,
+ OP_ENTERLOOP = 193,
+ OP_LEAVELOOP = 194,
+ OP_RETURN = 195,
+ OP_LAST = 196,
+ OP_NEXT = 197,
+ OP_REDO = 198,
+ OP_DUMP = 199,
+ OP_GOTO = 200,
+ OP_EXIT = 201,
+ OP_METHOD_NAMED = 202,
+ OP_METHOD_SUPER = 203,
+ OP_METHOD_REDIR = 204,
+ OP_METHOD_REDIR_SUPER = 205,
+ OP_ENTERGIVEN = 206,
+ OP_LEAVEGIVEN = 207,
+ OP_ENTERWHEN = 208,
+ OP_LEAVEWHEN = 209,
+ OP_BREAK = 210,
+ OP_CONTINUE = 211,
+ OP_OPEN = 212,
+ OP_CLOSE = 213,
+ OP_PIPE_OP = 214,
+ OP_FILENO = 215,
+ OP_UMASK = 216,
+ OP_BINMODE = 217,
+ OP_TIE = 218,
+ OP_UNTIE = 219,
+ OP_TIED = 220,
+ OP_DBMOPEN = 221,
+ OP_DBMCLOSE = 222,
+ OP_SSELECT = 223,
+ OP_SELECT = 224,
+ OP_GETC = 225,
+ OP_READ = 226,
+ OP_ENTERWRITE = 227,
+ OP_LEAVEWRITE = 228,
+ OP_PRTF = 229,
+ OP_PRINT = 230,
+ OP_SAY = 231,
+ OP_SYSOPEN = 232,
+ OP_SYSSEEK = 233,
+ OP_SYSREAD = 234,
+ OP_SYSWRITE = 235,
+ OP_EOF = 236,
+ OP_TELL = 237,
+ OP_SEEK = 238,
+ OP_TRUNCATE = 239,
+ OP_FCNTL = 240,
+ OP_IOCTL = 241,
+ OP_FLOCK = 242,
+ OP_SEND = 243,
+ OP_RECV = 244,
+ OP_SOCKET = 245,
+ OP_SOCKPAIR = 246,
+ OP_BIND = 247,
+ OP_CONNECT = 248,
+ OP_LISTEN = 249,
+ OP_ACCEPT = 250,
+ OP_SHUTDOWN = 251,
+ OP_GSOCKOPT = 252,
+ OP_SSOCKOPT = 253,
+ OP_GETSOCKNAME = 254,
+ OP_GETPEERNAME = 255,
+ OP_LSTAT = 256,
+ OP_STAT = 257,
+ OP_FTRREAD = 258,
+ OP_FTRWRITE = 259,
+ OP_FTREXEC = 260,
+ OP_FTEREAD = 261,
+ OP_FTEWRITE = 262,
+ OP_FTEEXEC = 263,
+ OP_FTIS = 264,
+ OP_FTSIZE = 265,
+ OP_FTMTIME = 266,
+ OP_FTATIME = 267,
+ OP_FTCTIME = 268,
+ OP_FTROWNED = 269,
+ OP_FTEOWNED = 270,
+ OP_FTZERO = 271,
+ OP_FTSOCK = 272,
+ OP_FTCHR = 273,
+ OP_FTBLK = 274,
+ OP_FTFILE = 275,
+ OP_FTDIR = 276,
+ OP_FTPIPE = 277,
+ OP_FTSUID = 278,
+ OP_FTSGID = 279,
+ OP_FTSVTX = 280,
+ OP_FTLINK = 281,
+ OP_FTTTY = 282,
+ OP_FTTEXT = 283,
+ OP_FTBINARY = 284,
+ OP_CHDIR = 285,
+ OP_CHOWN = 286,
+ OP_CHROOT = 287,
+ OP_UNLINK = 288,
+ OP_CHMOD = 289,
+ OP_UTIME = 290,
+ OP_RENAME = 291,
+ OP_LINK = 292,
+ OP_SYMLINK = 293,
+ OP_READLINK = 294,
+ OP_MKDIR = 295,
+ OP_RMDIR = 296,
+ OP_OPEN_DIR = 297,
+ OP_READDIR = 298,
+ OP_TELLDIR = 299,
+ OP_SEEKDIR = 300,
+ OP_REWINDDIR = 301,
+ OP_CLOSEDIR = 302,
+ OP_FORK = 303,
+ OP_WAIT = 304,
+ OP_WAITPID = 305,
+ OP_SYSTEM = 306,
+ OP_EXEC = 307,
+ OP_KILL = 308,
+ OP_GETPPID = 309,
+ OP_GETPGRP = 310,
+ OP_SETPGRP = 311,
+ OP_GETPRIORITY = 312,
+ OP_SETPRIORITY = 313,
+ OP_TIME = 314,
+ OP_TMS = 315,
+ OP_LOCALTIME = 316,
+ OP_GMTIME = 317,
+ OP_ALARM = 318,
+ OP_SLEEP = 319,
+ OP_SHMGET = 320,
+ OP_SHMCTL = 321,
+ OP_SHMREAD = 322,
+ OP_SHMWRITE = 323,
+ OP_MSGGET = 324,
+ OP_MSGCTL = 325,
+ OP_MSGSND = 326,
+ OP_MSGRCV = 327,
+ OP_SEMOP = 328,
+ OP_SEMGET = 329,
+ OP_SEMCTL = 330,
+ OP_REQUIRE = 331,
+ OP_DOFILE = 332,
+ OP_HINTSEVAL = 333,
+ OP_ENTEREVAL = 334,
+ OP_LEAVEEVAL = 335,
+ OP_ENTERTRY = 336,
+ OP_LEAVETRY = 337,
+ OP_GHBYNAME = 338,
+ OP_GHBYADDR = 339,
+ OP_GHOSTENT = 340,
+ OP_GNBYNAME = 341,
+ OP_GNBYADDR = 342,
+ OP_GNETENT = 343,
+ OP_GPBYNAME = 344,
+ OP_GPBYNUMBER = 345,
+ OP_GPROTOENT = 346,
+ OP_GSBYNAME = 347,
+ OP_GSBYPORT = 348,
+ OP_GSERVENT = 349,
+ OP_SHOSTENT = 350,
+ OP_SNETENT = 351,
+ OP_SPROTOENT = 352,
+ OP_SSERVENT = 353,
+ OP_EHOSTENT = 354,
+ OP_ENETENT = 355,
+ OP_EPROTOENT = 356,
+ OP_ESERVENT = 357,
+ OP_GPWNAM = 358,
+ OP_GPWUID = 359,
+ OP_GPWENT = 360,
+ OP_SPWENT = 361,
+ OP_EPWENT = 362,
+ OP_GGRNAM = 363,
+ OP_GGRGID = 364,
+ OP_GGRENT = 365,
+ OP_SGRENT = 366,
+ OP_EGRENT = 367,
+ OP_GETLOGIN = 368,
+ OP_SYSCALL = 369,
+ OP_LOCK = 370,
+ OP_ONCE = 371,
+ OP_CUSTOM = 372,
+ OP_REACH = 373,
+ OP_RKEYS = 374,
+ OP_RVALUES = 375,
+ OP_COREARGS = 376,
+ OP_RUNCV = 377,
+ OP_FC = 378,
+ OP_PADCV = 379,
+ OP_INTROCV = 380,
+ OP_CLONECV = 381,
+ OP_PADRANGE = 382,
+ OP_REFASSIGN = 383,
+ OP_LVREF = 384,
+ OP_LVREFSLICE = 385,
+ OP_LVAVREF = 386,
OP_max
} opcode;
-#define MAXO 386
+#define MAXO 387
#define OP_FREED MAXO
/* the OP_IS_* macros are optimized to a simple range check because
diff --git a/perl.h b/perl.h
index 2a77522c5e..ac674c1aa9 100644
--- a/perl.h
+++ b/perl.h
@@ -4605,12 +4605,13 @@ EXTCONST char PL_warn_nl[]
INIT("Unsuccessful %s on filename containing newline");
EXTCONST char PL_no_wrongref[]
INIT("Can't use %s ref as %s ref");
-/* The core no longer needs these here. If you require the string constant,
+/* The core no longer needs this here. If you require the string constant,
please inline a copy into your own code. */
EXTCONST char PL_no_symref[] __attribute__deprecated__
INIT("Can't use string (\"%.32s\") as %s ref while \"strict refs\" in use");
-EXTCONST char PL_no_symref_sv[] __attribute__deprecated__
- INIT("Can't use string (\"%" SVf32 "\") as %s ref while \"strict refs\" in use");
+EXTCONST char PL_no_symref_sv[]
+ INIT("Can't use string (\"%" SVf32 "\"%s) as %s ref while \"strict refs\" in use");
+
EXTCONST char PL_no_usym[]
INIT("Can't use an undefined value as %s reference");
EXTCONST char PL_no_aelem[]
diff --git a/pp.c b/pp.c
index 97ad595119..6772999463 100644
--- a/pp.c
+++ b/pp.c
@@ -195,9 +195,6 @@ PP(pp_clonecv)
/* Translations. */
-static const char S_no_symref_sv[] =
- "Can't use string (\"%" SVf32 "\"%s) as %s ref while \"strict refs\" in use";
-
/* In some cases this function inspects PL_op. If this function is called
for new op types, more bool parameters may need to be added in place of
the checks.
@@ -274,7 +271,7 @@ S_rv2gv(pTHX_ SV *sv, const bool vivify_sv, const bool strict,
else {
if (strict) {
Perl_die(aTHX_
- S_no_symref_sv,
+ PL_no_symref_sv,
sv,
(SvPOKp(sv) && SvCUR(sv)>32 ? "..." : ""),
"a symbol"
@@ -329,7 +326,7 @@ Perl_softref2xv(pTHX_ SV *const sv, const char *const what,
if (PL_op->op_private & HINT_STRICT_REFS) {
if (SvOK(sv))
- Perl_die(aTHX_ S_no_symref_sv, sv,
+ Perl_die(aTHX_ PL_no_symref_sv, sv,
(SvPOKp(sv) && SvCUR(sv)>32 ? "..." : ""), what);
else
Perl_die(aTHX_ PL_no_usym, what);
diff --git a/pp_hot.c b/pp_hot.c
index 35493eb1b4..24bf8e9086 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1857,6 +1857,442 @@ PP(pp_helem)
RETURN;
}
+
+/* a stripped-down version of Perl_softref2xv() for use by
+ * pp_multideref(), which doesn't use PL_op->op_flags */
+
+GV *
+S_softref2xv_lite(pTHX_ SV *const sv, const char *const what,
+ const svtype type)
+{
+ if (PL_op->op_private & HINT_STRICT_REFS) {
+ if (SvOK(sv))
+ Perl_die(aTHX_ PL_no_symref_sv, sv,
+ (SvPOKp(sv) && SvCUR(sv)>32 ? "..." : ""), what);
+ else
+ Perl_die(aTHX_ PL_no_usym, what);
+ }
+ if (!SvOK(sv))
+ Perl_die(aTHX_ PL_no_usym, what);
+ return gv_fetchsv_nomg(sv, GV_ADD, type);
+}
+
+
+/* handle one or more derefs and array/hash indexings, e.g.
+ * $h->{foo} or $a[0]{$key}[$i] or f()->[1]
+ *
+ * op_aux points to an array of unions of UV / IV / SV* / PADOFFSET.
+ * Each of these either contains an action, or an argument, such as
+ * a UV to use as an array index, or a lexical var to retrieve.
+ * In fact, several actions re stored per UV; we keep shifting new actions
+ * of the one UV, and only reload when it becomes zero.
+ */
+
+PP(pp_multideref)
+{
+ SV *sv = NULL; /* init to avoid spurious 'may be used uninitialized' */
+ UNOP_AUX_item *items = cUNOP_AUXx(PL_op)->op_aux;
+ UV actions = items->uv;
+
+ assert(actions);
+ /* this tells find_uninit_var() where we're up to */
+ PL_multideref_pc = items;
+
+ while (1) {
+ /* there are three main classes of action; the first retrieve
+ * the initial AV or HV from a variable or the stack; the second
+ * does the equivalent of an unrolled (/DREFAV, rv2av, aelem),
+ * the third an unrolled (/DREFHV, rv2hv, helem).
+ */
+ switch (actions & MDEREF_ACTION_MASK) {
+
+ case MDEREF_reload:
+ actions = (++items)->uv;
+ continue;
+
+ case MDEREF_AV_padav_aelem: /* $lex[...] */
+ sv = PAD_SVl((++items)->pad_offset);
+ goto do_AV_aelem;
+
+ case MDEREF_AV_gvav_aelem: /* $pkg[...] */
+ sv = UNOP_AUX_item_sv(++items);
+ assert(isGV_with_GP(sv));
+ sv = (SV*)GvAVn((GV*)sv);
+ goto do_AV_aelem;
+
+ case MDEREF_AV_pop_rv2av_aelem: /* expr->[...] */
+ {
+ dSP;
+ sv = POPs;
+ PUTBACK;
+ goto do_AV_rv2av_aelem;
+ }
+
+ case MDEREF_AV_gvsv_vivify_rv2av_aelem: /* $pkg->[...] */
+ sv = UNOP_AUX_item_sv(++items);
+ assert(isGV_with_GP(sv));
+ sv = GvSVn((GV*)sv);
+ goto do_AV_vivify_rv2av_aelem;
+
+ case MDEREF_AV_padsv_vivify_rv2av_aelem: /* $lex->[...] */
+ sv = PAD_SVl((++items)->pad_offset);
+ /* FALLTHROUGH */
+
+ do_AV_vivify_rv2av_aelem:
+ case MDEREF_AV_vivify_rv2av_aelem: /* vivify, ->[...] */
+ /* this is the OPpDEREF action normally found at the end of
+ * ops like aelem, helem, rv2sv */
+ sv = vivify_ref(sv, OPpDEREF_AV);
+ /* FALLTHROUGH */
+
+ do_AV_rv2av_aelem:
+ /* this is basically a copy of pp_rv2av when it just has the
+ * sKR/1 flags */
+ SvGETMAGIC(sv);
+ if (LIKELY(SvROK(sv))) {
+ if (UNLIKELY(SvAMAGIC(sv))) {
+ sv = amagic_deref_call(sv, to_av_amg);
+ }
+ sv = SvRV(sv);
+ if (UNLIKELY(SvTYPE(sv) != SVt_PVAV))
+ DIE(aTHX_ "Not an ARRAY reference");
+ }
+ else if (SvTYPE(sv) != SVt_PVAV) {
+ if (!isGV_with_GP(sv))
+ sv = (SV*)S_softref2xv_lite(aTHX_ sv, "an ARRAY", SVt_PVAV);
+ sv = MUTABLE_SV(GvAVn((GV*)sv));
+ }
+ /* FALLTHROUGH */
+
+ do_AV_aelem:
+ {
+ /* retrieve the key; this may be either a lexical or package
+ * var (whose index/ptr is stored as an item) or a signed
+ * integer constant stored as an item.
+ */
+ SV *elemsv;
+ IV elem = 0; /* to shut up stupid compiler warnings */
+
+
+ assert(SvTYPE(sv) == SVt_PVAV);
+
+ switch (actions & MDEREF_INDEX_MASK) {
+ case MDEREF_INDEX_none:
+ goto finish;
+ case MDEREF_INDEX_const:
+ elem = (++items)->iv;
+ break;
+ case MDEREF_INDEX_padsv:
+ elemsv = PAD_SVl((++items)->pad_offset);
+ goto check_elem;
+ case MDEREF_INDEX_gvsv:
+ elemsv = UNOP_AUX_item_sv(++items);
+ assert(isGV_with_GP(elemsv));
+ elemsv = GvSVn((GV*)elemsv);
+ check_elem:
+ if (UNLIKELY(SvROK(elemsv) && !SvGAMAGIC(elemsv)
+ && ckWARN(WARN_MISC)))
+ Perl_warner(aTHX_ packWARN(WARN_MISC),
+ "Use of reference \"%"SVf"\" as array index",
+ SVfARG(elemsv));
+ /* the only time that S_find_uninit_var() needs this
+ * is to determine which index value triggered the
+ * undef warning. So just update it here. Note that
+ * since we don't save and restore this var (e.g. for
+ * tie or overload execution), its value will be
+ * meaningless apart from just here */
+ PL_multideref_pc = items;
+ elem = SvIV(elemsv);
+ break;
+ }
+
+
+ /* this is basically a copy of pp_aelem with OPpDEREF skipped */
+
+ if (!(actions & MDEREF_FLAG_last)) {
+ SV** svp = av_fetch((AV*)sv, elem, 1);
+ if (!svp || ! (sv=*svp))
+ DIE(aTHX_ PL_no_aelem, elem);
+ break;
+ }
+
+ if (PL_op->op_private &
+ (OPpMULTIDEREF_EXISTS|OPpMULTIDEREF_DELETE))
+ {
+ if (PL_op->op_private & OPpMULTIDEREF_EXISTS) {
+ sv = av_exists((AV*)sv, elem) ? &PL_sv_yes : &PL_sv_no;
+ }
+ else {
+ I32 discard = (GIMME_V == G_VOID) ? G_DISCARD : 0;
+ sv = av_delete((AV*)sv, elem, discard);
+ if (discard)
+ return NORMAL;
+ if (!sv)
+ sv = &PL_sv_undef;
+ }
+ }
+ else {
+ const U32 lval = PL_op->op_flags & OPf_MOD || LVRET;
+ const U32 defer = PL_op->op_private & OPpLVAL_DEFER;
+ const bool localizing = PL_op->op_private & OPpLVAL_INTRO;
+ bool preeminent = TRUE;
+ AV *const av = (AV*)sv;
+ SV** svp;
+
+ if (UNLIKELY(localizing)) {
+ MAGIC *mg;
+ HV *stash;
+
+ /* If we can determine whether the element exist,
+ * Try to preserve the existenceness of a tied array
+ * element by using EXISTS and DELETE if possible.
+ * Fallback to FETCH and STORE otherwise. */
+ if (SvCANEXISTDELETE(av))
+ preeminent = av_exists(av, elem);
+ }
+
+ svp = av_fetch(av, elem, lval && !defer);
+
+ if (lval) {
+ if (!svp || !(sv = *svp)) {
+ IV len;
+ if (!defer)
+ DIE(aTHX_ PL_no_aelem, elem);
+ len = av_tindex(av);
+ sv = sv_2mortal(newSVavdefelem(av,
+ /* Resolve a negative index now, unless it points
+ * before the beginning of the array, in which
+ * case record it for error reporting in
+ * magic_setdefelem. */
+ elem < 0 && len + elem >= 0
+ ? len + elem : elem, 1));
+ }
+ else {
+ if (UNLIKELY(localizing)) {
+ if (preeminent) {
+ save_aelem(av, elem, svp);
+ sv = *svp; /* may have changed */
+ }
+ else
+ SAVEADELETE(av, elem);
+ }
+ }
+ }
+ else {
+ sv = (svp ? *svp : &PL_sv_undef);
+ /* see note in pp_helem() */
+ if (SvRMAGICAL(av) && SvGMAGICAL(sv))
+ mg_get(sv);
+ }
+ }
+
+ }
+ finish:
+ {
+ dSP;
+ XPUSHs(sv);
+ RETURN;
+ }
+ /* NOTREACHED */
+
+
+
+
+ case MDEREF_HV_padhv_helem: /* $lex{...} */
+ sv = PAD_SVl((++items)->pad_offset);
+ goto do_HV_helem;
+
+ case MDEREF_HV_gvhv_helem: /* $pkg{...} */
+ sv = UNOP_AUX_item_sv(++items);
+ assert(isGV_with_GP(sv));
+ sv = (SV*)GvHVn((GV*)sv);
+ goto do_HV_helem;
+
+ case MDEREF_HV_pop_rv2hv_helem: /* expr->{...} */
+ {
+ dSP;
+ sv = POPs;
+ PUTBACK;
+ goto do_HV_rv2hv_helem;
+ }
+
+ case MDEREF_HV_gvsv_vivify_rv2hv_helem: /* $pkg->{...} */
+ sv = UNOP_AUX_item_sv(++items);
+ assert(isGV_with_GP(sv));
+ sv = GvSVn((GV*)sv);
+ goto do_HV_vivify_rv2hv_helem;
+
+ case MDEREF_HV_padsv_vivify_rv2hv_helem: /* $lex->{...} */
+ sv = PAD_SVl((++items)->pad_offset);
+ /* FALLTHROUGH */
+
+ do_HV_vivify_rv2hv_helem:
+ case MDEREF_HV_vivify_rv2hv_helem: /* vivify, ->{...} */
+ /* this is the OPpDEREF action normally found at the end of
+ * ops like aelem, helem, rv2sv */
+ sv = vivify_ref(sv, OPpDEREF_HV);
+ /* FALLTHROUGH */
+
+ do_HV_rv2hv_helem:
+ /* this is basically a copy of pp_rv2hv when it just has the
+ * sKR/1 flags (and pp_rv2hv is aliased to pp_rv2av) */
+
+ SvGETMAGIC(sv);
+ if (LIKELY(SvROK(sv))) {
+ if (UNLIKELY(SvAMAGIC(sv))) {
+ sv = amagic_deref_call(sv, to_hv_amg);
+ }
+ sv = SvRV(sv);
+ if (UNLIKELY(SvTYPE(sv) != SVt_PVHV))
+ DIE(aTHX_ "Not a HASH reference");
+ }
+ else if (SvTYPE(sv) != SVt_PVHV) {
+ if (!isGV_with_GP(sv))
+ sv = (SV*)S_softref2xv_lite(aTHX_ sv, "a HASH", SVt_PVHV);
+ sv = MUTABLE_SV(GvHVn((GV*)sv));
+ }
+ /* FALLTHROUGH */
+
+ do_HV_helem:
+ {
+ /* retrieve the key; this may be either a lexical / package
+ * var or a string constant, whose index/ptr is stored as an
+ * item
+ */
+ SV *keysv = NULL; /* to shut up stupid compiler warnings */
+
+ assert(SvTYPE(sv) == SVt_PVHV);
+
+ switch (actions & MDEREF_INDEX_MASK) {
+ case MDEREF_INDEX_none:
+ goto finish;
+
+ case MDEREF_INDEX_const:
+ keysv = UNOP_AUX_item_sv(++items);
+ break;
+
+ case MDEREF_INDEX_padsv:
+ keysv = PAD_SVl((++items)->pad_offset);
+ break;
+
+ case MDEREF_INDEX_gvsv:
+ keysv = UNOP_AUX_item_sv(++items);
+ keysv = GvSVn((GV*)keysv);
+ break;
+ }
+
+ /* see comment above about setting this var */
+ PL_multideref_pc = items;
+
+
+ /* ensure that candidate CONSTs have been HEKified */
+ assert( ((actions & MDEREF_INDEX_MASK) != MDEREF_INDEX_const)
+ || SvTYPE(keysv) >= SVt_PVMG
+ || !SvOK(keysv)
+ || SvROK(keysv)
+ || SvIsCOW_shared_hash(keysv));
+
+ /* this is basically a copy of pp_helem with OPpDEREF skipped */
+
+ if (!(actions & MDEREF_FLAG_last)) {
+ HE *he = hv_fetch_ent((HV*)sv, keysv, 1, 0);
+ if (!he || !(sv=HeVAL(he)) || sv == &PL_sv_undef)
+ DIE(aTHX_ PL_no_helem_sv, SVfARG(keysv));
+ break;
+ }
+
+ if (PL_op->op_private &
+ (OPpMULTIDEREF_EXISTS|OPpMULTIDEREF_DELETE))
+ {
+ if (PL_op->op_private & OPpMULTIDEREF_EXISTS) {
+ sv = hv_exists_ent((HV*)sv, keysv, 0)
+ ? &PL_sv_yes : &PL_sv_no;
+ }
+ else {
+ I32 discard = (GIMME_V == G_VOID) ? G_DISCARD : 0;
+ sv = hv_delete_ent((HV*)sv, keysv, discard, 0);
+ if (discard)
+ return NORMAL;
+ if (!sv)
+ sv = &PL_sv_undef;
+ }
+ }
+ else {
+ const U32 lval = PL_op->op_flags & OPf_MOD || LVRET;
+ const U32 defer = PL_op->op_private & OPpLVAL_DEFER;
+ const bool localizing = PL_op->op_private & OPpLVAL_INTRO;
+ bool preeminent = TRUE;
+ SV **svp;
+ HV * const hv = (HV*)sv;
+ HE* he;
+
+ if (UNLIKELY(localizing)) {
+ MAGIC *mg;
+ HV *stash;
+
+ /* If we can determine whether the element exist,
+ * Try to preserve the existenceness of a tied hash
+ * element by using EXISTS and DELETE if possible.
+ * Fallback to FETCH and STORE otherwise. */
+ if (SvCANEXISTDELETE(hv))
+ preeminent = hv_exists_ent(hv, keysv, 0);
+ }
+
+ he = hv_fetch_ent(hv, keysv, lval && !defer, 0);
+ svp = he ? &HeVAL(he) : NULL;
+
+
+ if (lval) {
+ if (!svp || !(sv = *svp) || sv == &PL_sv_undef) {
+ SV* lv;
+ SV* key2;
+ if (!defer)
+ DIE(aTHX_ PL_no_helem_sv, SVfARG(keysv));
+ lv = sv_newmortal();
+ sv_upgrade(lv, SVt_PVLV);
+ LvTYPE(lv) = 'y';
+ sv_magic(lv, key2 = newSVsv(keysv),
+ PERL_MAGIC_defelem, NULL, 0);
+ /* sv_magic() increments refcount */
+ SvREFCNT_dec_NN(key2);
+ LvTARG(lv) = SvREFCNT_inc_simple(hv);
+ LvTARGLEN(lv) = 1;
+ sv = lv;
+ }
+ else {
+ if (localizing) {
+ if (HvNAME_get(hv) && isGV(sv))
+ save_gp(MUTABLE_GV(sv),
+ !(PL_op->op_flags & OPf_SPECIAL));
+ else if (preeminent) {
+ save_helem_flags(hv, keysv, svp,
+ (PL_op->op_flags & OPf_SPECIAL)
+ ? 0 : SAVEf_SETMAGIC);
+ sv = *svp; /* may have changed */
+ }
+ else
+ SAVEHDELETE(hv, keysv);
+ }
+ }
+ }
+ else {
+ sv = (svp && *svp ? *svp : &PL_sv_undef);
+ /* see note in pp_helem() */
+ if (SvRMAGICAL(hv) && SvGMAGICAL(sv))
+ mg_get(sv);
+ }
+ }
+ goto finish;
+ }
+
+ } /* switch */
+
+ actions >>= MDEREF_SHIFT;
+ } /* while */
+ /* NOTREACHED */
+}
+
+
PP(pp_iter)
{
dSP;
diff --git a/pp_proto.h b/pp_proto.h
index 6959357dd2..074f4ab8a3 100644
--- a/pp_proto.h
+++ b/pp_proto.h
@@ -157,6 +157,7 @@ PERL_CALLCONV OP *Perl_pp_method_redir_super(pTHX);
PERL_CALLCONV OP *Perl_pp_method_super(pTHX);
PERL_CALLCONV OP *Perl_pp_mkdir(pTHX);
PERL_CALLCONV OP *Perl_pp_modulo(pTHX);
+PERL_CALLCONV OP *Perl_pp_multideref(pTHX);
PERL_CALLCONV OP *Perl_pp_multiply(pTHX);
PERL_CALLCONV OP *Perl_pp_ncmp(pTHX);
PERL_CALLCONV OP *Perl_pp_ne(pTHX);
diff --git a/proto.h b/proto.h
index eb2ba5a9ad..f2be12dff5 100644
--- a/proto.h
+++ b/proto.h
@@ -4946,6 +4946,12 @@ PERL_CALLCONV UV Perl_to_utf8_case(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, S
PERL_CALLCONV bool Perl_try_amagic_bin(pTHX_ int method, int flags);
PERL_CALLCONV bool Perl_try_amagic_un(pTHX_ int method, int flags);
+PERL_CALLCONV SV* Perl_unop_aux_stringify(pTHX_ const OP* o, CV *cv)
+ __attribute__nonnull__(pTHX_1)
+ __attribute__nonnull__(pTHX_2);
+#define PERL_ARGS_ASSERT_UNOP_AUX_STRINGIFY \
+ assert(o); assert(cv)
+
PERL_CALLCONV I32 Perl_unpack_str(pTHX_ const char *pat, const char *patend, const char *s, const char *strbeg, const char *strend, char **new_s, I32 ocnt, U32 flags)
__attribute__nonnull__(pTHX_1)
__attribute__nonnull__(pTHX_2)
@@ -7543,7 +7549,11 @@ STATIC SV * S_find_hash_subscript(pTHX_ const HV *const hv, const SV *const val)
#define PERL_ARGS_ASSERT_FIND_HASH_SUBSCRIPT \
assert(val)
-STATIC SV* S_find_uninit_var(pTHX_ const OP *const obase, const SV *const uninit_sv, bool top);
+STATIC SV* S_find_uninit_var(pTHX_ const OP *const obase, const SV *const uninit_sv, bool match, const char **desc_p)
+ __attribute__nonnull__(pTHX_4);
+#define PERL_ARGS_ASSERT_FIND_UNINIT_VAR \
+ assert(desc_p)
+
STATIC bool S_glob_2number(pTHX_ GV* const gv)
__attribute__nonnull__(pTHX_1);
#define PERL_ARGS_ASSERT_GLOB_2NUMBER \
diff --git a/regen/op_private b/regen/op_private
index 731c4fb490..4b7c42522e 100644
--- a/regen/op_private
+++ b/regen/op_private
@@ -299,7 +299,7 @@ for (qw(nextstate dbstate)) {
addbits($_, 7 => qw(OPpLVAL_INTRO LVINTRO))
for qw(gvsv rv2sv rv2hv rv2gv rv2av aelem helem aslice
hslice delete padsv padav padhv enteriter entersub padrange
- pushmark cond_expr refassign lvref lvrefslice lvavref),
+ pushmark cond_expr refassign lvref lvrefslice lvavref multideref),
'list', # this gets set in my_attrs() for some reason
;
@@ -418,7 +418,7 @@ for (qw(rv2gv rv2sv padsv aelem helem entersub)) {
# Defer creation of array/hash elem
-addbits($_, 6 => qw(OPpLVAL_DEFER LVDEFER)) for qw(aelem helem);
+addbits($_, 6 => qw(OPpLVAL_DEFER LVDEFER)) for qw(aelem helem multideref);
@@ -437,7 +437,7 @@ addbits($_, 6 => qw(OPpOUR_INTRO OURINTR)) # Variable was in an our()
# We might be an lvalue to return
addbits($_, 3 => qw(OPpMAYBE_LVSUB LVSUB))
for qw(aassign rv2av rv2gv rv2hv padav padhv aelem helem aslice hslice
- av2arylen keys rkeys kvaslice kvhslice substr pos vec);
+ av2arylen keys rkeys kvaslice kvhslice substr pos vec multideref);
@@ -450,7 +450,8 @@ for (qw(rv2hv padhv)) {
-addbits($_, 1 => qw(OPpHINT_STRICT_REFS STRICT)) for qw(rv2sv rv2av rv2hv rv2gv);
+addbits($_, 1 => qw(OPpHINT_STRICT_REFS STRICT))
+ for qw(rv2sv rv2av rv2hv rv2gv multideref);
@@ -734,6 +735,13 @@ addbits($_,
#7 => qw(OPpLVAL_INTRO LVINTRO),
) for 'refassign', 'lvref';
+
+
+addbits('multideref',
+ 4 => qw(OPpMULTIDEREF_EXISTS EXISTS), # deref is actually exists
+ 5 => qw(OPpMULTIDEREF_DELETE DELETE), # deref is actually delete
+);
+
1;
# ex: set ts=8 sts=4 sw=4 et:
diff --git a/regen/opcodes b/regen/opcodes
index 4731fa7b56..49e6c297cc 100644
--- a/regen/opcodes
+++ b/regen/opcodes
@@ -236,6 +236,10 @@ helem hash element ck_null s2 H S
hslice hash slice ck_null m@ H L
kvhslice key/value hash slice ck_null m@ H L
+# mixed array and hash access
+
+multideref array or hash lookup ck_null ds+
+
# Explosives and implosives.
unpack unpack ck_fun u@ S S?
diff --git a/sv.c b/sv.c
index 5a73d9565c..b08899fc99 100644
--- a/sv.c
+++ b/sv.c
@@ -15456,6 +15456,8 @@ warning, then following the direct child of the op may yield an
OP_PADSV or OP_GV that gives the name of the undefined variable. On the
other hand, with OP_ADD there are two branches to follow, so we only print
the variable name if we get an exact match.
+desc_p points to a string pointer holding the description of the op.
+This may be updated if needed.
The name is returned as a mortal SV.
@@ -15467,13 +15469,15 @@ PL_comppad/PL_curpad points to the currently executing pad.
STATIC SV *
S_find_uninit_var(pTHX_ const OP *const obase, const SV *const uninit_sv,
- bool match)
+ bool match, const char **desc_p)
{
dVAR;
SV *sv;
const GV *gv;
const OP *o, *o2, *kid;
+ PERL_ARGS_ASSERT_FIND_UNINIT_VAR;
+
if (!obase || (match && (!uninit_sv || uninit_sv == &PL_sv_undef ||
uninit_sv == &PL_sv_placeholder)))
return NULL;
@@ -15513,7 +15517,7 @@ S_find_uninit_var(pTHX_ const OP *const obase, const SV *const uninit_sv,
}
else if (obase == PL_op) /* @{expr}, %{expr} */
return find_uninit_var(cUNOPx(obase)->op_first,
- uninit_sv, match);
+ uninit_sv, match, desc_p);
else /* @{expr}, %{expr} as a sub-expression */
return NULL;
}
@@ -15548,7 +15552,7 @@ S_find_uninit_var(pTHX_ const OP *const obase, const SV *const uninit_sv,
return varname(gv, '$', 0, NULL, 0, FUV_SUBSCRIPT_NONE);
}
/* ${expr} */
- return find_uninit_var(cUNOPx(obase)->op_first, uninit_sv, 1);
+ return find_uninit_var(cUNOPx(obase)->op_first, uninit_sv, 1, desc_p);
case OP_PADSV:
if (match && PAD_SVl(obase->op_targ) != uninit_sv)
@@ -15598,7 +15602,7 @@ S_find_uninit_var(pTHX_ const OP *const obase, const SV *const uninit_sv,
if (!o || o->op_type != OP_NULL ||
! (o->op_targ == OP_AELEM || o->op_targ == OP_HELEM))
break;
- return find_uninit_var(cBINOPo->op_last, uninit_sv, match);
+ return find_uninit_var(cBINOPo->op_last, uninit_sv, match, desc_p);
case OP_AELEM:
case OP_HELEM:
@@ -15607,7 +15611,8 @@ S_find_uninit_var(pTHX_ const OP *const obase, const SV *const uninit_sv,
if (PL_op == obase)
/* $a[uninit_expr] or $h{uninit_expr} */
- return find_uninit_var(cBINOPx(obase)->op_last, uninit_sv, match);
+ return find_uninit_var(cBINOPx(obase)->op_last,
+ uninit_sv, match, desc_p);
gv = NULL;
o = cBINOPx(obase)->op_first;
@@ -15696,9 +15701,205 @@ S_find_uninit_var(pTHX_ const OP *const obase, const SV *const uninit_sv,
NOT_REACHED; /* NOTREACHED */
}
+ case OP_MULTIDEREF: {
+ /* If we were executing OP_MULTIDEREF when the undef warning
+ * triggered, then it must be one of the index values within
+ * that triggered it. If not, then the only possibility is that
+ * the value retrieved by the last aggregate lookup might be the
+ * culprit. For the former, we set PL_multideref_pc each time before
+ * using an index, so work though the item list until we reach
+ * that point. For the latter, just work through the entire item
+ * list; the last aggregate retrieved will be the candidate.
+ */
+
+ /* the named aggregate, if any */
+ PADOFFSET agg_targ = 0;
+ GV *agg_gv = NULL;
+ /* the last-seen index */
+ UV index_type;
+ PADOFFSET index_targ;
+ GV *index_gv;
+ IV index_const_iv = 0; /* init for spurious compiler warn */
+ SV *index_const_sv;
+ int depth = 0; /* how many array/hash lookups we've done */
+
+ UNOP_AUX_item *items = cUNOP_AUXx(obase)->op_aux;
+ UNOP_AUX_item *last = NULL;
+ UV actions = items->uv;
+ bool is_hv;
+
+ if (PL_op == obase) {
+ last = PL_multideref_pc;
+ assert(last >= items && last <= items + items[-1].uv);
+ }
+
+ assert(actions);
+
+ while (1) {
+ is_hv = FALSE;
+ switch (actions & MDEREF_ACTION_MASK) {
+
+ case MDEREF_reload:
+ actions = (++items)->uv;
+ continue;
+
+ case MDEREF_HV_padhv_helem: /* $lex{...} */
+ is_hv = TRUE;
+ /* FALLTHROUGH */
+ case MDEREF_AV_padav_aelem: /* $lex[...] */
+ agg_targ = (++items)->pad_offset;
+ agg_gv = NULL;
+ break;
+
+ case MDEREF_HV_gvhv_helem: /* $pkg{...} */
+ is_hv = TRUE;
+ /* FALLTHROUGH */
+ case MDEREF_AV_gvav_aelem: /* $pkg[...] */
+ agg_targ = 0;
+ agg_gv = (GV*)UNOP_AUX_item_sv(++items);
+ assert(isGV_with_GP(agg_gv));
+ break;
+
+ case MDEREF_HV_gvsv_vivify_rv2hv_helem: /* $pkg->{...} */
+ case MDEREF_HV_padsv_vivify_rv2hv_helem: /* $lex->{...} */
+ ++items;
+ /* FALLTHROUGH */
+ case MDEREF_HV_pop_rv2hv_helem: /* expr->{...} */
+ case MDEREF_HV_vivify_rv2hv_helem: /* vivify, ->{...} */
+ agg_targ = 0;
+ agg_gv = NULL;
+ is_hv = TRUE;
+ break;
+
+ case MDEREF_AV_gvsv_vivify_rv2av_aelem: /* $pkg->[...] */
+ case MDEREF_AV_padsv_vivify_rv2av_aelem: /* $lex->[...] */
+ ++items;
+ /* FALLTHROUGH */
+ case MDEREF_AV_pop_rv2av_aelem: /* expr->[...] */
+ case MDEREF_AV_vivify_rv2av_aelem: /* vivify, ->[...] */
+ agg_targ = 0;
+ agg_gv = NULL;
+ } /* switch */
+
+ index_targ = 0;
+ index_gv = NULL;
+ index_const_sv = NULL;
+
+ index_type = (actions & MDEREF_INDEX_MASK);
+ switch (index_type) {
+ case MDEREF_INDEX_none:
+ break;
+ case MDEREF_INDEX_const:
+ if (is_hv)
+ index_const_sv = UNOP_AUX_item_sv(++items)
+ else
+ index_const_iv = (++items)->iv;
+ break;
+ case MDEREF_INDEX_padsv:
+ index_targ = (++items)->pad_offset;
+ break;
+ case MDEREF_INDEX_gvsv:
+ index_gv = (GV*)UNOP_AUX_item_sv(++items);
+ assert(isGV_with_GP(index_gv));
+ break;
+ }
+
+ if (index_type != MDEREF_INDEX_none)
+ depth++;
+
+ if ( index_type == MDEREF_INDEX_none
+ || (actions & MDEREF_FLAG_last)
+ || (last && items == last)
+ )
+ break;
+
+ actions >>= MDEREF_SHIFT;
+ } /* while */
+
+ if (PL_op == obase) {
+ /* index was undef */
+
+ *desc_p = ( (actions & MDEREF_FLAG_last)
+ && (obase->op_private
+ & (OPpMULTIDEREF_EXISTS|OPpMULTIDEREF_DELETE)))
+ ?
+ (obase->op_private & OPpMULTIDEREF_EXISTS)
+ ? "exists"
+ : "delete"
+ : is_hv ? "hash element" : "array element";
+ assert(index_type != MDEREF_INDEX_none);
+ if (index_gv)
+ return varname(index_gv, '$', 0, NULL, 0, FUV_SUBSCRIPT_NONE);
+ if (index_targ)
+ return varname(NULL, '$', index_targ,
+ NULL, 0, FUV_SUBSCRIPT_NONE);
+ assert(is_hv); /* AV index is an IV and can't be undef */
+ /* can a const HV index ever be undef? */
+ return NULL;
+ }
+
+ /* the SV returned by pp_multideref() was undef, if anything was */
+
+ if (depth != 1)
+ break;
+
+ if (agg_targ)
+ sv = PAD_SV(agg_targ);
+ else if (agg_gv)
+ sv = is_hv ? MUTABLE_SV(GvHV(agg_gv)) : MUTABLE_SV(GvAV(agg_gv));
+ else
+ break;
+
+ if (index_type == MDEREF_INDEX_const) {
+ if (match) {
+ if (SvMAGICAL(sv))
+ break;
+ if (is_hv) {
+ HE* he = hv_fetch_ent(MUTABLE_HV(sv), index_const_sv, 0, 0);
+ if (!he || HeVAL(he) != uninit_sv)
+ break;
+ }
+ else {
+ SV * const * const svp =
+ av_fetch(MUTABLE_AV(sv), index_const_iv, FALSE);
+ if (!svp || *svp != uninit_sv)
+ break;
+ }
+ }
+ return is_hv
+ ? varname(agg_gv, '%', agg_targ,
+ index_const_sv, 0, FUV_SUBSCRIPT_HASH)
+ : varname(agg_gv, '@', agg_targ,
+ NULL, index_const_iv, FUV_SUBSCRIPT_ARRAY);
+ }
+ else {
+ /* index is an var */
+ if (is_hv) {
+ SV * const keysv = find_hash_subscript((const HV*)sv, uninit_sv);
+ if (keysv)
+ return varname(agg_gv, '%', agg_targ,
+ keysv, 0, FUV_SUBSCRIPT_HASH);
+ }
+ else {
+ const I32 index
+ = find_array_subscript((const AV *)sv, uninit_sv);
+ if (index >= 0)
+ return varname(agg_gv, '@', agg_targ,
+ NULL, index, FUV_SUBSCRIPT_ARRAY);
+ }
+ if (match)
+ break;
+ return varname(agg_gv,
+ is_hv ? '%' : '@',
+ agg_targ, NULL, 0, FUV_SUBSCRIPT_WITHIN);
+ }
+ NOT_REACHED; /* NOTREACHED */
+ }
+
case OP_AASSIGN:
/* only examine RHS */
- return find_uninit_var(cBINOPx(obase)->op_first, uninit_sv, match);
+ return find_uninit_var(cBINOPx(obase)->op_first, uninit_sv,
+ match, desc_p);
case OP_OPEN:
o = cUNOPx(obase)->op_first;
@@ -15897,11 +16098,11 @@ S_find_uninit_var(pTHX_ const OP *const obase, const SV *const uninit_sv,
o2 = kid;
}
if (o2)
- return find_uninit_var(o2, uninit_sv, match);
+ return find_uninit_var(o2, uninit_sv, match, desc_p);
/* scan all args */
while (o) {
- sv = find_uninit_var(o, uninit_sv, 1);
+ sv = find_uninit_var(o, uninit_sv, 1, desc_p);
if (sv)
return sv;
o = OP_SIBLING(o);
@@ -15926,14 +16127,15 @@ Perl_report_uninit(pTHX_ const SV *uninit_sv)
if (PL_op) {
SV* varname = NULL;
const char *desc;
+
+ desc = PL_op->op_type == OP_STRINGIFY && PL_op->op_folded
+ ? "join or string"
+ : OP_DESC(PL_op);
if (uninit_sv && PL_curpad) {
- varname = find_uninit_var(PL_op, uninit_sv,0);
+ varname = find_uninit_var(PL_op, uninit_sv, 0, &desc);
if (varname)
sv_insert(varname, 0, 0, " ", 1);
}
- desc = PL_op->op_type == OP_STRINGIFY && PL_op->op_folded
- ? "join or string"
- : OP_DESC(PL_op);
/* PL_warn_uninit_sv is constant */
GCC_DIAG_IGNORE(-Wformat-nonliteral);
/* diag_listed_as: Use of uninitialized value%s */
diff --git a/t/lib/warnings/9uninit b/t/lib/warnings/9uninit
index c1a1dfcfc6..d26d6ca0ba 100644
--- a/t/lib/warnings/9uninit
+++ b/t/lib/warnings/9uninit
@@ -2091,3 +2091,80 @@ tie $t, "";
$v = 1.1 * $t; # sv_2nv on a tied regexp
EXPECT
+########
+# multi-level uninitialised array/hash indexes
+use warnings 'uninitialized';
+
+our ($i0, $i2, $i4, $i6, $i8, $i10, $i12);
+my ($i1, $i3, $i5, $i7, $i9, $i11, $i13);
+
+my (@a,%h);
+my $v;
+
+
+# use enough depth that OP_MULTIDEREF needs more than one action word
+
+$v = $a[$i0]{$i1}[$i2]{$i3}[$i4]{$i5}[$i6]{$i7}[$i8]{$i9}[$i10]{$i11}[$i12]{$i13};
+$v = $h{$i0}[$i1]{$i2}[$i3]{$i4}[$i5]{$i6}[$i7]{$i8}[$i9]{$i10}[$i11]{$i12}[$i13];
+
+EXPECT
+Use of uninitialized value $i0 in array element at - line 13.
+Use of uninitialized value $i1 in hash element at - line 13.
+Use of uninitialized value $i2 in array element at - line 13.
+Use of uninitialized value $i3 in hash element at - line 13.
+Use of uninitialized value $i4 in array element at - line 13.
+Use of uninitialized value $i5 in hash element at - line 13.
+Use of uninitialized value $i6 in array element at - line 13.
+Use of uninitialized value $i7 in hash element at - line 13.
+Use of uninitialized value $i8 in array element at - line 13.
+Use of uninitialized value $i9 in hash element at - line 13.
+Use of uninitialized value $i10 in array element at - line 13.
+Use of uninitialized value $i11 in hash element at - line 13.
+Use of uninitialized value $i12 in array element at - line 13.
+Use of uninitialized value $i13 in hash element at - line 13.
+Use of uninitialized value $i0 in hash element at - line 14.
+Use of uninitialized value $i1 in array element at - line 14.
+Use of uninitialized value $i2 in hash element at - line 14.
+Use of uninitialized value $i3 in array element at - line 14.
+Use of uninitialized value $i4 in hash element at - line 14.
+Use of uninitialized value $i5 in array element at - line 14.
+Use of uninitialized value $i6 in hash element at - line 14.
+Use of uninitialized value $i7 in array element at - line 14.
+Use of uninitialized value $i8 in hash element at - line 14.
+Use of uninitialized value $i9 in array element at - line 14.
+Use of uninitialized value $i10 in hash element at - line 14.
+Use of uninitialized value $i11 in array element at - line 14.
+Use of uninitialized value $i12 in hash element at - line 14.
+Use of uninitialized value $i13 in array element at - line 14.
+########
+# misc multideref
+use warnings 'uninitialized';
+my ($i,$j,$k);
+my @a;
+my @ra = \@a;
+my $v;
+$v = exists $a[$i]{$k};
+$v = delete $a[$i]{$k};
+$v = local $a[$i]{$k};
+delete $a[$i]{$k};
+$v = $ra->[$i+$j]{$k};
+$v = ($ra//0)->[$i]{$k};
+$v = $a[length $i]{$k}
+EXPECT
+Use of uninitialized value $i in array element at - line 7.
+Use of uninitialized value $k in exists at - line 7.
+Use of uninitialized value $i in array element at - line 8.
+Use of uninitialized value $k in delete at - line 8.
+Use of uninitialized value $i in array element at - line 9.
+Use of uninitialized value $k in hash element at - line 9.
+Use of uninitialized value $k in hash element at - line 9.
+Use of uninitialized value $k in hash element at - line 9.
+Use of uninitialized value $i in array element at - line 10.
+Use of uninitialized value $k in delete at - line 10.
+Use of uninitialized value $j in addition (+) at - line 11.
+Use of uninitialized value $i in addition (+) at - line 11.
+Use of uninitialized value $k in hash element at - line 11.
+Use of uninitialized value $i in array element at - line 12.
+Use of uninitialized value $k in hash element at - line 12.
+Use of uninitialized value $i in array element at - line 13.
+Use of uninitialized value $k in hash element at - line 13.
diff --git a/t/op/multideref.t b/t/op/multideref.t
new file mode 100644
index 0000000000..1ae0843aa8
--- /dev/null
+++ b/t/op/multideref.t
@@ -0,0 +1,187 @@
+#!./perl
+#
+# test OP_MULTIDEREF.
+#
+# This optimising op is used when one or more array or hash aggregate
+# lookups / derefs are performed, and where each key/index is a simple
+# constant or scalar var; e.g.
+#
+# $r->{foo}[0]{$k}[$i]
+
+
+BEGIN {
+ chdir 't';
+ require './test.pl';
+ set_up_inc("../lib");
+}
+
+use warnings;
+use strict;
+
+plan 56;
+
+
+# check that strict refs hint is handled
+
+{
+ package strict_refs;
+
+ our %foo;
+ my @a = ('foo');
+ eval {
+ $a[0]{k} = 7;
+ };
+ ::like($@, qr/Can't use string/, "strict refs");
+ ::ok(!exists $foo{k}, "strict refs, not exist");
+
+ no strict 'refs';
+
+ $a[0]{k} = 13;
+ ::is($foo{k}, 13, "no strict refs, exist");
+}
+
+# check the basics of multilevel lookups
+
+{
+ package basic;
+
+ # build up the multi-level structure piecemeal to try and avoid
+ # relying on what we're testing
+
+ my @a;
+ my $r = \@a;
+ my $rh = {};
+ my $ra = [];
+ my %h = qw(a 1 b 2 c 3 d 4 e 5 f 6);
+ push @a, 66, 77, 'abc', $rh;
+ %$rh = (foo => $ra, bar => 'BAR');
+ push @$ra, 'def', \%h;
+
+ our ($i1, $i2, $k1, $k2) = (3, 1, 'foo', 'c');
+ my ($li1, $li2, $lk1, $lk2) = (3, 1, 'foo', 'c');
+ my $z = 0;
+
+ # fetch
+
+ ::is($a[3]{foo}[1]{c}, 3, 'fetch: const indices');
+ ::is($a[$i1]{$k1}[$i2]{$k2}, 3, 'fetch: pkg indices');
+ ::is($r->[$i1]{$k1}[$i2]{$k2}, 3, 'fetch: deref pkg indices');
+ ::is($a[$li1]{$lk1}[$li2]{$lk2}, 3, 'fetch: lexical indices');
+ ::is($r->[$li1]{$lk1}[$li2]{$lk2}, 3, 'fetch: deref lexical indices');
+ ::is(($r//0)->[$li1]{$lk1}[$li2+$z]{$lk2}, 3,
+ 'fetch: general expression and index');
+
+
+ # store
+
+ ::is($a[3]{foo}[1]{c} = 5, 5, 'store: const indices');
+ ::is($a[3]{foo}[1]{c}, 5, 'store: const indices 2');
+ ::is($a[$i1]{$k1}[$i2]{$k2} = 7, 7, 'store: pkg indices');
+ ::is($a[$i1]{$k1}[$i2]{$k2}, 7, 'store: pkg indices 2');
+ ::is($r->[$i1]{$k1}[$i2]{$k2} = 9, 9, 'store: deref pkg indices');
+ ::is($r->[$i1]{$k1}[$i2]{$k2}, 9, 'store: deref pkg indices 2');
+ ::is($a[$li1]{$lk1}[$li2]{$lk2} = 11, 11, 'store: lexical indices');
+ ::is($a[$li1]{$lk1}[$li2]{$lk2}, 11, 'store: lexical indices 2');
+ ::is($r->[$li1]{$lk1}[$li2]{$lk2} = 13, 13, 'store: deref lexical indices');
+ ::is($r->[$li1]{$lk1}[$li2]{$lk2}, 13, 'store: deref lexical indices 2');
+ ::is(($r//0)->[$li1]{$lk1}[$li2+$z]{$lk2} = 15, 15,
+ 'store: general expression and index');
+ ::is(($r//0)->[$li1]{$lk1}[$li2+$z]{$lk2}, 15,
+ 'store: general expression and index 2');
+
+
+ # local
+
+ {
+ ::is(local $a[3]{foo}[1]{c} = 19, 19, 'local const indices');
+ ::is($a[3]{foo}[1]{c}, 19, 'local const indices 2');
+ }
+ ::is($a[3]{foo}[1]{c}, 15, 'local const indices 3');
+ {
+ ::is(local $a[$i1]{$k1}[$i2]{$k2} = 21, 21, 'local pkg indices');
+ ::is($a[$i1]{$k1}[$i2]{$k2}, 21, 'local pkg indices 2');
+ }
+ ::is($a[$i1]{$k1}[$i2]{$k2}, 15, 'local pkg indices 3');
+ {
+ ::is(local $a[$li1]{$lk1}[$li2]{$lk2} = 23, 23, 'local lexical indices');
+ ::is($a[$li1]{$lk1}[$li2]{$lk2}, 23, 'local lexical indices 2');
+ }
+ ::is($a[$li1]{$lk1}[$li2]{$lk2}, 15, 'local lexical indices 3');
+ {
+ ::is(local+($r//0)->[$li1]{$lk1}[$li2+$z]{$lk2} = 25, 25,
+ 'local general');
+ ::is(($r//0)->[$li1]{$lk1}[$li2+$z]{$lk2}, 25, 'local general 2');
+ }
+ ::is(($r//0)->[$li1]{$lk1}[$li2+$z]{$lk2}, 15, 'local general 3');
+
+
+ # exists
+
+ ::ok(exists $a[3]{foo}[1]{c}, 'exists: const indices');
+ ::ok(exists $a[$i1]{$k1}[$i2]{$k2}, 'exists: pkg indices');
+ ::ok(exists $r->[$i1]{$k1}[$i2]{$k2}, 'exists: deref pkg indices');
+ ::ok(exists $a[$li1]{$lk1}[$li2]{$lk2}, 'exists: lexical indices');
+ ::ok(exists $r->[$li1]{$lk1}[$li2]{$lk2}, 'exists: deref lexical indices');
+ ::ok(exists +($r//0)->[$li1]{$lk1}[$li2+$z]{$lk2}, 'exists: general');
+
+ # delete
+
+ our $k3 = 'a';
+ my $lk4 = 'b';
+ ::is(delete $a[3]{foo}[1]{c}, 15, 'delete: const indices');
+ ::is(delete $a[$i1]{$k1}[$i2]{$k3}, 1, 'delete: pkg indices');
+ ::is(delete $r->[$i1]{$k1}[$i2]{d}, 4, 'delete: deref pkg indices');
+ ::is(delete $a[$li1]{$lk1}[$li2]{$lk4}, 2, 'delete: lexical indices');
+ ::is(delete $r->[$li1]{$lk1}[$li2]{e}, 5, 'delete: deref lexical indices');
+ ::is(delete +($r//0)->[$li1]{$lk1}[$li2+$z]{f}, 6, 'delete: general');
+
+ # !exists
+
+ ::ok(!exists $a[3]{foo}[1]{c}, '!exists: const indices');
+ ::ok(!exists $a[$i1]{$k1}[$i2]{$k3}, '!exists: pkg indices');
+ ::ok(!exists $r->[$i1]{$k1}[$i2]{$k3}, '!exists: deref pkg indices');
+ ::ok(!exists $a[$li1]{$lk1}[$li2]{$lk4}, '!exists: lexical indices');
+ ::ok(!exists $r->[$li1]{$lk1}[$li2]{$lk4},'!exists: deref lexical indices');
+ ::ok(!exists +($r//0)->[$li1]{$lk1}[$li2+$z]{$lk4},'!exists: general');
+}
+
+
+# weird "constant" keys
+
+{
+ use constant my_undef => undef;
+ use constant my_ref => [];
+ no warnings 'uninitialized';
+ my %h1;
+ $h1{+my_undef} = 1;
+ is(join(':', keys %h1), '', "+my_undef");
+ my %h2;
+ $h2{+my_ref} = 1;
+ like(join(':', keys %h2), qr/x/, "+my_ref");
+}
+
+
+
+{
+ # test that multideref is marked OA_DANGEROUS, i.e. its one of the ops
+ # that should set the OPpASSIGN_COMMON flag in list assignments
+
+ my $x = {};
+ $x->{a} = [ 1 ];
+ $x->{b} = [ 2 ];
+ ($x->{a}, $x->{b}) = ($x->{b}, $x->{a});
+ is($x->{a}[0], 2, "OA_DANGEROUS a");
+ is($x->{b}[0], 1, "OA_DANGEROUS b");
+}
+
+# defer
+
+
+sub defer {}
+
+{
+ my %h;
+ $h{foo} = {};
+ defer($h{foo}{bar});
+ ok(!exists $h{foo}{bar}, "defer");
+}
diff --git a/t/op/svleak.t b/t/op/svleak.t
index 8d42265b8f..076f2bfdaf 100644
--- a/t/op/svleak.t
+++ b/t/op/svleak.t
@@ -15,7 +15,7 @@ BEGIN {
use Config;
-plan tests => 128;
+plan tests => 129;
# run some code N times. If the number of SVs at the end of loop N is
# greater than (N-1)*delta at the end of loop 1, we've got a leak
@@ -479,3 +479,17 @@ leak(2,0,sub{eval{require untohunothu}}, 'requiring nonexistent module');
# [perl #120939]
use constant const_av_xsub_leaked => 1 .. 3;
leak(5, 0, sub { scalar &const_av_xsub_leaked }, "const_av_sub in scalar context");
+
+# check that OP_MULTIDEREF doesn't leak when compiled and then freed
+
+eleak(2, 0, <<'EOF', 'OP_MULTIDEREF');
+no strict;
+no warnings;
+my ($x, @a, %h, $r, $k, $i);
+$x = $a[0]{foo}{$k}{$i};
+$x = $h[0]{foo}{$k}{$i};
+$x = $r->[0]{foo}{$k}{$i};
+$x = $mdr::a[0]{foo}{$mdr::k}{$mdr::i};
+$x = $mdr::h[0]{foo}{$mdr::k}{$mdr::i};
+$x = $mdr::r->[0]{foo}{$mdr::k}{$mdr::i};
+EOF
diff --git a/t/perf/benchmarks b/t/perf/benchmarks
index 52e2af9400..1e4cd72533 100644
--- a/t/perf/benchmarks
+++ b/t/perf/benchmarks
@@ -59,6 +59,95 @@
code => 'f(1,2,3)',
},
+
+ 'expr::array::lex_1const_0' => {
+ desc => 'lexical $array[0]',
+ setup => 'my @a = (1)',
+ code => '$a[0]',
+ },
+ 'expr::array::lex_1const_m1' => {
+ desc => 'lexical $array[-1]',
+ setup => 'my @a = (1)',
+ code => '$a[-1]',
+ },
+ 'expr::array::lex_2const' => {
+ desc => 'lexical $array[const][const]',
+ setup => 'my @a = ([1,2])',
+ code => '$a[0][1]',
+ },
+ 'expr::array::lex_2var' => {
+ desc => 'lexical $array[$i1][$i2]',
+ setup => 'my ($i1,$i2) = (0,1); my @a = ([1,2])',
+ code => '$a[$i1][$i2]',
+ },
+ 'expr::array::ref_lex_2var' => {
+ desc => 'lexical $arrayref->[$i1][$i2]',
+ setup => 'my ($i1,$i2) = (0,1); my $r = [[1,2]]',
+ code => '$r->[$i1][$i2]',
+ },
+ 'expr::array::ref_lex_3const' => {
+ desc => 'lexical $arrayref->[const][const][const]',
+ setup => 'my $r = [[[1,2]]]',
+ code => '$r->[0][0][0]',
+ },
+ 'expr::array::ref_expr_lex_3const' => {
+ desc => '(lexical expr)->[const][const][const]',
+ setup => 'my $r = [[[1,2]]]',
+ code => '($r//0)->[0][0][0]',
+ },
+
+
+ 'expr::array::pkg_1const_0' => {
+ desc => 'package $array[0]',
+ setup => 'our @a = (1)',
+ code => '$a[0]',
+ },
+ 'expr::array::pkg_1const_m1' => {
+ desc => 'package $array[-1]',
+ setup => 'our @a = (1)',
+ code => '$a[-1]',
+ },
+ 'expr::array::pkg_2const' => {
+ desc => 'package $array[const][const]',
+ setup => 'our @a = ([1,2])',
+ code => '$a[0][1]',
+ },
+ 'expr::array::pkg_2var' => {
+ desc => 'package $array[$i1][$i2]',
+ setup => 'our ($i1,$i2) = (0,1); our @a = ([1,2])',
+ code => '$a[$i1][$i2]',
+ },
+ 'expr::array::ref_pkg_2var' => {
+ desc => 'package $arrayref->[$i1][$i2]',
+ setup => 'our ($i1,$i2) = (0,1); our $r = [[1,2]]',
+ code => '$r->[$i1][$i2]',
+ },
+ 'expr::array::ref_pkg_3const' => {
+ desc => 'package $arrayref->[const][const][const]',
+ setup => 'our $r = [[[1,2]]]',
+ code => '$r->[0][0][0]',
+ },
+ 'expr::array::ref_expr_pkg_3const' => {
+ desc => '(package expr)->[const][const][const]',
+ setup => 'our $r = [[[1,2]]]',
+ code => '($r//0)->[0][0][0]',
+ },
+
+
+ 'expr::arrayhash::lex_3var' => {
+ desc => 'lexical $h{$k1}[$i]{$k2}',
+ setup => 'my ($i, $k1, $k2) = (0,"foo","bar");'
+ . 'my %h = (foo => [ { bar => 1 } ])',
+ code => '$h{$k1}[$i]{$k2}',
+ },
+ 'expr::arrayhash::pkg_3var' => {
+ desc => 'package $h{$k1}[$i]{$k2}',
+ setup => 'our ($i, $k1, $k2) = (0,"foo","bar");'
+ . 'our %h = (foo => [ { bar => 1 } ])',
+ code => '$h{$k1}[$i]{$k2}',
+ },
+
+
'expr::assign::scalar_lex' => {
desc => 'lexical $x = 1',
setup => 'my $x',
@@ -70,10 +159,87 @@
code => '($x, $y) = (1, 2)',
},
+
+ 'expr::hash::lex_1const' => {
+ desc => 'lexical $hash{const}',
+ setup => 'my %h = ("foo" => 1)',
+ code => '$h{foo}',
+ },
+ 'expr::hash::lex_2const' => {
+ desc => 'lexical $hash{const}{const}',
+ setup => 'my %h = (foo => { bar => 1 })',
+ code => '$h{foo}{bar}',
+ },
+ 'expr::hash::lex_2var' => {
+ desc => 'lexical $hash{$k1}{$k2}',
+ setup => 'my ($k1,$k2) = qw(foo bar); my %h = ($k1 => { $k2 => 1 })',
+ code => '$h{$k1}{$k2}',
+ },
+ 'expr::hash::ref_lex_2var' => {
+ desc => 'lexical $hashref->{$k1}{$k2}',
+ setup => 'my ($k1,$k2) = qw(foo bar); my $r = {$k1 => { $k2 => 1 }}',
+ code => '$r->{$k1}{$k2}',
+ },
+ 'expr::hash::ref_lex_3const' => {
+ desc => 'lexical $hashref->{const}{const}{const}',
+ setup => 'my $r = {foo => { bar => { baz => 1 }}}',
+ code => '$r->{foo}{bar}{baz}',
+ },
+ 'expr::hash::ref_expr_lex_3const' => {
+ desc => '(lexical expr)->{const}{const}{const}',
+ setup => 'my $r = {foo => { bar => { baz => 1 }}}',
+ code => '($r//0)->{foo}{bar}{baz}',
+ },
+
+
+ 'expr::hash::pkg_1const' => {
+ desc => 'package $hash{const}',
+ setup => 'our %h = ("foo" => 1)',
+ code => '$h{foo}',
+ },
+ 'expr::hash::pkg_2const' => {
+ desc => 'package $hash{const}{const}',
+ setup => 'our %h = (foo => { bar => 1 })',
+ code => '$h{foo}{bar}',
+ },
+ 'expr::hash::pkg_2var' => {
+ desc => 'package $hash{$k1}{$k2}',
+ setup => 'our ($k1,$k2) = qw(foo bar); our %h = ($k1 => { $k2 => 1 })',
+ code => '$h{$k1}{$k2}',
+ },
+ 'expr::hash::ref_pkg_2var' => {
+ desc => 'package $hashref->{$k1}{$k2}',
+ setup => 'our ($k1,$k2) = qw(foo bar); our $r = {$k1 => { $k2 => 1 }}',
+ code => '$r->{$k1}{$k2}',
+ },
+ 'expr::hash::ref_pkg_3const' => {
+ desc => 'package $hashref->{const}{const}{const}',
+ setup => 'our $r = {foo => { bar => { baz => 1 }}}',
+ code => '$r->{foo}{bar}{baz}',
+ },
+ 'expr::hash::ref_expr_pkg_3const' => {
+ desc => '(package expr)->{const}{const}{const}',
+ setup => 'our $r = {foo => { bar => { baz => 1 }}}',
+ code => '($r//0)->{foo}{bar}{baz}',
+ },
+
+
+ 'expr::hash::exists_lex_2var' => {
+ desc => 'lexical exists $hash{$k1}{$k2}',
+ setup => 'my ($k1,$k2) = qw(foo bar); my %h = ($k1 => { $k2 => 1 });',
+ code => 'exists $h{$k1}{$k2}',
+ },
+ 'expr::hash::delete_lex_2var' => {
+ desc => 'lexical delete $hash{$k1}{$k2}',
+ setup => 'my ($k1,$k2) = qw(foo bar); my %h = ($k1 => { $k2 => 1 });',
+ code => 'delete $h{$k1}{$k2}',
+ },
+
+
'expr::index::utf8_postion_1' => {
desc => 'index of a utf8 string, matching at position 1',
setup => 'utf8::upgrade my $x = "abc"',
code => 'index $x, "b"',
},
-];
+];
diff --git a/t/perf/opcount.t b/t/perf/opcount.t
index 659a80ee12..f3c0badcb6 100644
--- a/t/perf/opcount.t
+++ b/t/perf/opcount.t
@@ -17,7 +17,10 @@ BEGIN {
@INC = '../lib';
}
-plan 28;
+use warnings;
+use strict;
+
+plan 2249;
use B ();
@@ -56,8 +59,16 @@ use B ();
note(sprintf "%3d %s", $counts{$_}, $_) for sort keys %counts;
}
+ my @exp;
for (sort keys %$expected_counts) {
- is ($counts{$_}//0, $expected_counts->{$_}, "$desc: $_");
+ my ($c, $e) = ($counts{$_}//0, $expected_counts->{$_});
+ if ($c != $e) {
+ push @exp, "expected $e, got $c: $_";
+ }
+ }
+ ok(!@exp, $desc);
+ if (@exp) {
+ diag($_) for @exp;
}
}
}
@@ -65,7 +76,7 @@ use B ();
# aelem => aelemfast: a basic test that this test file works
test_opcount(0, "basic aelemfast",
- sub { $a[0] = 1 },
+ sub { our @a; $a[0] = 1 },
{
aelem => 0,
aelemfast => 1,
@@ -96,6 +107,7 @@ test_opcount(0, "basic aelemfast",
}
);
+ no warnings 'void';
test_opcount(0, "bench.pl active loop",
sub { for my $x (1..$ARGV[0]) { $x; } },
{
@@ -115,3 +127,136 @@ test_opcount(0, "basic aelemfast",
}
);
}
+
+#
+# multideref
+#
+# try many permutations of aggregate lookup expressions
+
+{
+ package Foo;
+
+ my (@agg_lex, %agg_lex, $i_lex, $r_lex);
+ our (@agg_pkg, %agg_pkg, $i_pkg, $r_pkg);
+
+ my $f;
+ my @bodies = ('[0]', '[128]', '[$i_lex]', '[$i_pkg]',
+ '{foo}', '{$i_lex}', '{$i_pkg}',
+ );
+
+ for my $prefix ('$f->()->', '$agg_lex', '$agg_pkg', '$r_lex->', '$r_pkg->')
+ {
+ for my $mod ('', 'local', 'exists', 'delete') {
+ for my $body0 (@bodies) {
+ for my $body1 ('', @bodies) {
+ for my $body2 ('', '[2*$i_lex]') {
+ my $code = "$mod $prefix$body0$body1$body2";
+ my $sub = "sub { $code }";
+ my $coderef = eval $sub
+ or die "eval '$sub': $@";
+
+ my %c = (aelem => 0,
+ aelemfast => 0,
+ aelemfast_lex => 0,
+ exists => 0,
+ delete => 0,
+ helem => 0,
+ multideref => 0,
+ );
+
+ my $top = 'aelem';
+ if ($code =~ /^\s*\$agg_...\[0\]$/) {
+ # we should expect aelemfast rather than multideref
+ $top = $code =~ /lex/ ? 'aelemfast_lex'
+ : 'aelemfast';
+ $c{$top} = 1;
+ }
+ else {
+ $c{multideref} = 1;
+ }
+
+ if ($body2 ne '') {
+ # trailing index; top aelem/exists/whatever
+ # node is kept
+ $top = $mod unless $mod eq '' or $mod eq 'local';
+ $c{$top} = 1
+ }
+
+ ::test_opcount(0, $sub, $coderef, \%c);
+ }
+ }
+ }
+ }
+ }
+}
+
+
+# multideref: ensure that the prefix expression and trailing index
+# expression are optimised (include aelemfast in those expressions)
+
+
+test_opcount(0, 'multideref expressions',
+ sub { ($_[0] // $_)->[0]{2*$_[0]} },
+ {
+ aelemfast => 2,
+ helem => 1,
+ multideref => 1,
+ },
+ );
+
+# multideref with interesting constant indices
+
+
+test_opcount(0, 'multideref const index',
+ sub { $_->{1}{1.1} },
+ {
+ helem => 0,
+ multideref => 1,
+ },
+ );
+
+use constant my_undef => undef;
+test_opcount(0, 'multideref undef const index',
+ sub { $_->{+my_undef} },
+ {
+ helem => 1,
+ multideref => 0,
+ },
+ );
+
+# multideref when its the first op in a subchain
+
+test_opcount(0, 'multideref op_other etc',
+ sub { $_{foo} = $_ ? $_{bar} : $_{baz} },
+ {
+ helem => 0,
+ multideref => 3,
+ },
+ );
+
+# multideref without hints
+
+{
+ no strict;
+ no warnings;
+
+ test_opcount(0, 'multideref no hints',
+ sub { $_{foo}[0] },
+ {
+ aelem => 0,
+ helem => 0,
+ multideref => 1,
+ },
+ );
+}
+
+# exists shouldn't clash with aelemfast
+
+test_opcount(0, 'multideref exists',
+ sub { exists $_[0] },
+ {
+ aelem => 0,
+ aelemfast => 0,
+ multideref => 1,
+ },
+ );
View Lorry Controller Status