X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=dump.c;h=0d87fab069fbb6d385ef2452905d2e4ac695c464;hb=8222d950c8d6de1b5e2b0ab47462f5dfd4bdf782;hp=6d7c007e4424d8169190d01b034dcd721e6428f8;hpb=e6abe6d8247cf3e8d3e08a706b164c5f207b68b6;p=p5sagit%2Fp5-mst-13.2.git diff --git a/dump.c b/dump.c index 6d7c007..0d87fab 100644 --- a/dump.c +++ b/dump.c @@ -143,22 +143,21 @@ Perl_pv_display(pTHX_ SV *dsv, char *pv, STRLEN cur, STRLEN len, STRLEN pvlim) } char * -Perl_sv_uni_display(pTHX_ SV *dsv, SV *ssv, STRLEN pvlim) +Perl_pv_uni_display(pTHX_ SV *dsv, U8 *spv, STRLEN len, STRLEN pvlim, UV flags) { int truncated = 0; char *s, *e; - sv_setpvn(dsv, "\"", 1); - for (s = SvPVX(ssv), e = s + SvCUR(ssv); s < e; s += UTF8SKIP(s)) { + sv_setpvn(dsv, "", 0); + for (s = (char *)spv, e = s + len; 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); + Perl_sv_catpvf(aTHX_ dsv, "\\x{%"UVxf"}", u); } - sv_catpvn(dsv, "\"", 1); if (truncated) sv_catpvn(dsv, "...", 3); @@ -166,6 +165,13 @@ Perl_sv_uni_display(pTHX_ SV *dsv, SV *ssv, STRLEN pvlim) } char * +Perl_sv_uni_display(pTHX_ SV *dsv, SV *ssv, STRLEN pvlim, UV flags) +{ + return Perl_pv_uni_display(aTHX_ dsv, (U8*)SvPVX(ssv), SvCUR(ssv), + pvlim, flags); +} + +char * Perl_sv_peek(pTHX_ SV *sv) { SV *t = sv_newmortal(); @@ -301,8 +307,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 %s]", - sv_uni_display(tmp, sv, 8 * sv_len_utf8(sv))); + Perl_sv_catpvf(aTHX_ t, " [UTF8 \"%s\"]", + sv_uni_display(tmp, sv, 8 * sv_len_utf8(sv), 0)); SvREFCNT_dec(tmp); } } @@ -616,7 +622,13 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o) } else if (o->op_type == OP_EXIT) { if (o->op_private & OPpEXIT_VMSISH) - sv_catpv(tmpsv, ",EXIST_VMSISH"); + sv_catpv(tmpsv, ",EXIT_VMSISH"); + if (o->op_private & OPpHUSH_VMSISH) + sv_catpv(tmpsv, ",HUSH_VMSISH"); + } + else if (o->op_type == OP_DIE) { + if (o->op_private & OPpHUSH_VMSISH) + sv_catpv(tmpsv, ",HUSH_VMSISH"); } if (o->op_flags & OPf_MOD && o->op_private & OPpLVAL_INTRO) sv_catpv(tmpsv, ",INTRO"); @@ -1129,7 +1141,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo PerlIO_printf(file, "( %s . ) ", pv_display(d, SvPVX(sv)-SvIVX(sv), SvIVX(sv), 0, 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, " [UTF8 \"%s\"]", sv_uni_display(d, sv, 8 * sv_len_utf8(sv), 0)); 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)); @@ -1251,14 +1263,18 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo hv_iterinit(hv); while ((he = hv_iternext(hv)) && count--) { - SV *elt; - char *key; - I32 len; + SV *elt, *keysv; + char *keypv; + STRLEN len; U32 hash = HeHASH(he); - key = hv_iterkey(he, &len); + keysv = hv_iterkeysv(he); + keypv = SvPV(keysv, len); elt = hv_iterval(hv, he); - Perl_dump_indent(aTHX_ level+1, file, "Elt %s HASH = 0x%"UVxf"\n", pv_display(d, key, len, 0, pvlim), (UV)hash); + 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), 0)); + PerlIO_printf(file, "HASH = 0x%"UVxf"\n", (UV)hash); do_sv_dump(level+1, file, elt, nest+1, maxnest, dumpops, pvlim); } hv_iterinit(hv); /* Return to status quo */