X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=dump.c;h=37337bbabe69837ea1fbb798966cbd91ca19b855;hb=20e8a3a35e61c7fcc6a4173969d7b685e762aef7;hp=1fdbb638c54763525586eb766f464e59f355bd5d;hpb=08e447406761619260203dbbef9cf10b6efa533c;p=p5sagit%2Fp5-mst-13.2.git diff --git a/dump.c b/dump.c index 1fdbb63..37337bb 100644 --- a/dump.c +++ b/dump.c @@ -72,6 +72,7 @@ void Perl_dump_indent(pTHX_ I32 level, PerlIO *file, const char* pat, ...) { va_list args; + PERL_ARGS_ASSERT_DUMP_INDENT; va_start(args, pat); dump_vindent(level, file, pat, &args); va_end(args); @@ -81,6 +82,7 @@ void Perl_dump_vindent(pTHX_ I32 level, PerlIO *file, const char* pat, va_list *args) { dVAR; + PERL_ARGS_ASSERT_DUMP_VINDENT; PerlIO_printf(file, "%*s", (int)(level*PL_dumpindent), ""); PerlIO_vprintf(file, pat, *args); } @@ -101,6 +103,8 @@ Perl_dump_packsubs(pTHX_ const HV *stash) dVAR; I32 i; + PERL_ARGS_ASSERT_DUMP_PACKSUBS; + if (!HvARRAY(stash)) return; for (i = 0; i <= (I32) HvMAX(stash); i++) { @@ -127,6 +131,8 @@ Perl_dump_sub(pTHX_ const GV *gv) { SV * const sv = sv_newmortal(); + PERL_ARGS_ASSERT_DUMP_SUB; + gv_fullname3(sv, gv, NULL); Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nSUB %s = ", SvPVX_const(sv)); if (CvISXSUB(GvCV(gv))) @@ -144,6 +150,8 @@ Perl_dump_form(pTHX_ const GV *gv) { SV * const sv = sv_newmortal(); + PERL_ARGS_ASSERT_DUMP_FORM; + gv_fullname3(sv, gv, NULL); Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nFORMAT %s = ", SvPVX_const(sv)); if (CvROOT(GvFORM(gv))) @@ -219,6 +227,8 @@ Perl_pv_escape( pTHX_ SV *dsv, char const * const str, const char * const end = pv + count; /* end of string */ octbuf[0] = esc; + PERL_ARGS_ASSERT_PV_ESCAPE; + if (!(flags & PERL_PV_ESCAPE_NOCLEAR)) { /* This won't alter the UTF-8 flag */ sv_setpvn(dsv, "", 0); @@ -332,7 +342,9 @@ Perl_pv_pretty( pTHX_ SV *dsv, char const * const str, const STRLEN count, { const U8 dq = (flags & PERL_PV_PRETTY_QUOTE) ? '"' : '%'; STRLEN escaped; - + + PERL_ARGS_ASSERT_PV_PRETTY; + if (!(flags & PERL_PV_PRETTY_NOCLEAR)) { /* This won't alter the UTF-8 flag */ sv_setpvn(dsv, "", 0); @@ -383,6 +395,8 @@ Note that the final string may be up to 7 chars longer than pvlim. char * Perl_pv_display(pTHX_ SV *dsv, const char *pv, STRLEN cur, STRLEN len, STRLEN pvlim) { + PERL_ARGS_ASSERT_PV_DISPLAY; + pv_pretty( dsv, pv, cur, pvlim, NULL, NULL, PERL_PV_PRETTY_DUMP); if (len > cur && pv[cur] == '\0') sv_catpvn( dsv, "\\0", 2 ); @@ -532,6 +546,8 @@ Perl_do_pmop_dump(pTHX_ I32 level, PerlIO *file, const PMOP *pm) { char ch; + PERL_ARGS_ASSERT_DO_PMOP_DUMP; + if (!pm) { Perl_dump_indent(aTHX_ level, file, "{}\n"); return; @@ -568,6 +584,8 @@ S_pm_description(pTHX_ const PMOP *pm) const REGEXP * const regex = PM_GETRE(pm); const U32 pmflags = pm->op_pmflags; + PERL_ARGS_ASSERT_PM_DESCRIPTION; + if (pmflags & PMf_ONCE) sv_catpv(desc, ",ONCE"); #ifdef USE_ITHREADS @@ -733,6 +751,8 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o) UV seq; const OPCODE optype = o->op_type; + PERL_ARGS_ASSERT_DO_OP_DUMP; + sequence(o); Perl_dump_indent(aTHX_ level, file, "{\n"); level++; @@ -962,7 +982,7 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o) sv_catpv(tmpsv, ",HUSH_VMSISH"); } else if (PL_check[optype] != MEMBER_TO_FPTR(Perl_ck_ftst)) { - if (OP_IS_FILETEST_ACCESS(o) && o->op_private & OPpFT_ACCESS) + if (OP_IS_FILETEST_ACCESS(o->op_type) && o->op_private & OPpFT_ACCESS) sv_catpv(tmpsv, ",FT_ACCESS"); if (o->op_private & OPpFT_STACKED) sv_catpv(tmpsv, ",FT_STACKED"); @@ -1045,6 +1065,7 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o) #endif break; case OP_CONST: + case OP_HINTSEVAL: case OP_METHOD_NAMED: #ifndef USE_ITHREADS /* with ITHREADS, consts are stored in the pad, and the right pad @@ -1052,7 +1073,6 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o) Perl_dump_indent(aTHX_ level, file, "SV = %s\n", SvPEEK(cSVOPo_sv)); #endif break; - case OP_SETSTATE: case OP_NEXTSTATE: case OP_DBSTATE: if (CopLINE(cCOPo)) @@ -1123,6 +1143,7 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o) void Perl_op_dump(pTHX_ const OP *o) { + PERL_ARGS_ASSERT_OP_DUMP; do_op_dump(0, Perl_debug_log, o); } @@ -1131,6 +1152,8 @@ Perl_gv_dump(pTHX_ GV *gv) { SV *sv; + PERL_ARGS_ASSERT_GV_DUMP; + if (!gv) { PerlIO_printf(Perl_debug_log, "{}\n"); return; @@ -1188,7 +1211,7 @@ static const struct { const char type; const char *name; } magic_names[] = { { PERL_MAGIC_qr, "qr(r)" }, { PERL_MAGIC_sigelem, "sigelem(s)" }, { PERL_MAGIC_taint, "taint(t)" }, - { PERL_MAGIC_uvar_elem, "uvar_elem(v)" }, + { PERL_MAGIC_uvar_elem, "uvar_elem(u)" }, { PERL_MAGIC_vec, "vec(v)" }, { PERL_MAGIC_vstring, "vstring(V)" }, { PERL_MAGIC_utf8, "utf8(w)" }, @@ -1202,6 +1225,8 @@ static const struct { const char type; const char *name; } magic_names[] = { void Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, const MAGIC *mg, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim) { + PERL_ARGS_ASSERT_DO_MAGIC_DUMP; + for (; mg; mg = mg->mg_moremagic) { Perl_dump_indent(aTHX_ level, file, " MAGIC = 0x%"UVxf"\n", PTR2UV(mg)); @@ -1343,6 +1368,9 @@ void Perl_do_hv_dump(pTHX_ I32 level, PerlIO *file, const char *name, HV *sv) { const char *hvname; + + PERL_ARGS_ASSERT_DO_HV_DUMP; + Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv)); if (sv && (hvname = HvNAME_get(sv))) PerlIO_printf(file, "\t\"%s\"\n", hvname); @@ -1353,6 +1381,8 @@ Perl_do_hv_dump(pTHX_ I32 level, PerlIO *file, const char *name, HV *sv) void Perl_do_gv_dump(pTHX_ I32 level, PerlIO *file, const char *name, GV *sv) { + PERL_ARGS_ASSERT_DO_GV_DUMP; + Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv)); if (sv && GvNAME(sv)) PerlIO_printf(file, "\t\"%s\"\n", GvNAME(sv)); @@ -1363,6 +1393,8 @@ Perl_do_gv_dump(pTHX_ I32 level, PerlIO *file, const char *name, GV *sv) void Perl_do_gvgv_dump(pTHX_ I32 level, PerlIO *file, const char *name, GV *sv) { + PERL_ARGS_ASSERT_DO_GVGV_DUMP; + Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv)); if (sv && GvNAME(sv)) { const char *hvname; @@ -1384,6 +1416,8 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo U32 flags; U32 type; + PERL_ARGS_ASSERT_DO_SV_DUMP; + if (!sv) { Perl_dump_indent(aTHX_ level, file, "SV = 0\n"); return; @@ -1554,7 +1588,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo (UV) COP_SEQ_RANGE_HIGH(sv)); } else if ((type >= SVt_PVNV && type != SVt_PVAV && type != SVt_PVHV && type != SVt_PVCV && type != SVt_PVFM && type != SVt_REGEXP - && !isGV_with_GP(sv) && !SvVALID(sv)) + && type != SVt_PVIO && !isGV_with_GP(sv) && !SvVALID(sv)) || type == SVt_NV) { STORE_NUMERIC_LOCAL_SET_STANDARD(); /* %Vg doesn't work? --jhi */ @@ -1580,7 +1614,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo if (SvOOK(sv)) { SvOOK_offset(sv, delta); Perl_dump_indent(aTHX_ level, file," OFFSET = %"UVuf"\n", - delta); + (UV) delta); } else { delta = 0; } @@ -1906,6 +1940,9 @@ void Perl_sv_dump(pTHX_ SV *sv) { dVAR; + + PERL_ARGS_ASSERT_SV_DUMP; + if (SvROK(sv)) do_sv_dump(0, Perl_debug_log, sv, 0, 4, 0, 0); else @@ -1955,12 +1992,16 @@ I32 Perl_debop(pTHX_ const OP *o) { dVAR; + + PERL_ARGS_ASSERT_DEBOP; + if (CopSTASH_eq(PL_curcop, PL_debstash) && !DEBUG_J_TEST_) return 0; Perl_deb(aTHX_ "%s", OP_NAME(o)); switch (o->op_type) { case OP_CONST: + case OP_HINTSEVAL: PerlIO_printf(Perl_debug_log, "(%s)", SvPEEK(cSVOPo_sv)); break; case OP_GVSV: @@ -2026,6 +2067,9 @@ void Perl_watch(pTHX_ char **addr) { dVAR; + + PERL_ARGS_ASSERT_WATCH; + PL_watchaddr = addr; PL_watchok = *addr; PerlIO_printf(Perl_debug_log, "WATCHING, %"UVxf" is currently %"UVxf"\n", @@ -2036,6 +2080,9 @@ STATIC void S_debprof(pTHX_ const OP *o) { dVAR; + + PERL_ARGS_ASSERT_DEBPROF; + if (!DEBUG_J_TEST_ && CopSTASH_eq(PL_curcop, PL_debstash)) return; if (!PL_profiledata) @@ -2067,6 +2114,9 @@ STATIC void S_xmldump_attr(pTHX_ I32 level, PerlIO *file, const char* pat, ...) { va_list args; + + PERL_ARGS_ASSERT_XMLDUMP_ATTR; + PerlIO_printf(file, "\n "); va_start(args, pat); xmldump_vindent(level, file, pat, &args); @@ -2078,6 +2128,7 @@ void Perl_xmldump_indent(pTHX_ I32 level, PerlIO *file, const char* pat, ...) { va_list args; + PERL_ARGS_ASSERT_XMLDUMP_INDENT; va_start(args, pat); xmldump_vindent(level, file, pat, &args); va_end(args); @@ -2086,6 +2137,8 @@ Perl_xmldump_indent(pTHX_ I32 level, PerlIO *file, const char* pat, ...) void Perl_xmldump_vindent(pTHX_ I32 level, PerlIO *file, const char* pat, va_list *args) { + PERL_ARGS_ASSERT_XMLDUMP_VINDENT; + PerlIO_printf(file, "%*s", (int)(level*PL_dumpindent), ""); PerlIO_vprintf(file, pat, *args); } @@ -2107,6 +2160,8 @@ Perl_xmldump_packsubs(pTHX_ const HV *stash) I32 i; HE *entry; + PERL_ARGS_ASSERT_XMLDUMP_PACKSUBS; + if (!HvARRAY(stash)) return; for (i = 0; i <= (I32) HvMAX(stash); i++) { @@ -2131,6 +2186,8 @@ Perl_xmldump_sub(pTHX_ const GV *gv) { SV * const sv = sv_newmortal(); + PERL_ARGS_ASSERT_XMLDUMP_SUB; + gv_fullname3(sv, gv, NULL); Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "\nSUB %s = ", SvPVX(sv)); if (CvXSUB(GvCV(gv))) @@ -2148,6 +2205,8 @@ Perl_xmldump_form(pTHX_ const GV *gv) { SV * const sv = sv_newmortal(); + PERL_ARGS_ASSERT_XMLDUMP_FORM; + gv_fullname3(sv, gv, NULL); Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "\nFORMAT %s = ", SvPVX(sv)); if (CvROOT(GvFORM(gv))) @@ -2165,6 +2224,7 @@ Perl_xmldump_eval(pTHX) char * Perl_sv_catxmlsv(pTHX_ SV *dsv, SV *ssv) { + PERL_ARGS_ASSERT_SV_CATXMLSV; return sv_catxmlpvn(dsv, SvPVX(ssv), SvCUR(ssv), SvUTF8(ssv)); } @@ -2177,6 +2237,8 @@ Perl_sv_catxmlpvn(pTHX_ SV *dsv, const char *pv, STRLEN len, int utf8) STRLEN dsvcur; STRLEN cl; + PERL_ARGS_ASSERT_SV_CATXMLPVN; + sv_catpvn(dsv,"",0); dsvcur = SvCUR(dsv); /* in case we have to restart */ @@ -2300,6 +2362,8 @@ Perl_sv_xmlpeek(pTHX_ SV *sv) STRLEN n_a; int unref = 0; + PERL_ARGS_ASSERT_SV_XMLPEEK; + sv_utf8_upgrade(t); sv_setpvn(t, "", 0); /* retry: */ @@ -2460,6 +2524,8 @@ Perl_sv_xmlpeek(pTHX_ SV *sv) void Perl_do_pmop_xmldump(pTHX_ I32 level, PerlIO *file, const PMOP *pm) { + PERL_ARGS_ASSERT_DO_PMOP_XMLDUMP; + if (!pm) { Perl_xmldump_indent(aTHX_ level, file, "\n"); return; @@ -2468,9 +2534,8 @@ Perl_do_pmop_xmldump(pTHX_ I32 level, PerlIO *file, const PMOP *pm) level++; if (PM_GETRE(pm)) { REGEXP *const r = PM_GETRE(pm); - /* FIXME ORANGE - REGEXP can be 8 bit, so this is sometimes buggy: */ - SV * const tmpsv = newSVpvn(RX_PRECOMP(r),RX_PRELEN(r)); - SvUTF8_on(tmpsv); + SV * const tmpsv = newSVpvn_utf8("", 0, TRUE); + sv_catxmlsv(tmpsv, (SV*)r); Perl_xmldump_indent(aTHX_ level, file, "pre=\"%s\"\n", SvPVX(tmpsv)); SvREFCNT_dec(tmpsv); @@ -2508,6 +2573,9 @@ Perl_do_op_xmldump(pTHX_ I32 level, PerlIO *file, const OP *o) { UV seq; int contents = 0; + + PERL_ARGS_ASSERT_DO_OP_XMLDUMP; + if (!o) return; sequence(o); @@ -2732,7 +2800,7 @@ Perl_do_op_xmldump(pTHX_ I32 level, PerlIO *file, const OP *o) sv_catpv(tmpsv, ",HUSH_VMSISH"); } else if (PL_check[o->op_type] != MEMBER_TO_FPTR(Perl_ck_ftst)) { - if (OP_IS_FILETEST_ACCESS(o) && o->op_private & OPpFT_ACCESS) + if (OP_IS_FILETEST_ACCESS(o->op_type) && o->op_private & OPpFT_ACCESS) sv_catpv(tmpsv, ",FT_ACCESS"); if (o->op_private & OPpFT_STACKED) sv_catpv(tmpsv, ",FT_STACKED"); @@ -2773,6 +2841,7 @@ Perl_do_op_xmldump(pTHX_ I32 level, PerlIO *file, const OP *o) #endif break; case OP_CONST: + case OP_HINTSEVAL: case OP_METHOD_NAMED: #ifndef USE_ITHREADS /* with ITHREADS, consts are stored in the pad, and the right pad @@ -2787,7 +2856,6 @@ Perl_do_op_xmldump(pTHX_ I32 level, PerlIO *file, const OP *o) } do_op_xmldump(level+1, file, CvROOT(cSVOPo_sv)); break; - case OP_SETSTATE: case OP_NEXTSTATE: case OP_DBSTATE: if (CopLINE(cCOPo)) @@ -2933,6 +3001,8 @@ Perl_do_op_xmldump(pTHX_ I32 level, PerlIO *file, const OP *o) void Perl_op_xmldump(pTHX_ const OP *o) { + PERL_ARGS_ASSERT_OP_XMLDUMP; + do_op_xmldump(0, PL_xmlfp, o); } #endif