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.

diff --git a/ext/B/B/Concise.pm b/ext/B/B/Concise.pm
index f474864..d525b5f 100644 (file)
--- 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 fb4a7d9..e14620b 100644 (file)
--- 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 1732b04..f369370 100644 (file)
--- 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 2e85438..d6d7a84 100644 (file)
--- 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 5dc6805..525ddc1 100644 (file)
--- 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 eab970d..00a577e 100644 (file)
--- 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 e511ce1..d459d47 100644 (file)
--- 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 6a138b9..037aa2e 100644 (file)
--- 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 3daa27d..f02a06a 100644 (file)
--- 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 f65695d..1d02fae 100644 (file)
--- 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,
+                });
+    }
+}