Dump SvUTF8(sv)s also as \x{...}.

TODO: dump the SvUTF8() hash keys similarly.

p4raw-id: //depot/perl@12243

5 files changed, 63 insertions, 23 deletions

diff --git a/dump.c b/dump.c
index 509df7916e..6d7c007e44 100644
--- a/dump.c
+++ b/dump.c
@@ -104,42 +104,65 @@ Perl_dump_eval(pTHX)
 }
 
 char *
-Perl_pv_display(pTHX_ SV *sv, char *pv, STRLEN cur, STRLEN len, STRLEN pvlim)
+Perl_pv_display(pTHX_ SV *dsv, char *pv, STRLEN cur, STRLEN len, STRLEN pvlim)
 {
     int truncated = 0;
     int nul_terminated = len > cur && pv[cur] == '\0';
 
-    sv_setpvn(sv, "\"", 1);
+    sv_setpvn(dsv, "\"", 1);
     for (; cur--; pv++) {
-	if (pvlim && SvCUR(sv) >= pvlim) {
+	if (pvlim && SvCUR(dsv) >= pvlim) {
             truncated++;
 	    break;
         }
         if (isPRINT(*pv)) {
             switch (*pv) {
-	    case '\t': sv_catpvn(sv, "\\t", 2);  break;
-	    case '\n': sv_catpvn(sv, "\\n", 2);  break;
-	    case '\r': sv_catpvn(sv, "\\r", 2);  break;
-	    case '\f': sv_catpvn(sv, "\\f", 2);  break;
-	    case '"':  sv_catpvn(sv, "\\\"", 2); break;
-	    case '\\': sv_catpvn(sv, "\\\\", 2); break;
-	    default:   sv_catpvn(sv, pv, 1);     break;
+	    case '\t': sv_catpvn(dsv, "\\t", 2);  break;
+	    case '\n': sv_catpvn(dsv, "\\n", 2);  break;
+	    case '\r': sv_catpvn(dsv, "\\r", 2);  break;
+	    case '\f': sv_catpvn(dsv, "\\f", 2);  break;
+	    case '"':  sv_catpvn(dsv, "\\\"", 2); break;
+	    case '\\': sv_catpvn(dsv, "\\\\", 2); break;
+	    default:   sv_catpvn(dsv, pv, 1);     break;
             }
         }
 	else {
 	    if (cur && isDIGIT(*(pv+1)))
-		Perl_sv_catpvf(aTHX_ sv, "\\%03o", (U8)*pv);
+		Perl_sv_catpvf(aTHX_ dsv, "\\%03o", (U8)*pv);
 	    else
-		Perl_sv_catpvf(aTHX_ sv, "\\%o", (U8)*pv);
+		Perl_sv_catpvf(aTHX_ dsv, "\\%o", (U8)*pv);
         }
     }
-    sv_catpvn(sv, "\"", 1);
+    sv_catpvn(dsv, "\"", 1);
     if (truncated)
-	sv_catpvn(sv, "...", 3);
+	sv_catpvn(dsv, "...", 3);
     if (nul_terminated)
-	sv_catpvn(sv, "\\0", 2);
+	sv_catpvn(dsv, "\\0", 2);
 
-    return SvPVX(sv);
+    return SvPVX(dsv);
+}
+
+char *
+Perl_sv_uni_display(pTHX_ SV *dsv, SV *ssv, STRLEN pvlim)
+{
+    int truncated = 0;
+    char *s, *e;
+
+    sv_setpvn(dsv, "\"", 1);
+    for (s = SvPVX(ssv), e = s + SvCUR(ssv); s < e; s += UTF8SKIP(s)) {
+	 UV u;
+	 if (pvlim && SvCUR(dsv) >= pvlim) {
+	      truncated++;
+	      break;
+	 }
+	 u = utf8_to_uvchr((U8*)s, 0);
+	 Perl_sv_catpvf(aTHX_ dsv, "\\x{%x}", u);
+    }
+    sv_catpvn(dsv, "\"", 1);
+    if (truncated)
+	 sv_catpvn(dsv, "...", 3);
+    
+    return SvPVX(dsv);
 }
 
 char *
@@ -278,7 +301,8 @@ Perl_sv_peek(pTHX_ SV *sv)
 		Perl_sv_catpvf(aTHX_ t, "[%s]", pv_display(tmp, SvPVX(sv)-SvIVX(sv), SvIVX(sv), 0, 127));
 	    Perl_sv_catpvf(aTHX_ t, "%s)", pv_display(tmp, SvPVX(sv), SvCUR(sv), SvLEN(sv), 127));
 	    if (SvUTF8(sv))
-		Perl_sv_catpvf(aTHX_ t, " [UTF8]");
+		Perl_sv_catpvf(aTHX_ t, " [UTF8 %s]",
+			       sv_uni_display(tmp, sv, 8 * sv_len_utf8(sv)));
 	    SvREFCNT_dec(tmp);
 	}
     }
