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

TODO: dump the SvUTF8() hash keys similarly.

p4raw-id: //depot/perl@12243

diff --git a/dump.c b/dump.c
index 509df79..6d7c007 100644 (file)
--- 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 ae62d12..ff4bfae 100644 (file)
--- 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 8671366..81a6587 100755 (executable)
--- 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 be7bf82..cd2dc6f 100644 (file)
--- 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 077bc92..9c1115c 100644 (file)
--- 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)))