summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Mitchell <davem@iabyn.com>2016-09-19 12:35:13 +0100
committerDavid Mitchell <davem@iabyn.com>2016-10-04 11:18:40 +0100
commit692044df8403d4568b919fe9ad7e282e864ec85e (patch)
treecee2e122d90dc7fc942964679cfd808189e5c390
parent70027d69be2857dc45d5ff75021fc5f55d6295da (diff)
downloadperl-692044df8403d4568b919fe9ad7e282e864ec85e.tar.gz
Better optimise my/local @a = split()
There are currently two optimisations for when the results of a split are assigned to an array. For the first, @array = split(...); the aassign and padav/rv2av are optimised away, and pp_split() directly assigns to the array attached to the split op (via op_pmtargetoff or op_pmtargetgv). For the second, my @array = split(...); local @array = split(...); @{$expr} = split(...); The aassign is optimised away, but the padav/rv2av is kept as an additional arg to split. pp_split itself then uses the first arg popped off the stack as the array (This was introduced by FC with v5.21.4-409-gef7999f). This commit moves these two: my @array = split(...); local @array = split(...); from the second case to the first case, by simply setting OPpLVAL_INTRO on the OP_SPLIT, and making pp_split() do SAVECLEARSV() or save_ary() as appropriate. This makes my @a = split(...) a few percent faster.
-rw-r--r--ext/B/B/Concise.pm4
-rw-r--r--lib/B/Deparse.pm3
-rw-r--r--lib/B/Op_private.pm8
-rw-r--r--op.c29
-rw-r--r--opcode.h132
-rw-r--r--pp.c19
-rw-r--r--regen/op_private4
-rw-r--r--t/op/split.t74
-rw-r--r--t/perf/benchmarks6
-rw-r--r--t/perf/opcount.t27
10 files changed, 208 insertions, 98 deletions
diff --git a/ext/B/B/Concise.pm b/ext/B/B/Concise.pm
index f474864779..d525b5f897 100644
--- a/ext/B/B/Concise.pm
+++ b/ext/B/B/Concise.pm
@@ -848,8 +848,8 @@ sub concise_op {
}
}
elsif ($op->name eq 'split') {
- if ( ($op->private & OPpSPLIT_ASSIGN)
- && (not $op->flags & OPf_STACKED))
+ if ( ($op->private & OPpSPLIT_ASSIGN) # @array = split
+ && (not $op->flags & OPf_STACKED)) # @{expr} = split
{
# with C<@array = split(/pat/, str);>,
# array is stored in /pat/'s pmreplroot; either
diff --git a/lib/B/Deparse.pm b/lib/B/Deparse.pm
index fb4a7d9fee..e14620ba6a 100644
--- a/lib/B/Deparse.pm
+++ b/lib/B/Deparse.pm
@@ -5760,6 +5760,9 @@ sub pp_split {
$self->gv_name($gv),
$cx))
}
+ if ($op->private & OPpLVAL_INTRO) {
+ $ary = $op->private & OPpSPLIT_LEX ? "my $ary" : "local $ary";
+ }
}
}
diff --git a/lib/B/Op_private.pm b/lib/B/Op_private.pm
index 1732b04f63..f3693707f5 100644
--- a/lib/B/Op_private.pm
+++ b/lib/B/Op_private.pm
@@ -133,7 +133,7 @@ $bits{$_}{5} = 'OPpHUSH_VMSISH' for qw(dbstate nextstate);
$bits{$_}{1} = 'OPpITER_REVERSED' for qw(enteriter iter);
$bits{$_}{7} = 'OPpLVALUE' for qw(leave leaveloop);
$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{$_}{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 split);
$bits{$_}{2} = 'OPpLVREF_ELEM' for qw(lvref refassign);
$bits{$_}{3} = 'OPpLVREF_ITER' for qw(lvref refassign);
$bits{$_}{3} = 'OPpMAYBE_LVSUB' for qw(aassign aelem akeys aslice av2arylen avhvswitch helem hslice keys kvaslice kvhslice multideref padav padhv pos rv2av rv2gv rv2hv substr vec);
@@ -538,7 +538,7 @@ $bits{snetent}{0} = $bf[0];
@{$bits{sockpair}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
@{$bits{sort}}{6,5,4,3,2,1,0} = ('OPpSORT_STABLE', 'OPpSORT_QSORT', 'OPpSORT_DESCEND', 'OPpSORT_INPLACE', 'OPpSORT_REVERSE', 'OPpSORT_INTEGER', 'OPpSORT_NUMERIC');
@{$bits{splice}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
-@{$bits{split}}{7,4,3} = ('OPpSPLIT_IMPLIM', 'OPpSPLIT_ASSIGN', 'OPpSPLIT_LEX');
+@{$bits{split}}{4,3,2} = ('OPpSPLIT_ASSIGN', 'OPpSPLIT_LEX', 'OPpSPLIT_IMPLIM');
@{$bits{sprintf}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
$bits{sprotoent}{0} = $bf[0];
$bits{sqrt}{0} = $bf[0];
@@ -672,7 +672,7 @@ our %defines = (
OPpSORT_REVERSE => 4,
OPpSORT_STABLE => 64,
OPpSPLIT_ASSIGN => 16,
- OPpSPLIT_IMPLIM => 128,
+ OPpSPLIT_IMPLIM => 4,
OPpSPLIT_LEX => 8,
OPpSUBSTR_REPL_FIRST => 16,
OPpTARGET_MY => 16,
@@ -804,7 +804,7 @@ our %ops_using = (
OPpLIST_GUESSED => [qw(list)],
OPpLVALUE => [qw(leave leaveloop)],
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)],
+ 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 split)],
OPpLVREF_ELEM => [qw(lvref refassign)],
OPpMAYBE_LVSUB => [qw(aassign aelem akeys aslice av2arylen avhvswitch helem hslice keys kvaslice kvhslice multideref padav padhv pos rv2av rv2gv rv2hv substr vec)],
OPpMAYBE_TRUEBOOL => [qw(padhv rv2hv)],
diff --git a/op.c b/op.c
index 2e85438a67..d6d7a847d0 100644
--- a/op.c
+++ b/op.c
@@ -1017,8 +1017,8 @@ Perl_op_clear(pTHX_ OP *o)
goto clear_pmop;
case OP_SPLIT:
- if ( (o->op_private & OPpSPLIT_ASSIGN)
- && !(o->op_flags & OPf_STACKED))
+ if ( (o->op_private & OPpSPLIT_ASSIGN) /* @array = split */
+ && !(o->op_flags & OPf_STACKED)) /* @{expr} = split */
{
if (o->op_private & OPpSPLIT_LEX)
pad_free(cPMOPo->op_pmreplrootu.op_pmtargetoff);
@@ -6568,10 +6568,10 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
}
/* optimise @a = split(...) into:
- * local/my @a: split(..., @a), where @a is not flattened
- * other arrays: split(...) where @a is attached to
- * the split op itself
- */
+ * @{expr}: split(..., @{expr}) (where @a is not flattened)
+ * @a, my @a, local @a: split(...) (where @a is attached to
+ * the split op itself)
+ */
if ( right
&& right->op_type == OP_SPLIT
@@ -6580,13 +6580,11 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
{
OP *gvop = NULL;
- if (!(left->op_private & OPpLVAL_INTRO) &&
- ( (left->op_type == OP_RV2AV &&
- (gvop=((UNOP*)left)->op_first)->op_type==OP_GV)
- || left->op_type == OP_PADAV )
- )
+ if ( ( left->op_type == OP_RV2AV
+ && (gvop=((UNOP*)left)->op_first)->op_type==OP_GV)
+ || left->op_type == OP_PADAV)
{
- /* @pkg or @lex, but not 'local @pkg' nor 'my @lex' */
+ /* @pkg or @lex or local @pkg' or 'my @lex' */
OP *tmpop;
PMOP * const pm = (PMOP*)right;
if (gvop) {
@@ -6607,6 +6605,7 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
left->op_targ = 0; /* steal it */
right->op_private |= OPpSPLIT_LEX;
}
+ right->op_private |= left->op_private & OPpLVAL_INTRO;
detach_split:
tmpop = cUNOPo->op_first; /* to list (nulled) */
@@ -6622,10 +6621,8 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
/* "I don't know and I don't care." */
return right;
}
- else if (left->op_type == OP_RV2AV
- || left->op_type == OP_PADAV)
- {
- /* 'local @pkg' or 'my @lex' */
+ else if (left->op_type == OP_RV2AV) {
+ /* @{expr} */
OP *pushop = cUNOPx(cBINOPo->op_last)->op_first;
assert(OpSIBLING(pushop) == left);
diff --git a/opcode.h b/opcode.h
index 5dc6805670..525ddc1d15 100644
--- a/opcode.h
+++ b/opcode.h
@@ -2221,6 +2221,7 @@ END_EXTERN_C
#define OPpLVREF_ELEM 0x04
#define OPpSLICEWARNING 0x04
#define OPpSORT_REVERSE 0x04
+#define OPpSPLIT_IMPLIM 0x04
#define OPpTRANS_IDENTICAL 0x04
#define OPpARGELEM_MASK 0x06
#define OPpARG3_MASK 0x07
@@ -2294,7 +2295,6 @@ END_EXTERN_C
#define OPpOFFBYONE 0x80
#define OPpOPEN_OUT_CRLF 0x80
#define OPpPV_IS_UTF8 0x80
-#define OPpSPLIT_IMPLIM 0x80
#define OPpTRANS_DELETE 0x80
START_EXTERN_C
@@ -2601,7 +2601,7 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = {
47, /* pack */
120, /* split */
47, /* join */
- 125, /* list */
+ 126, /* list */
12, /* lslice */
47, /* anonlist */
47, /* anonhash */
@@ -2610,51 +2610,51 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = {
0, /* pop */
0, /* shift */
77, /* unshift */
- 127, /* sort */
- 134, /* reverse */
+ 128, /* sort */
+ 135, /* reverse */
0, /* grepstart */
0, /* grepwhile */
0, /* mapstart */
0, /* mapwhile */
0, /* range */
- 136, /* flip */
- 136, /* flop */
+ 137, /* flip */
+ 137, /* flop */
0, /* and */
0, /* or */
12, /* xor */
0, /* dor */
- 138, /* cond_expr */
+ 139, /* cond_expr */
0, /* andassign */
0, /* orassign */
0, /* dorassign */
0, /* method */
- 140, /* entersub */
- 147, /* leavesub */
- 147, /* leavesublv */
+ 141, /* entersub */
+ 148, /* leavesub */
+ 148, /* leavesublv */
0, /* argcheck */
- 149, /* argelem */
+ 150, /* argelem */
0, /* argdefelem */
- 151, /* caller */
+ 152, /* caller */
47, /* warn */
47, /* die */
47, /* reset */
-1, /* lineseq */
- 153, /* nextstate */
- 153, /* dbstate */
+ 154, /* nextstate */
+ 154, /* dbstate */
-1, /* unstack */
-1, /* enter */
- 154, /* leave */
+ 155, /* leave */
-1, /* scope */
- 156, /* enteriter */
- 160, /* iter */
+ 157, /* enteriter */
+ 161, /* iter */
-1, /* enterloop */
- 161, /* leaveloop */
+ 162, /* leaveloop */
-1, /* return */
- 163, /* last */
- 163, /* next */
- 163, /* redo */
- 163, /* dump */
- 163, /* goto */
+ 164, /* last */
+ 164, /* next */
+ 164, /* redo */
+ 164, /* dump */
+ 164, /* goto */
47, /* exit */
0, /* method_named */
0, /* method_super */
@@ -2666,7 +2666,7 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = {
0, /* leavewhen */
-1, /* break */
-1, /* continue */
- 165, /* open */
+ 166, /* open */
47, /* close */
47, /* pipe_op */
47, /* fileno */
@@ -2682,7 +2682,7 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = {
47, /* getc */
47, /* read */
47, /* enterwrite */
- 147, /* leavewrite */
+ 148, /* leavewrite */
-1, /* prtf */
-1, /* print */
-1, /* say */
@@ -2712,33 +2712,33 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = {
0, /* getpeername */
0, /* lstat */
0, /* stat */
- 170, /* ftrread */
- 170, /* ftrwrite */
- 170, /* ftrexec */
- 170, /* fteread */
- 170, /* ftewrite */
- 170, /* fteexec */
- 175, /* ftis */
- 175, /* ftsize */
- 175, /* ftmtime */
- 175, /* ftatime */
- 175, /* ftctime */
- 175, /* ftrowned */
- 175, /* fteowned */
- 175, /* ftzero */
- 175, /* ftsock */
- 175, /* ftchr */
- 175, /* ftblk */
- 175, /* ftfile */
- 175, /* ftdir */
- 175, /* ftpipe */
- 175, /* ftsuid */
- 175, /* ftsgid */
- 175, /* ftsvtx */
- 175, /* ftlink */
- 175, /* fttty */
- 175, /* fttext */
- 175, /* ftbinary */
+ 171, /* ftrread */
+ 171, /* ftrwrite */
+ 171, /* ftrexec */
+ 171, /* fteread */
+ 171, /* ftewrite */
+ 171, /* fteexec */
+ 176, /* ftis */
+ 176, /* ftsize */
+ 176, /* ftmtime */
+ 176, /* ftatime */
+ 176, /* ftctime */
+ 176, /* ftrowned */
+ 176, /* fteowned */
+ 176, /* ftzero */
+ 176, /* ftsock */
+ 176, /* ftchr */
+ 176, /* ftblk */
+ 176, /* ftfile */
+ 176, /* ftdir */
+ 176, /* ftpipe */
+ 176, /* ftsuid */
+ 176, /* ftsgid */
+ 176, /* ftsvtx */
+ 176, /* ftlink */
+ 176, /* fttty */
+ 176, /* fttext */
+ 176, /* ftbinary */
77, /* chdir */
77, /* chown */
71, /* chroot */
@@ -2758,17 +2758,17 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = {
0, /* rewinddir */
0, /* closedir */
-1, /* fork */
- 179, /* wait */
+ 180, /* wait */
77, /* waitpid */
77, /* system */
77, /* exec */
77, /* kill */
- 179, /* getppid */
+ 180, /* getppid */
77, /* getpgrp */
77, /* setpgrp */
77, /* getpriority */
77, /* setpriority */
- 179, /* time */
+ 180, /* time */
-1, /* tms */
0, /* localtime */
47, /* gmtime */
@@ -2788,8 +2788,8 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = {
0, /* require */
0, /* dofile */
-1, /* hintseval */
- 180, /* entereval */
- 147, /* leaveeval */
+ 181, /* entereval */
+ 148, /* leaveeval */
0, /* entertry */
-1, /* leavetry */
0, /* ghbyname */
@@ -2827,18 +2827,18 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = {
0, /* lock */
0, /* once */
-1, /* custom */
- 186, /* coreargs */
- 190, /* avhvswitch */
+ 187, /* coreargs */
+ 191, /* avhvswitch */
3, /* runcv */
0, /* fc */
-1, /* padcv */
-1, /* introcv */
-1, /* clonecv */
- 192, /* padrange */
- 194, /* refassign */
- 200, /* lvref */
- 206, /* lvrefslice */
- 207, /* lvavref */
+ 193, /* padrange */
+ 195, /* refassign */
+ 201, /* lvref */
+ 207, /* lvrefslice */
+ 208, /* lvavref */
0, /* anonconst */
};
@@ -2894,7 +2894,7 @@ EXTCONST U16 PL_op_private_bitdefs[] = {
0x4058, 0x0003, /* exists */
0x2cbc, 0x31d8, 0x0614, 0x06b0, 0x2dac, 0x3ba8, 0x3f64, 0x0003, /* rv2hv */
0x2cbc, 0x2bb8, 0x1074, 0x19d0, 0x2dac, 0x3f64, 0x0003, /* multideref */
- 0x249c, 0x31d8, 0x3974, 0x0350, 0x29cd, /* split */
+ 0x2cbc, 0x31d8, 0x3974, 0x0350, 0x29cc, 0x2489, /* split */
0x2cbc, 0x20f9, /* list */
0x3dd8, 0x3474, 0x1310, 0x27ac, 0x37c8, 0x28a4, 0x3141, /* sort */
0x27ac, 0x0003, /* reverse */
@@ -3085,7 +3085,7 @@ EXTCONST U8 PL_op_private_valid[] = {
/* MULTIDEREF */ (OPpARG1_MASK|OPpHINT_STRICT_REFS|OPpMAYBE_LVSUB|OPpMULTIDEREF_EXISTS|OPpMULTIDEREF_DELETE|OPpLVAL_DEFER|OPpLVAL_INTRO),
/* UNPACK */ (OPpARG4_MASK),
/* PACK */ (OPpARG4_MASK),
- /* SPLIT */ (OPpSPLIT_LEX|OPpSPLIT_ASSIGN|OPpRUNTIME|OPpOUR_INTRO|OPpSPLIT_IMPLIM),
+ /* SPLIT */ (OPpSPLIT_IMPLIM|OPpSPLIT_LEX|OPpSPLIT_ASSIGN|OPpRUNTIME|OPpOUR_INTRO|OPpLVAL_INTRO),
/* JOIN */ (OPpARG4_MASK),
/* LIST */ (OPpLIST_GUESSED|OPpLVAL_INTRO),
/* LSLICE */ (OPpARG2_MASK),
diff --git a/pp.c b/pp.c
index eab970d3cc..00a577e278 100644
--- a/pp.c
+++ b/pp.c
@@ -5708,8 +5708,8 @@ PP(pp_reverse)
PP(pp_split)
{
dSP; dTARG;
- AV *ary = ( (PL_op->op_private & OPpSPLIT_ASSIGN)
- && (PL_op->op_flags & OPf_STACKED))
+ AV *ary = ( (PL_op->op_private & OPpSPLIT_ASSIGN) /* @a = split */
+ && (PL_op->op_flags & OPf_STACKED)) /* @{expr} = split */
? (AV *)POPs : NULL;
IV limit = POPi; /* note, negative is forever */
SV * const sv = POPs;
@@ -5733,7 +5733,7 @@ PP(pp_split)
I32 base;
const U8 gimme = GIMME_V;
bool gimme_scalar;
- const I32 oldsave = PL_savestack_ix;
+ I32 oldsave = PL_savestack_ix;
U32 make_mortal = SVs_TEMP;
bool multiline = 0;
MAGIC *mg = NULL;
@@ -5743,10 +5743,14 @@ PP(pp_split)
TAINT_IF(get_regex_charset(RX_EXTFLAGS(rx)) == REGEX_LOCALE_CHARSET &&
(RX_EXTFLAGS(rx) & (RXf_WHITE | RXf_SKIPWHITE)));
+ /* handle @ary = split(...) optimisation */
if (PL_op->op_private & OPpSPLIT_ASSIGN) {
if (!(PL_op->op_flags & OPf_STACKED)) {
- if (PL_op->op_private & OPpSPLIT_LEX)
+ if (PL_op->op_private & OPpSPLIT_LEX) {
+ if (PL_op->op_private & OPpLVAL_INTRO)
+ SAVECLEARSV(PAD_SVl(pm->op_pmreplrootu.op_pmtargetoff));
ary = (AV *)PAD_SVl(pm->op_pmreplrootu.op_pmtargetoff);
+ }
else {
GV *gv =
#ifdef USE_ITHREADS
@@ -5754,8 +5758,13 @@ PP(pp_split)
#else
pm->op_pmreplrootu.op_pmtargetgv;
#endif
- ary = GvAVn(gv);
+ if (PL_op->op_private & OPpLVAL_INTRO)
+ ary = save_ary(gv);
+ else
+ ary = GvAVn(gv);
}
+ /* skip anything pushed by OPpLVAL_INTRO above */
+ oldsave = PL_savestack_ix;
}
realarray = 1;
diff --git a/regen/op_private b/regen/op_private
index e511ce145b..d459d479e4 100644
--- a/regen/op_private
+++ b/regen/op_private
@@ -300,7 +300,7 @@ for (qw(nextstate dbstate)) {
# my $x
addbits($_, 7 => qw(OPpLVAL_INTRO LVINTRO))
- for qw(gvsv rv2sv rv2hv rv2gv rv2av aelem helem aslice
+ for qw(gvsv rv2sv rv2hv rv2gv rv2av aelem helem aslice split
hslice delete padsv padav padhv enteriter entersub padrange
pushmark cond_expr refassign lvref lvrefslice lvavref multideref),
'list', # this gets set in my_attrs() for some reason
@@ -732,11 +732,11 @@ addbits('coreargs',
addbits('split',
- 7 => qw(OPpSPLIT_IMPLIM IMPLIM), # implicit limit
# @a = split() has been replaced with split() where split itself
# does the array assign
4 => qw(OPpSPLIT_ASSIGN ASSIGN),
3 => qw(OPpSPLIT_LEX LEX), # the OPpSPLIT_ASSIGN is a lexical array
+ 2 => qw(OPpSPLIT_IMPLIM IMPLIM), # implicit limit
);
diff --git a/t/op/split.t b/t/op/split.t
index 6a138b9ed9..037aa2e059 100644
--- a/t/op/split.t
+++ b/t/op/split.t
@@ -7,7 +7,7 @@ BEGIN {
set_up_inc('../lib');
}
-plan tests => 135;
+plan tests => 159;
$FS = ':';
@@ -538,3 +538,75 @@ is "@a", '1 2 3', 'assignment to split-to-array (stacked)';
is "@a", "a b c", "run-time re-eval";
is $c, 2, "run-time re-eval count";
}
+
+# check that that my/local @array = split works
+
+{
+ my $s = "a:b:c";
+
+ local @a = qw(x y z);
+ {
+ local @a = split /:/, $s;
+ is "@a", "a b c", "local split inside";
+ }
+ is "@a", "x y z", "local split outside";
+
+ my @b = qw(x y z);
+ {
+ my @b = split /:/, $s;
+ is "@b", "a b c", "my split inside";
+ }
+ is "@b", "x y z", "my split outside";
+}
+
+# check that the (@a = split) optimisation works in scalar/list context
+
+{
+ my $s = "a:b:c:d:e";
+ my @outer;
+ my $outer;
+ my @lex;
+ local our @pkg;
+
+ $outer = (@lex = split /:/, $s);
+ is "@lex", "a b c d e", "array split: scalar cx lex: inner";
+ is $outer, 5, "array split: scalar cx lex: outer";
+
+ @outer = (@lex = split /:/, $s);
+ is "@lex", "a b c d e", "array split: list cx lex: inner";
+ is "@outer", "a b c d e", "array split: list cx lex: outer";
+
+ $outer = (@pkg = split /:/, $s);
+ is "@pkg", "a b c d e", "array split: scalar cx pkg inner";
+ is $outer, 5, "array split: scalar cx pkg outer";
+
+ @outer = (@pkg = split /:/, $s);
+ is "@pkg", "a b c d e", "array split: list cx pkg inner";
+ is "@outer", "a b c d e", "array split: list cx pkg outer";
+
+ $outer = (my @a1 = split /:/, $s);
+ is "@a1", "a b c d e", "array split: scalar cx my lex: inner";
+ is $outer, 5, "array split: scalar cx my lex: outer";
+
+ @outer = (my @a2 = split /:/, $s);
+ is "@a2", "a b c d e", "array split: list cx my lex: inner";
+ is "@outer", "a b c d e", "array split: list cx my lex: outer";
+
+ $outer = (local @pkg = split /:/, $s);
+ is "@pkg", "a b c d e", "array split: scalar cx local pkg inner";
+ is $outer, 5, "array split: scalar cx local pkg outer";
+
+ @outer = (local @pkg = split /:/, $s);
+ is "@pkg", "a b c d e", "array split: list cx local pkg inner";
+ is "@outer", "a b c d e", "array split: list cx local pkg outer";
+
+ $outer = (@{\@lex} = split /:/, $s);
+ is "@lex", "a b c d e", "array split: scalar cx lexref inner";
+ is $outer, 5, "array split: scalar cx lexref outer";
+
+ @outer = (@{\@pkg} = split /:/, $s);
+ is "@pkg", "a b c d e", "array split: list cx pkgref inner";
+ is "@outer", "a b c d e", "array split: list cx pkgref outer";
+
+
+}
diff --git a/t/perf/benchmarks b/t/perf/benchmarks
index 3daa27d0b7..f02a06a299 100644
--- a/t/perf/benchmarks
+++ b/t/perf/benchmarks
@@ -983,12 +983,16 @@
setup => 'my @a; my $s = "abc:def";',
code => '@a = split /:/, $s, 2;',
},
-
'func::split::myarray' => {
desc => 'split into a lexical array declared in the assign',
setup => 'my $s = "abc:def";',
code => 'my @a = split /:/, $s, 2;',
},
+ 'func::split::arrayexpr' => {
+ desc => 'split into an @{$expr} ',
+ setup => 'my $s = "abc:def"; my $r = []',
+ code => '@$r = split /:/, $s, 2;',
+ },
'loop::block' => {
diff --git a/t/perf/opcount.t b/t/perf/opcount.t
index f65695dc86..1d02fae175 100644
--- a/t/perf/opcount.t
+++ b/t/perf/opcount.t
@@ -20,7 +20,7 @@ BEGIN {
use warnings;
use strict;
-plan 2256;
+plan 2261;
use B ();
@@ -325,3 +325,28 @@ test_opcount(0, 'barewords can be constant-folded',
}
+
+# in-place assign optimisation for @a = split
+
+{
+ local our @pkg;
+ my @lex;
+
+ for (['@pkg', 0, ],
+ ['local @pkg', 0, ],
+ ['@lex', 0, ],
+ ['my @a', 0, ],
+ ['@{[]}', 1, ],
+ ){
+ # partial implies that the aassign has been optimised away, but
+ # not the rv2av
+ my ($code, $partial) = @$_;
+ test_opcount(0, "in-place assignment for split: $code",
+ eval qq{sub { $code = split }},
+ {
+ padav => 0,
+ rv2av => $partial,
+ aassign => 0,
+ });
+ }
+}