diff options
author | David Mitchell <davem@iabyn.com> | 2016-09-19 15:39:34 +0100 |
---|---|---|
committer | David Mitchell <davem@iabyn.com> | 2016-10-04 11:18:40 +0100 |
commit | 47a8f19b6f8f837245506422e5a4d36804e7b56a (patch) | |
tree | 440117f4ea662c607be9195091a01ad97032efe8 /t/perf | |
parent | 692044df8403d4568b919fe9ad7e282e864ec85e (diff) | |
download | perl-47a8f19b6f8f837245506422e5a4d36804e7b56a.tar.gz |
fix common assign issue on @a = (split(), 1)
RT #127999 Slowdown in split + list assign
The compile-time common-value detection mechanism for OP_ASSIGN
was getting OP_SPLIT wrong.
It was assuming that OP_SPLIT was always dangerous. In fact,
OP_SPLIT is usually completely safe, not passing though any of its
arguments, except where the assign in (@a = split()) has been optimised
away and the array attached directly to the OP_SPLIT op, or the ops that
produce the array have been appended as an extra child of the OP_SPLIT op
(OPf_STACKED).
Diffstat (limited to 't/perf')
-rw-r--r-- | t/perf/benchmarks | 5 | ||||
-rw-r--r-- | t/perf/optree.t | 7 |
2 files changed, 11 insertions, 1 deletions
diff --git a/t/perf/benchmarks b/t/perf/benchmarks index f02a06a299..56987bcf27 100644 --- a/t/perf/benchmarks +++ b/t/perf/benchmarks @@ -993,6 +993,11 @@ setup => 'my $s = "abc:def"; my $r = []', code => '@$r = split /:/, $s, 2;', }, + 'func::split::arraylist' => { + desc => 'split into an array with extra arg', + setup => 'my @a; my $s = "abc:def";', + code => '@a = (split(/:/, $s, 2), 1);', + }, 'loop::block' => { diff --git a/t/perf/optree.t b/t/perf/optree.t index a2ff7f283c..49959ce666 100644 --- a/t/perf/optree.t +++ b/t/perf/optree.t @@ -10,7 +10,7 @@ BEGIN { @INC = '../lib'; } -plan 54; +plan 59; use v5.10; # state use B qw(svref_2object @@ -74,6 +74,11 @@ for my $test ( [ "---", '(undef,$x) = f()', 'single scalar on LHS' ], [ "---", '($x,$y) = ($x)', 'single scalar on RHS, no AGG' ], [ "--A", '($x,@b) = ($x)', 'single scalar on RHS' ], + [ "--A", 'my @a; @a = (@a = split())', 'split a/a' ], + [ "--A", 'my (@a,@b); @a = (@b = split())', 'split a/b' ], + [ "---", 'my @a; @a = (split(), 1)', '(split(),1)' ], + [ "---", '@a = (split(//, @a), 1)', 'split(@a)' ], + [ "--A", 'my @a; my $ar = @a; @a = (@$ar = split())', 'a/ar split' ], ) { my ($exp, $code, $desc) = @$test; my $sub = eval "sub { $code }" |