@@ -1103,7 +1127,10 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
 	    Perl_dump_indent(aTHX_ level, file,"  PV = 0x%"UVxf" ", PTR2UV(SvPVX(sv)));
 	    if (SvOOK(sv))
 		PerlIO_printf(file, "( %s . ) ", pv_display(d, SvPVX(sv)-SvIVX(sv), SvIVX(sv), 0, pvlim));
-	    PerlIO_printf(file, "%s\n", pv_display(d, SvPVX(sv), SvCUR(sv), SvLEN(sv), pvlim));
+	    PerlIO_printf(file, "%s", pv_display(d, SvPVX(sv), SvCUR(sv), SvLEN(sv), pvlim));
+	    if (SvUTF8(sv)) /* the 8?  \x{....} */
+	        PerlIO_printf(file, " %s", sv_uni_display(d, sv, 8 * sv_len_utf8(sv)));
+	    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));
 	}
diff --git a/embed.h b/embed.h
index ae62d1236b..ff4bfaea82 100644
--- a/embed.h
+++ b/embed.h
@@ -810,6 +810,7 @@
 #define sv_usepvn_mg		Perl_sv_usepvn_mg
 #define get_vtbl		Perl_get_vtbl
 #define pv_display		Perl_pv_display
+#define sv_uni_display		Perl_sv_uni_display
 #define dump_indent		Perl_dump_indent
 #define dump_vindent		Perl_dump_vindent
 #define do_gv_dump		Perl_do_gv_dump
@@ -1063,7 +1064,7 @@
 #if defined(PERL_IN_SCOPE_C) || defined(PERL_DECL_PROT)
 #define save_scalar_at		S_save_scalar_at
 #endif
-#if defined(USE_ITHREADS) && (defined(PERL_IN_SHAREDSV_C) || defined(PERL_DECL_PROT))
+#if defined(USE_ITHREADS)
 #define sharedsv_init		Perl_sharedsv_init
 #define sharedsv_new		Perl_sharedsv_new
 #define sharedsv_find		Perl_sharedsv_find
@@ -2323,6 +2324,7 @@
 #define sv_usepvn_mg(a,b,c)	Perl_sv_usepvn_mg(aTHX_ a,b,c)
 #define get_vtbl(a)		Perl_get_vtbl(aTHX_ a)
 #define pv_display(a,b,c,d,e)	Perl_pv_display(aTHX_ a,b,c,d,e)
+#define sv_uni_display(a,b,c)	Perl_sv_uni_display(aTHX_ a,b,c)
 #define dump_vindent(a,b,c,d)	Perl_dump_vindent(aTHX_ a,b,c,d)
 #define do_gv_dump(a,b,c,d)	Perl_do_gv_dump(aTHX_ a,b,c,d)
 #define do_gvgv_dump(a,b,c,d)	Perl_do_gvgv_dump(aTHX_ a,b,c,d)
@@ -2573,7 +2575,7 @@
 #if defined(PERL_IN_SCOPE_C) || defined(PERL_DECL_PROT)
 #define save_scalar_at(a)	S_save_scalar_at(aTHX_ a)
 #endif
