diff options
| author | Yves Orton <demerphq@gmail.com> | 2010-08-25 20:05:58 +0200 |
|---|---|---|
| committer | Yves Orton <demerphq@gmail.com> | 2010-08-25 20:06:21 +0200 |
| commit | d7d51f4b6ba689e611fef778b3f5d12981e872ba (patch) | |
| tree | 52e67539e1c0a45573b3ed6293cd3cb664281183 | |
| parent | b0c6325e9e0a1de42f208a0e41705cc75eb71433 (diff) | |
| download | perl-d7d51f4b6ba689e611fef778b3f5d12981e872ba.tar.gz | |
prevent Devel::Peek::Dump from lieing to us about evil class names
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.
| -rw-r--r-- | dump.c | 9 | ||||
| -rw-r--r-- | ext/Devel-Peek/t/Peek.t | 24 |
2 files changed, 31 insertions, 2 deletions
@@ -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'); } diff --git a/ext/Devel-Peek/t/Peek.t b/ext/Devel-Peek/t/Peek.t index 4e39d109e0..0b9009a315 100644 --- a/ext/Devel-Peek/t/Peek.t +++ b/ext/Devel-Peek/t/Peek.t @@ -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"); + |