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
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
