Skip Menu |
 

Preferred bug tracker

Please visit the preferred bug tracker to report your issue.

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

Report information
The Basics
Id: 84120
Status: open
Priority: 0/
Queue: Data-Dumper

People
Owner: Nobody in particular
Requestors: RURBAN [...] cpan.org
Cc:
AdminCc:

Bug Information
Severity: Important
Broken in: (no value)
Fixed in: (no value)

Attachments
0001-RT-84120-Data-Dumper-2.146-nul-safe-classnames.patch



Subject: classnames not nul-safe (needs_quote bless)
This added test shows that DD is not nul-safe (critical since perl 5.16) The classname needs to be checked for needs_quote(), otherwise the chars after the nul are stripped. not ok 11 - classnames with nulls # Failed test 'classnames with nulls' # at ../dist/Data-Dumper/t/bugs.t line 124. # got: 'foo::b' # expected: 'foo::bar' not ok 15 - classnames with nulls # Failed test 'classnames with nulls' # at ../dist/Data-Dumper/t/bugs.t line 124. # got: 'foo::b' # expected: 'foo::bar' --- a/dist/Data-Dumper/t/bugs.t +++ b/dist/Data-Dumper/t/bugs.t @@ -12,7 +12,7 @@ BEGIN { } use strict; -use Test::More tests => 15; +use Test::More tests => 17; use Data::Dumper; { @@ -118,6 +118,11 @@ SKIP: { () = \*{"\0".chr 256}; # same bug is eval Dumper(\*{"\0".chr 256}), \*{"\0".chr 256}, 'GVs with UTF8 and nulls'; + + $VAR1 = bless{}, "foo::b\0ar"; + eval(Dumper $VAR1); + is ref $VAR1, "foo::b\0ar", + 'classnames with nulls'; }; SKIP: { skip "no XS", 3 if not defined &Data::Dumper::Dumpxs; -- Reini Urban
Download (untitled) / with headers
text/plain 1.2k
Fixed in XS with the attached patch On Thu Mar 21 11:19:49 2013, RURBAN wrote: Show quoted text
> This added test shows that DD is not nul-safe (critical since perl > 5.16) > The classname needs to be checked for needs_quote(), otherwise the > chars after the nul are stripped. > not ok 11 - classnames with nulls > # Failed test 'classnames with nulls' > # at ../dist/Data-Dumper/t/bugs.t line 124. > # got: 'foo::b' > # expected: 'foo::bar' > not ok 15 - classnames with nulls > # Failed test 'classnames with nulls' > # at ../dist/Data-Dumper/t/bugs.t line 124. > # got: 'foo::b' > # expected: 'foo::bar' > > > --- a/dist/Data-Dumper/t/bugs.t > +++ b/dist/Data-Dumper/t/bugs.t > @@ -12,7 +12,7 @@ BEGIN { > } > > use strict; > -use Test::More tests => 15; > +use Test::More tests => 17; > use Data::Dumper; > > { > @@ -118,6 +118,11 @@ SKIP: { > () = \*{"\0".chr 256}; # same bug > is eval Dumper(\*{"\0".chr 256}), \*{"\0".chr 256}, > 'GVs with UTF8 and nulls'; > + > + $VAR1 = bless{}, "foo::b\0ar"; > + eval(Dumper $VAR1); > + is ref $VAR1, "foo::b\0ar", > + 'classnames with nulls'; > }; > SKIP: { > skip "no XS", 3 if not defined &Data::Dumper::Dumpxs;
-- Reini Urban
Subject: 0001-RT-84120-Data-Dumper-2.146-nul-safe-classnames.patch
From 9b88efb7f553173e5163af28014fdedb1cb51347 Mon Sep 17 00:00:00 2001 From: Reini Urban <rurban@x-ray.at> Date: Thu, 21 Mar 2013 11:23:17 -0500 Subject: [PATCH] [RT #84120] Data::Dumper 2.146 nul-safe classnames Quote \0 in bless classnames in the XS implementation. Not yet in the pure-perl variant, as it needs to qq the string (""). --- dist/Data-Dumper/Changes | 4 ++++ dist/Data-Dumper/Dumper.pm | 5 +++-- dist/Data-Dumper/Dumper.xs | 19 +++++++++++++++---- dist/Data-Dumper/t/bugs.t | 11 ++++++++++- 4 files changed, 32 insertions(+), 7 deletions(-) diff --git a/dist/Data-Dumper/Changes b/dist/Data-Dumper/Changes index 84627ba..1c1fadd 100644 --- a/dist/Data-Dumper/Changes +++ b/dist/Data-Dumper/Changes @@ -6,6 +6,10 @@ Changes - public release history for Data::Dumper =over 8 +=item 2.146 (Mar 21 2013) + +nul-safe classnames. Fixes RT #84120. (rurban) + =item 2.145 (Mar 15 2013) Test refactoring and fixing wide and far. diff --git a/dist/Data-Dumper/Dumper.pm b/dist/Data-Dumper/Dumper.pm index a04024e..c6d402a 100644 --- a/dist/Data-Dumper/Dumper.pm +++ b/dist/Data-Dumper/Dumper.pm @@ -10,7 +10,7 @@ package Data::Dumper; BEGIN { - $VERSION = '2.145'; # Don't forget to set version and release + $VERSION = '2.146'; # Don't forget to set version and release } # date in POD below! #$| = 1; @@ -705,6 +705,7 @@ sub Sparseseen { # used by qquote below my %esc = ( + "\0" => "\\0", "\a" => "\\a", "\b" => "\\b", "\t" => "\\t", @@ -1401,7 +1402,7 @@ modify it under the same terms as Perl itself. =head1 VERSION -Version 2.145 (March 15 2013)) +Version 2.146 (March 21 2013) =head1 SEE ALSO diff --git a/dist/Data-Dumper/Dumper.xs b/dist/Data-Dumper/Dumper.xs index b74650a..8bbc914 100644 --- a/dist/Data-Dumper/Dumper.xs +++ b/dist/Data-Dumper/Dumper.xs @@ -145,6 +145,13 @@ esc_q(char *d, const char *s, STRLEN slen) while (slen > 0) { switch (*s) { +#if 0 + case '\0': + *d = *s; + ++ret; + ++d; ++s; --slen; + break; +#endif case '\'': case '\\': *d = '\\'; @@ -854,17 +861,21 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv, if (realpack && !no_bless) { /* free blessed allocs */ I32 plen; - I32 pticks; + I32 pticks = 0; if (indent >= 2) { SvREFCNT_dec(apad); apad = blesspad; } sv_catpvn(retval, ", '", 3); - +#if PERL_VERSION >= 16 + plen = HvNAMELEN_get(SvSTASH(ival)); + pticks = plen - strlen(realpack); +#else plen = strlen(realpack); - pticks = num_q(realpack, plen); - if (pticks) { /* needs escaping */ +#endif + pticks += num_q(realpack, plen); + if (pticks || needs_quote(realpack, plen)) { /* needs escaping */ char *npack; char *npack_buffer = NULL; diff --git a/dist/Data-Dumper/t/bugs.t b/dist/Data-Dumper/t/bugs.t index a440b0a..79426e2 100644 --- a/dist/Data-Dumper/t/bugs.t +++ b/dist/Data-Dumper/t/bugs.t @@ -12,7 +12,7 @@ BEGIN { } use strict; -use Test::More tests => 15; +use Test::More tests => 17; use Data::Dumper; { @@ -118,6 +118,15 @@ SKIP: { () = \*{"\0".chr 256}; # same bug is eval Dumper(\*{"\0".chr 256}), \*{"\0".chr 256}, 'GVs with UTF8 and nulls'; + # [RT #84120] classnames not nul-safe, need to be quoted. + $VAR1 = bless{}, "foo::b\0ar"; + eval(Dumper $VAR1); + TODO: { + local $TODO = 'Useperl cannot do classnames with nul yet' + if $Data::Dumper::Useperl; + is ref $VAR1, "foo::b\0ar", + 'classnames with nul [RT #84120]'; + } }; SKIP: { skip "no XS", 3 if not defined &Data::Dumper::Dumpxs; -- 1.7.10.4


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.