This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
prevent Devel::Peek::Dump from lieing to us about evil class names
authorYves Orton <demerphq@gmail.com>
Wed, 25 Aug 2010 18:05:58 +0000 (20:05 +0200)
committerYves Orton <demerphq@gmail.com>
Wed, 25 Aug 2010 18:06:21 +0000 (20:06 +0200)
While one certainly can argue the merits of using a class name like "\0", it is legal
so lets avoid it confusing our primary debugging tool.

dump.c
ext/Devel-Peek/t/Peek.t

diff --git a/dump.c b/dump.c
index 06ce879..832c60c 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -1434,7 +1434,14 @@ Perl_do_hv_dump(pTHX_ I32 level, PerlIO *file, const char *name, HV *sv)
 
     Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv));
     if (sv && (hvname = HvNAME_get(sv)))
-       PerlIO_printf(file, "\t\"%s\"\n", hvname);
+    {
+       /* we have to use pv_display and HvNAMELEN_get() so that we display the real package
+           name which quite legally could contain insane things like tabs, newlines, nulls or
+           other scary crap - this should produce sane results - except maybe for unicode package
+           names - but we will wait for someone to file a bug on that - demerphq */
+        SV * const tmpsv = newSVpvs("");
+        PerlIO_printf(file, "\t%s\n", pv_display(tmpsv, hvname, HvNAMELEN_get(sv), 0, 1024));
+    }
     else
        PerlIO_putc(file, '\n');
 }
index 4e39d10..0b9009a 100644 (file)
@@ -8,7 +8,7 @@ BEGIN {
     }
 }
 
-use Test::More tests => 52;
+use Test::More tests => 54;
 
 use Devel::Peek;
 
@@ -663,3 +663,25 @@ do_test(26,
     PADLIST = $ADDR
     PADNAME = $ADDR\\($ADDR\\) PAD = $ADDR\\($ADDR\\)
     OUTSIDE = $ADDR \\(MAIN\\)');
+
+do_test(27,
+        (bless {}, "\0::foo::\n::baz::\t::\0"),
+'SV = $RV\\($ADDR\\) at $ADDR
+  REFCNT = 1
+  FLAGS = \\(ROK\\)
+  RV = $ADDR
+  SV = PVHV\\($ADDR\\) at $ADDR
+    REFCNT = 1
+    FLAGS = \\(OBJECT,SHAREKEYS\\)
+    IV = 0                                     # $] < 5.009
+    NV = 0                                     # $] < 5.009
+    STASH = $ADDR\\t"\\\\0::foo::\\\\n::baz::\\\\t::\\\\0"
+    ARRAY = $ADDR
+    KEYS = 0
+    FILL = 0
+    MAX = 7
+    RITER = -1
+    EITER = 0x0', '',
+       $] > 5.009 ? 'The hash iterator used in dump.c sets the OOK flag'
+       : "Something causes the HV's array to become allocated");
+