summaryrefslogtreecommitdiff
path: root/t/perf
diff options
context:
space:
mode:
authorDavid Mitchell <davem@iabyn.com>2016-09-19 15:39:34 +0100
committerDavid Mitchell <davem@iabyn.com>2016-10-04 11:18:40 +0100
commit47a8f19b6f8f837245506422e5a4d36804e7b56a (patch)
tree440117f4ea662c607be9195091a01ad97032efe8 /t/perf
parent692044df8403d4568b919fe9ad7e282e864ec85e (diff)
downloadperl-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/benchmarks5
-rw-r--r--t/perf/optree.t7
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 }"