From 95869c09b86df682c7834ce2fc5007ecc61f111e Mon Sep 17 00:00:00 2001
From: Father Chrysostomos <sprout@cpan.org>
Date: Tue, 22 Nov 2011 12:56:37 -0800
Subject: [PATCH] Make Data::Dumper UTF8- and null-clean with GVs

---
 dist/Data-Dumper/Dumper.pm |  4 ++--
 dist/Data-Dumper/Dumper.xs | 29 +++++++++++++++++++++++------
 dist/Data-Dumper/t/bugs.t  | 25 ++++++++++++++++++++++++-
 3 files changed, 49 insertions(+), 9 deletions(-)

diff --git a/dist/Data-Dumper/Dumper.pm b/dist/Data-Dumper/Dumper.pm
index 8835721..56a561c 100644
--- 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
--- 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
--- 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
-- 
2.7.4