From: Jarkko Hietaniemi Date: Thu, 27 Sep 2001 02:20:06 +0000 (+0000) Subject: Dump SvUTF8(sv)s also as \x{...}. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e6abe6d8247cf3e8d3e08a706b164c5f207b68b6;p=p5sagit%2Fp5-mst-13.2.git 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 --- 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 --- 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 --- 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 --- 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 --- 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)))