X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=dump.c;h=c891b2fc2af2773bd6c1fc3e8f7216e313af4d7e;hb=a0f20b650099024032f274cd75500979583e0eb7;hp=1d2dd2b2832f4061f12aa8cf5e5f73b8b73109a9;hpb=ad64d0ecd555e97c5a216efca1ec5a96b7fd0b34;p=p5sagit%2Fp5-mst-13.2.git diff --git a/dump.c b/dump.c index 1d2dd2b..c891b2f 100644 --- a/dump.c +++ b/dump.c @@ -9,8 +9,10 @@ */ /* - * "'You have talked long in your sleep, Frodo,' said Gandalf gently, 'and - * it has not been hard for me to read your mind and memory.'" + * 'You have talked long in your sleep, Frodo,' said Gandalf gently, 'and + * it has not been hard for me to read your mind and memory.' + * + * [p.220 of _The Lord of the Rings_, II/i: "Many Meetings"] */ /* This file contains utility routines to dump the contents of SV and OP @@ -110,7 +112,7 @@ Perl_dump_packsubs(pTHX_ const HV *stash) for (i = 0; i <= (I32) HvMAX(stash); i++) { const HE *entry; for (entry = HvARRAY(stash)[i]; entry; entry = HeNEXT(entry)) { - const GV * const gv = (GV*)HeVAL(entry); + const GV * const gv = (const GV *)HeVAL(entry); if (SvTYPE(gv) != SVt_PVGV || !GvGP(gv)) continue; if (GvCVu(gv)) @@ -503,8 +505,11 @@ Perl_sv_peek(pTHX_ SV *sv) else { SV * const tmp = newSVpvs(""); sv_catpv(t, "("); - if (SvOOK(sv)) - Perl_sv_catpvf(aTHX_ t, "[%s]", pv_display(tmp, SvPVX_const(sv)-SvIVX(sv), SvIVX(sv), 0, 127)); + if (SvOOK(sv)) { + STRLEN delta; + SvOOK_offset(sv, delta); + Perl_sv_catpvf(aTHX_ t, "[%s]", pv_display(tmp, SvPVX_const(sv)-delta, delta, 0, 127)); + } Perl_sv_catpvf(aTHX_ t, "%s)", pv_display(tmp, SvPVX_const(sv), SvCUR(sv), SvLEN(sv), 127)); if (SvUTF8(sv)) Perl_sv_catpvf(aTHX_ t, " [UTF8 \"%s\"]", @@ -530,6 +535,8 @@ Perl_sv_peek(pTHX_ SV *sv) finish: while (unref--) sv_catpv(t, ")"); + if (PL_tainting && SvTAINTED(sv)) + sv_catpv(t, " [tainted]"); return SvPV_nolen(t); } @@ -1036,7 +1043,7 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o) #ifdef USE_ITHREADS Perl_dump_indent(aTHX_ level, file, "PADIX = %" IVdf "\n", (IV)cPADOPo->op_padix); #else - if ( ! PL_op->op_flags & OPf_SPECIAL) { /* not lexical */ + if ( ! (o->op_flags & OPf_SPECIAL)) { /* not lexical */ if (cSVOPo->op_sv) { SV * const tmpsv = newSV(0); ENTER; @@ -1046,7 +1053,7 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o) UTF-8 cleanliness of the dump file handle? */ SvUTF8_on(tmpsv); #endif - gv_fullname3(tmpsv, (GV*)cSVOPo->op_sv, NULL); + gv_fullname3(tmpsv, MUTABLE_GV(cSVOPo->op_sv), NULL); Perl_dump_indent(aTHX_ level, file, "GV = %s\n", SvPV_nolen_const(tmpsv)); LEAVE; @@ -1254,6 +1261,7 @@ Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, const MAGIC *mg, I32 nest, I32 else if (v == &PL_vtbl_utf8) s = "utf8"; else if (v == &PL_vtbl_arylen_p) s = "arylen_p"; else if (v == &PL_vtbl_hintselem) s = "hintselem"; + else if (v == &PL_vtbl_hints) s = "hints"; else s = NULL; if (s) Perl_dump_indent(aTHX_ level, file, " MG_VIRTUAL = &PL_vtbl_%s\n", s); @@ -1473,7 +1481,6 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo if (SvCOMPILED(sv)) sv_catpv(d, "COMPILED,"); if (CvLVALUE(sv)) sv_catpv(d, "LVALUE,"); if (CvMETHOD(sv)) sv_catpv(d, "METHOD,"); - if (CvLOCKED(sv)) sv_catpv(d, "LOCKED,"); if (CvWEAKOUTSIDE(sv)) sv_catpv(d, "WEAKOUTSIDE,"); break; case SVt_PVHV: @@ -1488,7 +1495,6 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo if (isGV_with_GP(sv)) { if (GvINTRO(sv)) sv_catpv(d, "INTRO,"); if (GvMULTI(sv)) sv_catpv(d, "MULTI,"); - if (GvUNIQUE(sv)) sv_catpv(d, "UNIQUE,"); if (GvASSUMECV(sv)) sv_catpv(d, "ASSUMECV,"); if (GvIN_PAD(sv)) sv_catpv(d, "IN_PAD,"); } @@ -1748,12 +1754,48 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo if (SvOOK(sv)) { AV * const backrefs = *Perl_hv_backreferences_p(aTHX_ MUTABLE_HV(sv)); + struct mro_meta * const meta = HvAUX(sv)->xhv_mro_meta; if (backrefs) { Perl_dump_indent(aTHX_ level, file, " BACKREFS = 0x%"UVxf"\n", PTR2UV(backrefs)); do_sv_dump(level+1, file, MUTABLE_SV(backrefs), nest+1, maxnest, dumpops, pvlim); } + if (meta) { + /* FIXME - mro_algs kflags can signal a UTF-8 name. */ + Perl_dump_indent(aTHX_ level, file, " MRO_WHICH = \"%.*s\" (0x%"UVxf")\n", + (int)meta->mro_which->length, + meta->mro_which->name, + PTR2UV(meta->mro_which)); + Perl_dump_indent(aTHX_ level, file, " CACHE_GEN = 0x%"UVxf"\n", + (UV)meta->cache_gen); + Perl_dump_indent(aTHX_ level, file, " PKG_GEN = 0x%"UVxf"\n", + (UV)meta->pkg_gen); + if (meta->mro_linear_all) { + Perl_dump_indent(aTHX_ level, file, " MRO_LINEAR_ALL = 0x%"UVxf"\n", + PTR2UV(meta->mro_linear_all)); + do_sv_dump(level+1, file, MUTABLE_SV(meta->mro_linear_all), nest+1, maxnest, + dumpops, pvlim); + } + if (meta->mro_linear_current) { + Perl_dump_indent(aTHX_ level, file, " MRO_LINEAR_CURRENT = 0x%"UVxf"\n", + PTR2UV(meta->mro_linear_current)); + do_sv_dump(level+1, file, MUTABLE_SV(meta->mro_linear_current), nest+1, maxnest, + dumpops, pvlim); + } + if (meta->mro_nextmethod) { + Perl_dump_indent(aTHX_ level, file, " MRO_NEXTMETHOD = 0x%"UVxf"\n", + PTR2UV(meta->mro_nextmethod)); + do_sv_dump(level+1, file, MUTABLE_SV(meta->mro_nextmethod), nest+1, maxnest, + dumpops, pvlim); + } + if (meta->isa) { + Perl_dump_indent(aTHX_ level, file, " ISA = 0x%"UVxf"\n", + PTR2UV(meta->isa)); + do_sv_dump(level+1, file, MUTABLE_SV(meta->isa), nest+1, maxnest, + dumpops, pvlim); + } + } } if (nest < maxnest && !HvEITER_get(sv)) { /* Try to preserve iterator */ HE *he; @@ -2168,7 +2210,7 @@ Perl_xmldump_packsubs(pTHX_ const HV *stash) return; for (i = 0; i <= (I32) HvMAX(stash); i++) { for (entry = HvARRAY(stash)[i]; entry; entry = HeNEXT(entry)) { - GV *gv = (GV*)HeVAL(entry); + GV *gv = MUTABLE_GV(HeVAL(entry)); HV *hv; if (SvTYPE(gv) != SVt_PVGV || !GvGP(gv)) continue; @@ -2832,7 +2874,7 @@ Perl_do_op_xmldump(pTHX_ I32 level, PerlIO *file, const OP *o) ENTER; SAVEFREESV(tmpsv1); SAVEFREESV(tmpsv2); - gv_fullname3(tmpsv1, (GV*)cSVOPo->op_sv, NULL); + gv_fullname3(tmpsv1, MUTABLE_GV(cSVOPo->op_sv), NULL); s = SvPV(tmpsv1,len); sv_catxmlpvn(tmpsv2, s, len, 1); S_xmldump_attr(aTHX_ level, file, "gv=\"%s\"", SvPV(tmpsv2, len));