diff options
| author | Gerard Goossen <gerard@tty.nl> | 2007-07-11 21:19:11 +0200 |
|---|---|---|
| committer | Rafael Garcia-Suarez <rgarciasuarez@gmail.com> | 2007-07-11 17:36:40 +0000 |
| commit | e9569a7a55e6b33419f56b3697245a199938eb42 (patch) | |
| tree | 095fa1275d39edec21dcde82fb03a856e2d7201e | |
| parent | 500960a6f90e95877f90eef273215f16726946b1 (diff) | |
| download | perl-e9569a7a55e6b33419f56b3697245a199938eb42.tar.gz | |
dump.c: do not use sv_len_utf8 because it modified the scalar
Message-ID: <20070711171911.GD8177@ostwald>
do not use sv_len_utf8 because it modified the scalar.
Add a test to Peek.t to check that dumping doesn't modify anything;
the test is still TODO because hashiteration in dump.c set the OOK flag.
p4raw-id: //depot/perl@31588
| -rw-r--r-- | dump.c | 8 | ||||
| -rw-r--r-- | ext/Devel/Peek/t/Peek.t | 12 |
2 files changed, 14 insertions, 6 deletions
@@ -491,7 +491,7 @@ Perl_sv_peek(pTHX_ SV *sv) Perl_sv_catpvf(aTHX_ t, "%s)", pv_display(tmp, SvPVX_const(sv), SvCUR(sv), SvLEN(sv), 127)); if (SvUTF8(sv)) Perl_sv_catpvf(aTHX_ t, " [UTF8 \"%s\"]", - sv_uni_display(tmp, sv, 8 * sv_len_utf8(sv), + sv_uni_display(tmp, sv, 6 * SvCUR(sv), UNI_DISPLAY_QQ)); SvREFCNT_dec(tmp); } @@ -1570,8 +1570,8 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo if (SvOOK(sv)) PerlIO_printf(file, "( %s . ) ", pv_display(d, SvPVX_const(sv)-SvIVX(sv), SvIVX(sv), 0, pvlim)); PerlIO_printf(file, "%s", pv_display(d, SvPVX_const(sv), SvCUR(sv), SvLEN(sv), pvlim)); - if (SvUTF8(sv)) /* the 8? \x{....} */ - PerlIO_printf(file, " [UTF8 \"%s\"]", sv_uni_display(d, sv, 8 * sv_len_utf8(sv), UNI_DISPLAY_QQ)); + if (SvUTF8(sv)) /* the 6? \x{....} */ + PerlIO_printf(file, " [UTF8 \"%s\"]", sv_uni_display(d, sv, 6 * SvCUR(sv), UNI_DISPLAY_QQ)); PerlIO_printf(file, "\n"); Perl_dump_indent(aTHX_ level, file, " CUR = %"IVdf"\n", (IV)SvCUR(sv)); Perl_dump_indent(aTHX_ level, file, " LEN = %"IVdf"\n", (IV)SvLEN(sv)); @@ -1716,7 +1716,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo Perl_dump_indent(aTHX_ level+1, file, "Elt %s ", pv_display(d, keypv, len, 0, pvlim)); if (SvUTF8(keysv)) - PerlIO_printf(file, "[UTF8 \"%s\"] ", sv_uni_display(d, keysv, 8 * sv_len_utf8(keysv), UNI_DISPLAY_QQ)); + PerlIO_printf(file, "[UTF8 \"%s\"] ", sv_uni_display(d, keysv, 6 * SvCUR(keysv), UNI_DISPLAY_QQ)); if (HeKREHASH(he)) PerlIO_printf(file, "[REHASH] "); PerlIO_printf(file, "HASH = 0x%"UVxf"\n", (UV)hash); diff --git a/ext/Devel/Peek/t/Peek.t b/ext/Devel/Peek/t/Peek.t index 43dcb1cbfd..0b6878e927 100644 --- a/ext/Devel/Peek/t/Peek.t +++ b/ext/Devel/Peek/t/Peek.t @@ -14,7 +14,7 @@ BEGIN { require "./test.pl"; } use Devel::Peek; -plan(24); +plan(48); our $DEBUG = 0; open(SAVERR, ">&STDERR") or die "Can't dup STDERR: $!"; @@ -24,6 +24,8 @@ sub do_test { if (open(OUT,">peek$$")) { open(STDERR, ">&OUT") or die "Can't dup OUT: $!"; Dump($_[1]); + print STDERR "*****\n"; + Dump($_[1]); # second dump to compare with the first to make sure nothing changed. open(STDERR, ">&SAVERR") or die "Can't restore STDERR: $!"; close(OUT); if (open(IN, "peek$$")) { @@ -44,10 +46,15 @@ sub do_test { /mge; print $pattern, "\n" if $DEBUG; - my $dump = <IN>; + my ($dump, $dump2) = split m/\*\*\*\*\*\n/, scalar <IN>; print $dump, "\n" if $DEBUG; like( $dump, qr/\A$pattern\Z/ms ); + + local $TODO = $dump2 =~ /OOK/ ? "The hash iterator used in dump.c sets the OOK flag" : undef; + is($dump2, $dump); + close(IN); + return $1; } else { die "$0: failed to open peek$$: !\n"; @@ -264,6 +271,7 @@ do_test(14, \\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$pattern" \\d+\\. $ADDR<\\d+> FAKE "\\$DEBUG" flags=0x0 index=0 \\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$dump" + \\d+\\. $ADDR<\\d+> \\(\\d+,\\d+\\) "\\$dump2" OUTSIDE = $ADDR \\(MAIN\\)'); do_test(15, |