X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=dump.c;h=724baf8bd3acd084020c9ae156d45661d2b842d7;hb=cd22a09c8c81e5e4c639c15ad19704a0d1e0c842;hp=3a34fcb8c7021e43523f5253577f27d4e08b289a;hpb=87cea99e29dc843a5ce7742434c86a627eb3f6f5;p=p5sagit%2Fp5-mst-13.2.git diff --git a/dump.c b/dump.c index 3a34fcb..724baf8 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)) @@ -229,7 +231,7 @@ Perl_pv_escape( pTHX_ SV *dsv, char const * const str, if (!(flags & PERL_PV_ESCAPE_NOCLEAR)) { /* This won't alter the UTF-8 flag */ - sv_setpvn(dsv, "", 0); + sv_setpvs(dsv, ""); } if ((flags & PERL_PV_ESCAPE_UNI_DETECT) && is_utf8_string((U8*)pv, count)) @@ -342,29 +344,29 @@ Perl_pv_pretty( pTHX_ SV *dsv, char const * const str, const STRLEN count, if (!(flags & PERL_PV_PRETTY_NOCLEAR)) { /* This won't alter the UTF-8 flag */ - sv_setpvn(dsv, "", 0); + sv_setpvs(dsv, ""); } if ( dq == '"' ) - sv_catpvn(dsv, "\"", 1); + sv_catpvs(dsv, "\""); else if ( flags & PERL_PV_PRETTY_LTGT ) - sv_catpvn(dsv, "<", 1); + sv_catpvs(dsv, "<"); if ( start_color != NULL ) - Perl_sv_catpv( aTHX_ dsv, start_color); + sv_catpv(dsv, start_color); pv_escape( dsv, str, count, max, &escaped, flags | PERL_PV_ESCAPE_NOCLEAR ); if ( end_color != NULL ) - Perl_sv_catpv( aTHX_ dsv, end_color); + sv_catpv(dsv, end_color); if ( dq == '"' ) - sv_catpvn( dsv, "\"", 1 ); + sv_catpvs( dsv, "\""); else if ( flags & PERL_PV_PRETTY_LTGT ) - sv_catpvn( dsv, ">", 1); + sv_catpvs(dsv, ">"); if ( (flags & PERL_PV_PRETTY_ELLIPSES) && ( escaped < count ) ) - sv_catpvn( dsv, "...", 3 ); + sv_catpvs(dsv, "..."); return SvPVX(dsv); } @@ -372,9 +374,6 @@ Perl_pv_pretty( pTHX_ SV *dsv, char const * const str, const STRLEN count, /* =for apidoc pv_display - char *pv_display(SV *dsv, const char *pv, STRLEN cur, STRLEN len, - STRLEN pvlim, U32 flags) - Similar to pv_escape(dsv,pv,cur,pvlim,PERL_PV_ESCAPE_QUOTE); @@ -394,7 +393,7 @@ Perl_pv_display(pTHX_ SV *dsv, const char *pv, STRLEN cur, STRLEN len, STRLEN pv pv_pretty( dsv, pv, cur, pvlim, NULL, NULL, PERL_PV_PRETTY_DUMP); if (len > cur && pv[cur] == '\0') - sv_catpvn( dsv, "\\0", 2 ); + sv_catpvs( dsv, "\\0"); return SvPVX(dsv); } @@ -406,13 +405,13 @@ Perl_sv_peek(pTHX_ SV *sv) int unref = 0; U32 type; - sv_setpvn(t, "", 0); + sv_setpvs(t, ""); retry: if (!sv) { sv_catpv(t, "VOID"); goto finish; } - else if (sv == (SV*)0x55555555 || SvTYPE(sv) == 'U') { + else if (sv == (const SV *)0x55555555 || SvTYPE(sv) == 'U') { sv_catpv(t, "WILD"); goto finish; } @@ -483,7 +482,7 @@ Perl_sv_peek(pTHX_ SV *sv) sv_catpv(t, "..."); goto finish; } - sv = (SV*)SvRV(sv); + sv = SvRV(sv); goto retry; } type = SvTYPE(sv); @@ -533,6 +532,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); } @@ -991,13 +992,13 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o) #ifdef PERL_MAD if (PL_madskills && o->op_madprop) { - SV * const tmpsv = newSVpvn("", 0); + SV * const tmpsv = newSVpvs(""); MADPROP* mp = o->op_madprop; Perl_dump_indent(aTHX_ level, file, "MADPROPS = {\n"); level++; while (mp) { const char tmp = mp->mad_key; - sv_setpvn(tmpsv,"'",1); + sv_setpvs(tmpsv,"'"); if (tmp) sv_catpvn(tmpsv, &tmp, 1); sv_catpv(tmpsv, "'="); @@ -1049,7 +1050,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; @@ -1331,7 +1332,8 @@ Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, const MAGIC *mg, I32 nest, I32 } else if (mg->mg_len == HEf_SVKEY) { PerlIO_puts(file, " => HEf_SVKEY\n"); - do_sv_dump(level+2, file, (SV*)((mg)->mg_ptr), nest+1, maxnest, dumpops, pvlim); /* MG is already +1 */ + do_sv_dump(level+2, file, MUTABLE_SV(((mg)->mg_ptr)), nest+1, + maxnest, dumpops, pvlim); /* MG is already +1 */ continue; } else @@ -1659,15 +1661,15 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo Perl_dump_indent(aTHX_ level, file, " FILL = %"IVdf"\n", (IV)AvFILLp(sv)); Perl_dump_indent(aTHX_ level, file, " MAX = %"IVdf"\n", (IV)AvMAX(sv)); Perl_dump_indent(aTHX_ level, file, " ARYLEN = 0x%"UVxf"\n", SvMAGIC(sv) ? PTR2UV(AvARYLEN(sv)) : 0); - sv_setpvn(d, "", 0); + sv_setpvs(d, ""); if (AvREAL(sv)) sv_catpv(d, ",REAL"); if (AvREIFY(sv)) sv_catpv(d, ",REIFY"); Perl_dump_indent(aTHX_ level, file, " FLAGS = (%s)\n", SvCUR(d) ? SvPVX_const(d) + 1 : ""); - if (nest < maxnest && av_len((AV*)sv) >= 0) { + if (nest < maxnest && av_len(MUTABLE_AV(sv)) >= 0) { int count; - for (count = 0; count <= av_len((AV*)sv) && count < maxnest; count++) { - SV** const elt = av_fetch((AV*)sv,count,0); + for (count = 0; count <= av_len(MUTABLE_AV(sv)) && count < maxnest; count++) { + SV** const elt = av_fetch(MUTABLE_AV(sv),count,0); Perl_dump_indent(aTHX_ level + 1, file, "Elt No. %"IVdf"\n", (IV)count); if (elt) @@ -1748,12 +1750,12 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n", hvname); } if (SvOOK(sv)) { - const AV * const backrefs + AV * const backrefs = *Perl_hv_backreferences_p(aTHX_ MUTABLE_HV(sv)); if (backrefs) { Perl_dump_indent(aTHX_ level, file, " BACKREFS = 0x%"UVxf"\n", PTR2UV(backrefs)); - do_sv_dump(level+1, file, (SV*)backrefs, nest+1, maxnest, + do_sv_dump(level+1, file, MUTABLE_SV(backrefs), nest+1, maxnest, dumpops, pvlim); } } @@ -1805,7 +1807,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo do_op_dump(level+1, file, CvROOT(sv)); } } else { - SV * const constant = cv_const_sv((CV *)sv); + SV * const constant = cv_const_sv((const CV *)sv); Perl_dump_indent(aTHX_ level, file, " XSUB = 0x%"UVxf"\n", PTR2UV(CvXSUB(sv))); @@ -1843,7 +1845,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo : CvGV(outside) ? GvNAME(CvGV(outside)) : "UNDEFINED")); } if (nest < maxnest && (CvCLONE(sv) || CvCLONED(sv))) - do_sv_dump(level+1, file, (SV*)CvOUTSIDE(sv), nest+1, maxnest, dumpops, pvlim); + do_sv_dump(level+1, file, MUTABLE_SV(CvOUTSIDE(sv)), nest+1, maxnest, dumpops, pvlim); break; case SVt_PVGV: case SVt_PVLV: @@ -1898,8 +1900,8 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo else { Perl_dump_indent(aTHX_ level, file, " TOP_GV = 0x%"UVxf"\n", PTR2UV(IoTOP_GV(sv))); - do_sv_dump (level+1, file, (SV *) IoTOP_GV(sv), nest+1, maxnest, - dumpops, pvlim); + do_sv_dump (level+1, file, MUTABLE_SV(IoTOP_GV(sv)), nest+1, + maxnest, dumpops, pvlim); } /* Source filters hide things that are not GVs in these three, so let's be careful out there. */ @@ -1910,8 +1912,8 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo else { Perl_dump_indent(aTHX_ level, file, " FMT_GV = 0x%"UVxf"\n", PTR2UV(IoFMT_GV(sv))); - do_sv_dump (level+1, file, (SV *) IoFMT_GV(sv), nest+1, maxnest, - dumpops, pvlim); + do_sv_dump (level+1, file, MUTABLE_SV(IoFMT_GV(sv)), nest+1, + maxnest, dumpops, pvlim); } if (IoBOTTOM_NAME(sv)) Perl_dump_indent(aTHX_ level, file, " BOTTOM_NAME = \"%s\"\n", IoBOTTOM_NAME(sv)); @@ -1920,8 +1922,8 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo else { Perl_dump_indent(aTHX_ level, file, " BOTTOM_GV = 0x%"UVxf"\n", PTR2UV(IoBOTTOM_GV(sv))); - do_sv_dump (level+1, file, (SV *) IoBOTTOM_GV(sv), nest+1, maxnest, - dumpops, pvlim); + do_sv_dump (level+1, file, MUTABLE_SV(IoBOTTOM_GV(sv)), nest+1, + maxnest, dumpops, pvlim); } if (isPRINT(IoTYPE(sv))) Perl_dump_indent(aTHX_ level, file, " TYPE = '%c'\n", IoTYPE(sv)); @@ -2033,7 +2035,7 @@ Perl_debop(pTHX_ const OP *o) SV *sv; if (cv) { AV * const padlist = CvPADLIST(cv); - AV * const comppad = (AV*)(*av_fetch(padlist, 0, FALSE)); + AV * const comppad = MUTABLE_AV(*av_fetch(padlist, 0, FALSE)); sv = *av_fetch(comppad, o->op_targ, FALSE); } else sv = NULL; @@ -2170,7 +2172,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; @@ -2243,7 +2245,7 @@ Perl_sv_catxmlpvn(pTHX_ SV *dsv, const char *pv, STRLEN len, int utf8) PERL_ARGS_ASSERT_SV_CATXMLPVN; - sv_catpvn(dsv,"",0); + sv_catpvs(dsv,""); dsvcur = SvCUR(dsv); /* in case we have to restart */ retry: @@ -2369,13 +2371,13 @@ Perl_sv_xmlpeek(pTHX_ SV *sv) PERL_ARGS_ASSERT_SV_XMLPEEK; sv_utf8_upgrade(t); - sv_setpvn(t, "", 0); + sv_setpvs(t, ""); /* retry: */ if (!sv) { sv_catpv(t, "VOID=\"\""); goto finish; } - else if (sv == (SV*)0x55555555 || SvTYPE(sv) == 'U') { + else if (sv == (const SV *)0x55555555 || SvTYPE(sv) == 'U') { sv_catpv(t, "WILD=\"\""); goto finish; } @@ -2539,7 +2541,7 @@ Perl_do_pmop_xmldump(pTHX_ I32 level, PerlIO *file, const PMOP *pm) if (PM_GETRE(pm)) { REGEXP *const r = PM_GETRE(pm); SV * const tmpsv = newSVpvn_utf8("", 0, TRUE); - sv_catxmlsv(tmpsv, (SV*)r); + sv_catxmlsv(tmpsv, MUTABLE_SV(r)); Perl_xmldump_indent(aTHX_ level, file, "pre=\"%s\"\n", SvPVX(tmpsv)); SvREFCNT_dec(tmpsv); @@ -2619,7 +2621,7 @@ Perl_do_op_xmldump(pTHX_ I32 level, PerlIO *file, const OP *o) PerlIO_printf(file, " addr=\"0x%"UVxf" => 0x%"UVxf"\"", (UV)o, (UV)o->op_next); #endif if (o->op_flags) { - SV * const tmpsv = newSVpvn("", 0); + SV * const tmpsv = newSVpvs(""); switch (o->op_flags & OPf_WANT) { case OPf_WANT_VOID: sv_catpv(tmpsv, ",VOID"); @@ -2650,7 +2652,7 @@ Perl_do_op_xmldump(pTHX_ I32 level, PerlIO *file, const OP *o) SvREFCNT_dec(tmpsv); } if (o->op_private) { - SV * const tmpsv = newSVpvn("", 0); + SV * const tmpsv = newSVpvs(""); if (PL_opargs[o->op_type] & OA_TARGLEX) { if (o->op_private & OPpTARGET_MY) sv_catpv(tmpsv, ",TARGET_MY"); @@ -2834,7 +2836,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)); @@ -2927,7 +2929,7 @@ Perl_do_op_xmldump(pTHX_ I32 level, PerlIO *file, const OP *o) level++; while (mp) { char tmp = mp->mad_key; - sv_setpvn(tmpsv,"\"",1); + sv_setpvs(tmpsv,"\""); if (tmp) sv_catxmlpvn(tmpsv, &tmp, 1, 0); if ((tmp == '_') || (tmp == '#')) /* '_' '#' whitespace belong to the previous token. */ @@ -2948,7 +2950,7 @@ Perl_do_op_xmldump(pTHX_ I32 level, PerlIO *file, const OP *o) break; case MAD_SV: sv_catpv(tmpsv, " val=\""); - sv_catxmlsv(tmpsv, (SV*)mp->mad_val); + sv_catxmlsv(tmpsv, MUTABLE_SV(mp->mad_val)); sv_catpv(tmpsv, "\""); Perl_xmldump_indent(aTHX_ level, file, "\n", SvPVX(tmpsv)); break;