summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--dump.c63
-rw-r--r--embed.h6
-rwxr-xr-xembed.pl3
-rw-r--r--ext/Devel/Peek/Peek.t11
-rw-r--r--proto.h3
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)))
View Lorry Controller Status