X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=dump.c;h=798c331f4e2e03edf3387a6d9348279039627f35;hb=ab5f7a047194357ab367848e6e322b76ed830de6;hp=124fb62e7958dae5a23366921af0ba03cebbd434;hpb=f18b2318c1a1ea8f33016f2bf34abc4ac137b8e3;p=p5sagit%2Fp5-mst-13.2.git diff --git a/dump.c b/dump.c index 124fb62..798c331 100644 --- a/dump.c +++ b/dump.c @@ -1,6 +1,7 @@ /* dump.c * - * Copyright (c) 1991-2003, Larry Wall + * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, + * 2000, 2001, 2002, 2003, by Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -159,7 +160,7 @@ Perl_sv_peek(pTHX_ SV *sv) sv_catpv(t, "WILD"); goto finish; } - else if (sv == &PL_sv_undef || sv == &PL_sv_no || sv == &PL_sv_yes) { + else if (sv == &PL_sv_undef || sv == &PL_sv_no || sv == &PL_sv_yes || sv == &PL_sv_placeholder) { if (sv == &PL_sv_undef) { sv_catpv(t, "SV_UNDEF"); if (!(SvFLAGS(sv) & (SVf_OK|SVf_OOK|SVs_OBJECT| @@ -177,7 +178,7 @@ Perl_sv_peek(pTHX_ SV *sv) SvNVX(sv) == 0.0) goto finish; } - else { + else if (sv == &PL_sv_yes) { sv_catpv(t, "SV_YES"); if (!(SvFLAGS(sv) & (SVf_ROK|SVf_OOK|SVs_OBJECT| SVs_GMG|SVs_SMG|SVs_RMG)) && @@ -188,6 +189,13 @@ Perl_sv_peek(pTHX_ SV *sv) SvNVX(sv) == 1.0) goto finish; } + else { + sv_catpv(t, "SV_PLACEHOLDER"); + if (!(SvFLAGS(sv) & (SVf_OK|SVf_OOK|SVs_OBJECT| + SVs_GMG|SVs_SMG|SVs_RMG)) && + SvREADONLY(sv)) + goto finish; + } sv_catpv(t, ":"); } else if (SvREFCNT(sv) == 0) { @@ -411,7 +419,8 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o) if (o->op_targ == OP_NEXTSTATE) { if (CopLINE(cCOPo)) - Perl_dump_indent(aTHX_ level, file, "LINE = %d\n",CopLINE(cCOPo)); + Perl_dump_indent(aTHX_ level, file, "LINE = %"UVf"\n", + (UV)CopLINE(cCOPo)); if (CopSTASHPV(cCOPo)) Perl_dump_indent(aTHX_ level, file, "PACKAGE = \"%s\"\n", CopSTASHPV(cCOPo)); @@ -615,6 +624,12 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o) if (o->op_private & OPpHUSH_VMSISH) 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) + sv_catpv(tmpsv, ",FT_ACCESS"); + if (o->op_private & OPpFT_STACKED) + sv_catpv(tmpsv, ",FT_STACKED"); + } if (o->op_flags & OPf_MOD && o->op_private & OPpLVAL_INTRO) sv_catpv(tmpsv, ",INTRO"); if (SvCUR(tmpsv)) @@ -644,13 +659,18 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o) break; case OP_CONST: case OP_METHOD_NAMED: +#ifndef USE_ITHREADS + /* with ITHREADS, consts are stored in the pad, and the right pad + * may not be active here, so skip */ 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)) - Perl_dump_indent(aTHX_ level, file, "LINE = %d\n",CopLINE(cCOPo)); + Perl_dump_indent(aTHX_ level, file, "LINE = %"UVf"\n", + (UV)CopLINE(cCOPo)); if (CopSTASHPV(cCOPo)) Perl_dump_indent(aTHX_ level, file, "PACKAGE = \"%s\"\n", CopSTASHPV(cCOPo)); @@ -939,7 +959,7 @@ Perl_do_gvgv_dump(pTHX_ I32 level, PerlIO *file, char *name, GV *sv) Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv)); if (sv && GvNAME(sv)) { PerlIO_printf(file, "\t\""); - if (GvSTASH(sv)) + if (GvSTASH(sv) && HvNAME(GvSTASH(sv))) PerlIO_printf(file, "%s\" :: \"", HvNAME(GvSTASH(sv))); PerlIO_printf(file, "%s\"\n", GvNAME(sv)); } @@ -989,7 +1009,8 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo if (flags & SVf_FAKE) sv_catpv(d, "FAKE,"); if (flags & SVf_READONLY) sv_catpv(d, "READONLY,"); - if (flags & SVf_AMAGIC) sv_catpv(d, "OVERLOAD,"); + if (flags & SVf_AMAGIC && type != SVt_PVHV) + sv_catpv(d, "OVERLOAD,"); if (flags & SVp_IOK) sv_catpv(d, "pIOK,"); if (flags & SVp_NOK) sv_catpv(d, "pNOK,"); if (flags & SVp_POK) sv_catpv(d, "pPOK,"); @@ -1015,8 +1036,9 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo if (HvSHAREKEYS(sv)) sv_catpv(d, "SHAREKEYS,"); if (HvLAZYDEL(sv)) sv_catpv(d, "LAZYDEL,"); if (HvHASKFLAGS(sv)) sv_catpv(d, "HASKFLAGS,"); + if (HvREHASH(sv)) sv_catpv(d, "REHASH,"); break; - case SVt_PVGV: + case SVt_PVGV: case SVt_PVLV: if (GvINTRO(sv)) sv_catpv(d, "INTRO,"); if (GvMULTI(sv)) sv_catpv(d, "MULTI,"); if (GvUNIQUE(sv)) sv_catpv(d, "UNIQUE,"); @@ -1152,7 +1174,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo SvREFCNT_dec(d); return; } - if (type <= SVt_PVLV) { + if (type <= SVt_PVLV && type != SVt_PVGV) { if (SvPVX(sv)) { Perl_dump_indent(aTHX_ level, file," PV = 0x%"UVxf" ", PTR2UV(SvPVX(sv))); if (SvOOK(sv)) @@ -1174,14 +1196,6 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo do_hv_dump(level, file, " STASH", SvSTASH(sv)); } switch (type) { - case SVt_PVLV: - Perl_dump_indent(aTHX_ level, file, " TYPE = %c\n", LvTYPE(sv)); - Perl_dump_indent(aTHX_ level, file, " TARGOFF = %"IVdf"\n", (IV)LvTARGOFF(sv)); - Perl_dump_indent(aTHX_ level, file, " TARGLEN = %"IVdf"\n", (IV)LvTARGLEN(sv)); - Perl_dump_indent(aTHX_ level, file, " TARG = 0x%"UVxf"\n", PTR2UV(LvTARG(sv))); - /* XXX level+1 ??? */ - do_sv_dump(level, file, LvTARG(sv), nest+1, maxnest, dumpops, pvlim); - break; case SVt_PVAV: Perl_dump_indent(aTHX_ level, file, " ARRAY = 0x%"UVxf, PTR2UV(AvARRAY(sv))); if (AvARRAY(sv) != AvALLOC(sv)) { @@ -1293,6 +1307,8 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo 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), UNI_DISPLAY_QQ)); + if (HeKREHASH(he)) + PerlIO_printf(file, "[REHASH] "); PerlIO_printf(file, "HASH = 0x%"UVxf"\n", (UV)hash); do_sv_dump(level+1, file, elt, nest+1, maxnest, dumpops, pvlim); } @@ -1336,7 +1352,16 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo if (nest < maxnest && (CvCLONE(sv) || CvCLONED(sv))) do_sv_dump(level+1, file, (SV*)CvOUTSIDE(sv), nest+1, maxnest, dumpops, pvlim); break; - case SVt_PVGV: + case SVt_PVGV: case SVt_PVLV: + if (type == SVt_PVLV) { + Perl_dump_indent(aTHX_ level, file, " TYPE = %c\n", LvTYPE(sv)); + Perl_dump_indent(aTHX_ level, file, " TARGOFF = %"IVdf"\n", (IV)LvTARGOFF(sv)); + Perl_dump_indent(aTHX_ level, file, " TARGLEN = %"IVdf"\n", (IV)LvTARGLEN(sv)); + Perl_dump_indent(aTHX_ level, file, " TARG = 0x%"UVxf"\n", PTR2UV(LvTARG(sv))); + if (LvTYPE(sv) != 't' && LvTYPE(sv) != 'T') + do_sv_dump(level+1, file, LvTARG(sv), nest+1, maxnest, + dumpops, pvlim); + } Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n", GvNAME(sv)); Perl_dump_indent(aTHX_ level, file, " NAMELEN = %"IVdf"\n", (IV)GvNAMELEN(sv)); do_hv_dump (level, file, " GvSTASH", GvSTASH(sv));