#839600 perl: concatenating string instead of sprintf takes all computation power of server

Package:
perl
Source:
perl
Description:
Larry Wall's Practical Extraction and Report Language
Submitter:
Leszek Dubiel
Date:
2020-11-15 00:21:09 UTC
Severity:
normal
#839600#5
Date:
2016-10-02 16:40:32 UTC
From:
To:
Dear Maintainer,

*** Reporter, please consider answering these questions, where appropriate ***

I am reading big string from file (2 megabytes), then add parentheses to
the beginning and end of that string, finally do parsing with regular
expressions using \G for continuation.
consumed by that perl script.

I have asked question on perlmonks:
http://www.perlmonks.org/?node_id=1172994

People were testing program and didn't have the same effect. So it
appeared that this is problem only on my server. I have moved script to
another computer with the same version of Debian (jessie, stable), and
script still did run very slow. Problem dissapeared on new version
(stretch). I have tested on my ubuntu (run fast), and the same hardware
under VirtualBox with fresh installation of Debian Jessie -- script did
run very slow.

So the problem exists on current debian stable version (jessie), and
doesn't exist on newer versions.

Here is the test suite to reproduce error:

https://drive.google.com/file/d/0B9GHvKh0yZKYY0pOUFc5V2hadTg/view?usp=sharing

If error is on your computer, then it runs about 30 seconds.
If there is no error that it runs only half a second.

Below there is a program. There are some lines commented out -- if you
uncomment them, then program runs very fast. Why? I don't understand.

###################################

use strict;
use warnings;

sub my_parse {
	my ($a) = @_;
	$$a =~ /\G\s*+\(/gc or die "paren expected";
	while ($$a =~ /\G\s*+([[:alnum:]_]+)\s*+/gc) {
		if ($$a =~ /\G([-+._[:alnum:]]+|"(?:[^\\"]++|\\[\\"])*+")/gc) {
			1;
		} elsif ($$a =~ /\G(?=\()/gc) {
			my_parse($a);
		} else {
			die "wrong value";
		}
	}
	$$a =~ /\G\s*+\)\s*+/gc or die "name expected";
	return;
}

my $inp = `cat input.txt`;

# my $inp = `echo; cat input.txt`; # is fast
# my $inp = `cat input.txt; echo`; # is fast
# my $inp = `sed -n '1,9000p' input.txt`; # is slow
# my $inp = `sed -n '1,8000p' input.txt`; # is fast

my $par = "(" . $inp . ")";
# my $par = sprintf "(%s)", $inp; # is fast

my_parse(\$par);

###################################

The problem seems very strange for me. I have tried to make smaller data
input, but if I cut some lines from input script runs very fast, cut
lines from the beginning, or end, or in the middle. Adding empty line
with "echo" makes it run fast. Sprintf istead of concatenation makes it
fast.



*** End of the template - remove these template lines ***

#839600#10
Date:
2016-10-02 17:00:56 UTC
From:
To:
Attachments -- test script, input file.
#839600#15
Date:
2016-10-02 19:44:35 UTC
From:
To:
Control: found -1 5.24.1~rc3-3

I see this on current sid/amd64 (Perl 5.24) too fwiw, and also in an
amd64 chroot with Perl 5.22. I've no idea why it goes away for you on
stretch. Can you confirm that? Are you only testing on i386 or on amd64
as well?

It looks like the difference between
  $par = "(" . $inp . ")"; # is slow
and
  $par = sprintf "(%s)", $inp; # is fast
internally is that the first one uses copy on write semantics, meaning
it doesn't have to copy the whole string in memory. Of course, this
is supposed to improve performance rather than degrade it.

AFAICS the regexp behaviour stays unchanged, it's just the performance
that drops. I tried some debugging with 'debugperl -Dr' but it mostly
hides the problem by slowing down the execution by itself.

It would be nice to distill the issue to a smaller test case but it's
rather sensitive to the input as you noted so that doesn't seem to be
easy.

Thanks for the report, will try to investigate more.

#839600#22
Date:
2016-10-02 20:38:28 UTC
From:
To:
I don't see this on sid (amd64):

% for i in $(seq 1 100); time perl run_tests.pl
[..]
perl run_tests.pl  0.08s user 0.01s system 98% cpu 0.093 total
perl run_tests.pl  0.15s user 0.00s system 98% cpu 0.158 total

(These are the fastest and the slowest of the 100 runs.)


Cheers,
gregor

#839600#27
Date:
2016-10-02 20:59:12 UTC
From:
To:
Sorry, should have said I see it with the 'sed -n '1,9000p'
line uncommented.

It seems to have to do with the size of the input file rather
than its contents, but I'm not quite sure yet.

#839600#32
Date:
2016-10-02 21:12:20 UTC
From:
To:
Ah :)

