From: Gerard Goossen <gerard@tty.nl>
Date: Wed, 11 Jul 2007 19:19:11 +0000 (+0200)
Subject: dump.c: do not use sv_len_utf8 because it modified the scalar
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e9569a7a55e6b33419f56b3697245a199938eb42;p=p5sagit%2Fp5-mst-13.2.git

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
--- 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
--- 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,