Make Data::Dumper UTF8- and null-clean with GVs

diff --git a/dist/Data-Dumper/Dumper.pm b/dist/Data-Dumper/Dumper.pm
index 8835721..56a561c 100644 (file)
--- a/dist/Data-Dumper/Dumper.pm
+++ b/dist/Data-Dumper/Dumper.pm
@@ -9,7 +9,7 @@
 
 package Data::Dumper;
 
-$VERSION = '2.134'; # Don't forget to set version and release date in POD!
+$VERSION = '2.135'; # Don't forget to set version and release date in POD!
 
 #$| = 1;
 
@@ -1297,7 +1297,7 @@ modify it under the same terms as Perl itself.
 
 =head1 VERSION
 
-Version 2.134  (September 7 2011)
+Version 2.135  (December 20 2011)
 
 =head1 SEE ALSO
 

diff --git a/dist/Data-Dumper/Dumper.xs b/dist/Data-Dumper/Dumper.xs
index c8e96cd..4bd3c7e 100644 (file)
--- a/dist/Data-Dumper/Dumper.xs
+++ b/dist/Data-Dumper/Dumper.xs
@@ -15,7 +15,7 @@
 static I32 num_q (const char *s, STRLEN slen);
 static I32 esc_q (char *dest, const char *src, STRLEN slen);
 static I32 esc_q_utf8 (pTHX_ SV *sv, const char *src, STRLEN slen);
-static I32 needs_quote(register const char *s);
+static I32 needs_quote(register const char *s, STRLEN len);
 static SV *sv_x (pTHX_ SV *sv, const char *str, STRLEN len, I32 n);
 static I32 DD_dump (pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval,
                    HV *seenhv, AV *postav, I32 *levelp, I32 indent,
@@ -63,11 +63,12 @@ Perl_utf8_to_uvchr(pTHX_ U8 *s, STRLEN *retlen)
 
 /* does a string need to be protected? */
 static I32
-needs_quote(register const char *s)
+needs_quote(register const char *s, STRLEN len)
 {
+    const char *send = s+len;
 TOP:
     if (s[0] == ':') {
-       if (*++s) {
+       if (++s<send) {
            if (*s++ != ':')
                return 1;
        }
@@ -75,7 +76,7 @@ TOP:
            return 1;
     }
     if (isIDFIRST(*s)) {
-       while (*++s)
+       while (++s<send)
            if (!isALNUM(*s)) {
                if (*s == ':')
                    goto TOP;
@@ -741,7 +742,7 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
                    more common doesn't need quoting case.
                    The code is also smaller (22044 vs 22260) because I've been
                    able to pull the common logic out to both sides.  */
-                if (quotekeys || needs_quote(key)) {
+                if (quotekeys || needs_quote(key,keylen)) {
                     if (do_utf8) {
                         STRLEN ocur = SvCUR(retval);
                         nlen = esc_q_utf8(aTHX_ retval, key, klen);
@@ -918,7 +919,22 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
                c += 4;
                i -= 4;
            }
-           if (needs_quote(c)) {
+           if (needs_quote(c,i)) {
+#ifdef GvNAMEUTF8
+             if (GvNAMEUTF8(val)) {
+               sv_grow(retval, SvCUR(retval)+2);
+               r = SvPVX(retval)+SvCUR(retval);
+               r[0] = '*'; r[1] = '{';
+               SvCUR_set(retval, SvCUR(retval)+2);
+               esc_q_utf8(aTHX_ retval, c, i);
+               sv_grow(retval, SvCUR(retval)+2);
+               r = SvPVX(retval)+SvCUR(retval);
+               r[0] = '}'; r[1] = '\0';
+               i = 1;
+             }
+             else
+#endif
+             {
                sv_grow(retval, SvCUR(retval)+6+2*i);
                r = SvPVX(retval)+SvCUR(retval);
                r[0] = '*'; r[1] = '{'; r[2] = '\'';
@@ -926,6 +942,7 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
                i += 3;
                r[i++] = '\''; r[i++] = '}';
                r[i] = '\0';
+             }
            }
            else {
                sv_grow(retval, SvCUR(retval)+i+2);

diff --git a/dist/Data-Dumper/t/bugs.t b/dist/Data-Dumper/t/bugs.t
index 73d18c0..f0b04f8 100644 (file)
--- 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 => 7;
+use Test::More tests => 13;
 use Data::Dumper;
 
 {
@@ -100,4 +100,27 @@ SKIP: {
     ok("ok", "no crash dumping malformed utf8 with the utf8 flag on");
 }
 
+{
+  # We have to test reference equivalence, rather than actual output, as
+  # Perl itself is buggy prior to 5.15.6.  Output from DD should at least
+  # evaluate to the same typeglob, regardless of perl bugs.
+  my $tests = sub {
+    my $VAR1;
+    no strict 'refs';
+    is eval(Dumper \*{"foo::b\0ar"}), \*{"foo::b\0ar"},
+      'GVs with nulls';
+    is eval Dumper(\*{chr 256}), \*{chr 256},
+      'GVs with UTF8 names (or not, depending on perl version)';
+    is eval Dumper(\*{"\0".chr 256}), \*{"\0".chr 256},
+      'GVs with UTF8 and nulls';
+  };
+  SKIP: {
+    skip "no XS", 3 if not defined &Data::Dumper::Dumpxs;
+    local $Data::Dumper::Useperl = 0;
+    &$tests;
+  }
+  local $Data::Dumper::Useperl = 1;
+  &$tests;
+}
+
 # EOF