diff options
author | David Mitchell <davem@iabyn.com> | 2016-09-19 12:35:13 +0100 |
---|---|---|
committer | David Mitchell <davem@iabyn.com> | 2016-10-04 11:18:40 +0100 |
commit | 692044df8403d4568b919fe9ad7e282e864ec85e (patch) | |
tree | cee2e122d90dc7fc942964679cfd808189e5c390 | |
parent | 70027d69be2857dc45d5ff75021fc5f55d6295da (diff) | |
download | perl-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.pm | 4 | ||||
-rw-r--r-- | lib/B/Deparse.pm | 3 | ||||
-rw-r--r-- | lib/B/Op_private.pm | 8 | ||||
-rw-r--r-- | op.c | 29 | ||||
-rw-r--r-- | opcode.h | 132 | ||||
-rw-r--r-- | pp.c | 19 | ||||
-rw-r--r-- | regen/op_private | 4 | ||||
-rw-r--r-- | t/op/split.t | 74 | ||||
-rw-r--r-- | t/perf/benchmarks | 6 | ||||
-rw-r--r-- | t/perf/opcount.t | 27 |
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)], @@ -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); @@ -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), @@ -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, + }); + } +} |