-#if defined(USE_ITHREADS) && (defined(PERL_IN_SHAREDSV_C) || defined(PERL_DECL_PROT))
+#if defined(USE_ITHREADS)
 #define sharedsv_init()		Perl_sharedsv_init(aTHX)
 #define sharedsv_new()		Perl_sharedsv_new(aTHX)
 #define sharedsv_find(a)	Perl_sharedsv_find(aTHX_ a)
diff --git a/embed.pl b/embed.pl
index 86713667c7..81a65879ff 100755
--- a/embed.pl
+++ b/embed.pl
@@ -1898,8 +1898,9 @@ Apd	|void	|sv_setpvn_mg	|SV *sv|const char *ptr|STRLEN len
 Apd	|void	|sv_setsv_mg	|SV *dstr|SV *sstr
 Apd	|void	|sv_usepvn_mg	|SV *sv|char *ptr|STRLEN len
 Ap	|MGVTBL*|get_vtbl	|int vtbl_id
-p	|char*	|pv_display	|SV *sv|char *pv|STRLEN cur|STRLEN len \
+p	|char*	|pv_display	|SV *dsv|char *pv|STRLEN cur|STRLEN len \
 				|STRLEN pvlim
+p	|char*	|sv_uni_display	|SV *dsv|SV *ssv|STRLEN pvlim
 Afp	|void	|dump_indent	|I32 level|PerlIO *file|const char* pat|...
 Ap	|void	|dump_vindent	|I32 level|PerlIO *file|const char* pat \
 				|va_list *args
diff --git a/ext/Devel/Peek/Peek.t b/ext/Devel/Peek/Peek.t
index be7bf820d7..cd2dc6f8fe 100644
--- a/ext/Devel/Peek/Peek.t
+++ b/ext/Devel/Peek/Peek.t
@@ -12,7 +12,7 @@ BEGIN {
 
 use Devel::Peek;
 
-print "1..17\n";
+print "1..18\n";
 
 our $DEBUG = 0;
 open(SAVERR, ">&STDERR") or die "Can't dup STDERR: $!";
@@ -317,6 +317,15 @@ do_test(17,
     FLAGS = $ADDR
     EGV = $ADDR\\t"a"');
 
+do_test(18,
+	chr(256).chr(0).chr(512),
+'SV = PV\\($ADDR\\) at $ADDR
+  REFCNT = 1
+  FLAGS = \\(PADBUSY,PADTMP,POK,READONLY,pPOK,UTF8\\)
+  PV = $ADDR "\\\304\\\200\\\0\\\310\\\200"\\\0 "\\\x\{100\}\\\x\{0\}\\\x\{200\}"
+  CUR = 5
+  LEN = 6');
+
 END {
   1 while unlink("peek$$");
 }
diff --git a/proto.h b/proto.h
index 077bc92c5d..9c1115c585 100644
--- a/proto.h
+++ b/proto.h
@@ -897,7 +897,8 @@ PERL_CALLCONV void	Perl_sv_setpvn_mg(pTHX_ SV *sv, const char *ptr, STRLEN len);
 PERL_CALLCONV void	Perl_sv_setsv_mg(pTHX_ SV *dstr, SV *sstr);
 PERL_CALLCONV void	Perl_sv_usepvn_mg(pTHX_ SV *sv, char *ptr, STRLEN len);
 PERL_CALLCONV MGVTBL*	Perl_get_vtbl(pTHX_ int vtbl_id);
-PERL_CALLCONV char*	Perl_pv_display(pTHX_ SV *sv, char *pv, STRLEN cur, STRLEN len, STRLEN pvlim);
+PERL_CALLCONV char*	Perl_pv_display(pTHX_ SV *dsv, char *pv, STRLEN cur, STRLEN len, STRLEN pvlim);
+PERL_CALLCONV char*	Perl_sv_uni_display(pTHX_ SV *dsv, SV *ssv, STRLEN pvlim);
 PERL_CALLCONV void	Perl_dump_indent(pTHX_ I32 level, PerlIO *file, const char* pat, ...)
 #ifdef CHECK_FORMAT
  __attribute__((format(printf,pTHX_3,pTHX_4)))