Ok, then I get:

% for i in $(seq 1 100); time perl run_tests.pl
perl run_tests.pl  63.54s user 0.02s system 99% cpu 1:03.59 total
perl run_tests.pl  67.39s user 0.15s system 99% cpu 1:07.69 total
perl run_tests.pl  70.04s user 0.08s system 99% cpu 1:10.37 total
^C

Weird indeed.
With "sed -n '1,9001p'" it's fast again; with "sed -n '1,8999p'" as
well?!

Cheers,
gregor

#839600#37
Date:
2016-10-02 21:24:50 UTC
From:
To:
Problem goes away on "stretch", perl version "subversion 1 (v5.24.1)
built for x86_64-linux-gnu-thread-multi".
I have checked that many times.
Yes! I think the same.
But you see the difference between "fast" and "slow" lines...
Fast -- half a second, slow -- 30 seconds.
This is dramatic performance impact.
I have tried hard -- to cut lines, to cut program to get minimal test
suite.
But when you remove one line it is slow, when remove 1000 lines still
slow, when remove 1001 lines gets fast.

Also if you ADD twice that number of lines (double input in size) it
gets FAST.... :) :)
Twice many data, 50 times faster.

I think I'm lucky to get proper data input to show the problem -- I
can't craft very small data example to show the problem.

#839600#42
Date:
2016-10-03 19:23:51 UTC
From:
To:
It looks like none of the gory regexps are necessary to trigger it.
Here's a short test case, resulting here in

           Rate  concat  assign sprintf
concat   2928/s      --    -94%    -94%
assign  47733/s   1530%      --     -0%
sprintf 47733/s   1530%      0%      --

so showing the 'concat' option has pathologic performance.
It goes away if the length of the base string $s is varied
even slightly, and seems to reappear in 8-byte increments
or decrements. Some of those, like 2**16 - 3, also blow
up the 'sprintf' performance.

The results don't vary much between jessie (Perl 5.20) and sid (5.24)
for me on amd64.

I'll test/bisect this on upstream code next and try to find out if it's
really copy-on-write related or something else.

#839600#47
Date:
2016-10-03 20:19:17 UTC
From:
To:
Control: forwarded -1 https://rt.perl.org/Ticket/Display.html?id=129802

I've bisected that it regressed with 5.19.7, more precisely
http://perl5.git.perl.org/perl.git/commit/9ffd39ab75dd662df22fcdafbf7f740838acc898

and filed upstream ticket [perl #129802] about it.

#839600#54
Date:
2019-08-25 20:42:42 UTC
From:
To:
This bug is not relevant in current stable release of debian.
Maybe something wash changed upstream.



Upstream but still open:

https://rt.perl.org/Public/Bug/Display.html?id=129802



Current test:


root@gamma:~# cat /etc/issue
Debian GNU/Linux 10 \n \l

root@gamma:~# perl --version

This is perl 5, version 28, subversion 1 (v5.28.1) built for
i686-linux-gnu-thread-multi-64int
(with 61 registered patches, see perl -V for more detail)

Copyright 1987-2018, Larry Wall

Perl may be copied only under the terms of either the Artistic License
or the
GNU General Public License, which may be found in the Perl 5 source kit.

Complete documentation for Perl, including FAQ lists, should be found on
this system using "man perl" or "perldoc perl".  If you have access to the
Internet, point your browser at http://www.perl.org/, the Perl Home Page.

root@gamma:~# cat pb
#!/usr/bin/perl

# https://rt.perl.org/Public/Bug/Display.html?id=129802

use strict;
use warnings;
use Benchmark 'cmpthese';

my $s = "A"x (2**16 + 5);
my $cat = 'B' . $s . 'B';
my $spr = sprintf "B%sB", $s;
my $ca2 = "$cat "; chop $ca2;

cmpthese(-1, {
     "assign"  => sub {my $i=0; $s   =~ /./ while $i++ < 100 },
     "concat"  => sub {my $i=0; $cat =~ /./ while $i++ < 100 },
     "sprintf" => sub {my $i=0; $spr =~ /./ while $i++ < 100 },
     "okeycat" => sub {my $i=0; $ca2 =~ /./ while $i++ < 100 },
});

root@gamma:~# ./pb
            Rate  concat  assign sprintf okeycat
concat  30075/s      --     -2%     -2%     -4%
assign  30632/s      2%      --      0%     -2%
sprintf 30632/s      2%      0%      --     -2%
okeycat 31210/s      4%      2%      2%      --
root@gamma:~#