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

diff --git a/dump.c b/dump.c
index 14e3c48..5030430 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -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 43dcb1c..0b6878e 100644 (file)
--- 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,