Skip Menu |

This queue is for tickets about the Data-Dump CPAN distribution.

Report information
The Basics
Id: 33520
Status: resolved
Priority: 0/
Queue: Data-Dump
People
Owner: Nobody in particular
Requestors: AGRUNDMA [...] cpan.org
Cc:
AdminCc:
Bug Information
Severity: Normal
Broken in: 1.08
Fixed in: (no value)

History Show all quoted text
  Fri Feb 22 14:59:50 2008 AGRUNDMA [...] cpan.org - Ticket created
Subject: Dumping large strings causes a segfault
At least with Perl 5.8.8, the following small script causes a segfault. Tested on Mac and Linux. #!/usr/bin/perl use strict; use Data::Dump qw(dump); warn dump( 'x' x ( 100 * 1024 ) );
  Fri Feb 22 15:26:41 2008 AGRUNDMA [...] cpan.org - Correspondence added
This appears to work fine in Perl 5.10.0, so it's probably a Perl bug that you can ignore.
  Fri Feb 22 15:26:44 2008 AGRUNDMA [...] cpan.org - Status changed from 'new' to 'open'
  Thu Aug 21 08:39:04 2008 GAAS [...] cpan.org - Correspondence added
On Fri Feb 22 14:59:50 2008, AGRUNDMA wrote: Show quoted text
> At least with Perl 5.8.8, the following small script causes a segfault. > Tested on Mac and Linux. > > #!/usr/bin/perl > > use strict; > use Data::Dump qw(dump); > > warn dump( 'x' x ( 100 * 1024 ) );
It's probably the regular expression engine that blows the stack when trying to decide how much repetition there is. The perl-5.10 re engine has been reworked to not consume stack.
  Thu Aug 21 09:09:52 2008 GAAS [...] cpan.org - Correspondence added
I've now applied the following patch: commit afd9a722457f8d9d2b64675d5d8da1bcf10d2353 Author: Gisle Aas <gisle@aas.no> Date: Thu Aug 21 15:07:55 2008 +0200 Dumping large strings causes a segfault [RT#33520] diff --git a/lib/Data/Dump.pm b/lib/Data/Dump.pm index 404b44b..fba3cfe 100644 --- a/lib/Data/Dump.pm +++ b/lib/Data/Dump.pm @@ -398,7 +398,17 @@ sub quote { local($_) = $_[0]; if (length($_) > 20) { # Check for repeated string - if (/^(.{1,5}?)(\1*)$/s) { + if (/^(.)\1\1\1/s) { + # seems to be a repating sequence, let's check if it really is + # without backtracking + unless (/[^\Q$1\E]/) { + my $base = quote($1); + my $repeat = length; + return "($base x $repeat)" + } + } + # Length protection because the RE engine will blow the stack [RT#33520] + if (length($_) < 16 * 1024 && /^(.{2,5}?)(\1*)\z/s) { my $base = quote($1); my $repeat = length($2)/length($1) + 1; return "($base x $repeat)"; diff --git a/t/quote.t b/t/quote.t index 368bdbf..7e311ad 100644 --- a/t/quote.t +++ b/t/quote.t @@ -3,7 +3,7 @@ use strict; use Test qw(plan ok skip); -plan tests => 9; +plan tests => 12; use Data::Dump qw(dump); $Data::Dump::TRY_BASE64 = 0; @@ -13,6 +13,9 @@ ok(dump("\n"), qq("\\n")); ok(dump("\0\1\x1F\0" . 3), qq("\\0\\1\\37\\x003")); ok(dump("xx" x 30), qq(("x" x 60))); ok(dump("xy" x 30), qq(("xy" x 30))); +ok(dump("\0" x 1024), qq(("\\0" x 1024))); +ok(dump("\$" x 1024), qq(("\\\$" x 1024))); +ok(dump("\n" x (1024 * 1024)), qq(("\\n" x 1048576))); ok(dump("\x7F\x80\xFF"), qq("\\x7F\\x80\\xFF")); ok(dump(join("", map chr($_), 0..127)), qq("\\0\\1\\2\\3\\4\\5\\6\\a\\b\\t\\n\\13\\f\\r\\16\\17\\20\\21\\22\\23\\24\\25\\26\\27\ ok(dump(join("", map chr($_), 0..255)), qq(pack("H*","000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f2021222324
  Thu Aug 21 09:09:55 2008 GAAS [...] cpan.org - Status changed from 'open' to 'resolved'