diff options
Diffstat (limited to 'contrib/perl5/dump.c')
-rw-r--r-- | contrib/perl5/dump.c | 31 |
1 files changed, 18 insertions, 13 deletions
diff --git a/contrib/perl5/dump.c b/contrib/perl5/dump.c index 86c56ce..c9a788c 100644 --- a/contrib/perl5/dump.c +++ b/contrib/perl5/dump.c @@ -1,6 +1,6 @@ /* dump.c * - * Copyright (c) 1991-2000, Larry Wall + * Copyright (c) 1991-2001, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -29,7 +29,6 @@ Perl_dump_indent(pTHX_ I32 level, PerlIO *file, const char* pat, ...) void Perl_dump_vindent(pTHX_ I32 level, PerlIO *file, const char* pat, va_list *args) { - dTHR; PerlIO_printf(file, "%*s", (int)(level*PL_dumpindent), ""); PerlIO_vprintf(file, pat, *args); } @@ -37,7 +36,6 @@ Perl_dump_vindent(pTHX_ I32 level, PerlIO *file, const char* pat, va_list *args) void Perl_dump_all(pTHX) { - dTHR; PerlIO_setlinebuf(Perl_debug_log); if (PL_main_root) op_dump(PL_main_root); @@ -47,7 +45,6 @@ Perl_dump_all(pTHX) void Perl_dump_packsubs(pTHX_ HV *stash) { - dTHR; I32 i; HE *entry; @@ -279,9 +276,9 @@ Perl_sv_peek(pTHX_ SV *sv) } } else if (SvNOKp(sv)) { - RESTORE_NUMERIC_STANDARD(); + STORE_NUMERIC_LOCAL_SET_STANDARD(); Perl_sv_catpvf(aTHX_ t, "(%g)",SvNVX(sv)); - RESTORE_NUMERIC_LOCAL(); + RESTORE_NUMERIC_LOCAL(); } else if (SvIOKp(sv)) { if (SvIsUV(sv)) @@ -369,7 +366,6 @@ Perl_pmop_dump(pTHX_ PMOP *pm) void Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o) { - dTHR; Perl_dump_indent(aTHX_ level, file, "{\n"); level++; if (o->op_seq) @@ -457,6 +453,7 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o) } else if (o->op_type == OP_ENTERSUB || o->op_type == OP_RV2SV || + o->op_type == OP_GVSV || o->op_type == OP_RV2AV || o->op_type == OP_RV2HV || o->op_type == OP_RV2GV || @@ -768,8 +765,7 @@ Perl_do_gvgv_dump(pTHX_ I32 level, PerlIO *file, char *name, GV *sv) void Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim) { - dTHR; - SV *d = sv_newmortal(); + SV *d; char *s; U32 flags; U32 type; @@ -783,7 +779,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo flags = SvFLAGS(sv); type = SvTYPE(sv); - Perl_sv_setpvf(aTHX_ d, + d = Perl_newSVpvf(aTHX_ "(0x%"UVxf") at 0x%"UVxf"\n%*s REFCNT = %"IVdf"\n%*s FLAGS = (", PTR2UV(SvANY(sv)), PTR2UV(sv), (int)(PL_dumpindent*level), "", (IV)SvREFCNT(sv), @@ -824,6 +820,8 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo if (CvCLONED(sv)) sv_catpv(d, "CLONED,"); if (CvNODEBUG(sv)) sv_catpv(d, "NODEBUG,"); if (SvCOMPILED(sv)) sv_catpv(d, "COMPILED,"); + if (CvLVALUE(sv)) sv_catpv(d, "LVALUE,"); + if (CvMETHOD(sv)) sv_catpv(d, "METHOD,"); break; case SVt_PVHV: if (HvSHAREKEYS(sv)) sv_catpv(d, "SHAREKEYS,"); @@ -833,6 +831,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo if (GvINTRO(sv)) sv_catpv(d, "INTRO,"); if (GvMULTI(sv)) sv_catpv(d, "MULTI,"); if (GvASSUMECV(sv)) sv_catpv(d, "ASSUMECV,"); + if (GvIN_PAD(sv)) sv_catpv(d, "IN_PAD,"); if (GvIMPORTED(sv)) { sv_catpv(d, "IMPORT"); if (GvIMPORTED(sv) == GVf_IMPORTED) @@ -867,6 +866,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo switch (type) { case SVt_NULL: PerlIO_printf(file, "NULL%s\n", s); + SvREFCNT_dec(d); return; case SVt_IV: PerlIO_printf(file, "IV%s\n", s); @@ -915,6 +915,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo break; default: PerlIO_printf(file, "UNKNOWN(0x%"UVxf") %s\n", (UV)type, s); + SvREFCNT_dec(d); return; } if (type >= SVt_PVIV || type == SVt_IV) { @@ -927,7 +928,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo PerlIO_putc(file, '\n'); } if (type >= SVt_PVNV || type == SVt_NV) { - RESTORE_NUMERIC_STANDARD(); + STORE_NUMERIC_LOCAL_SET_STANDARD(); /* %Vg doesn't work? --jhi */ #ifdef USE_LONG_DOUBLE Perl_dump_indent(aTHX_ level, file, " NV = %.*" PERL_PRIgldbl "\n", LDBL_DIG, SvNVX(sv)); @@ -940,10 +941,13 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo Perl_dump_indent(aTHX_ level, file, " RV = 0x%"UVxf"\n", PTR2UV(SvRV(sv))); if (nest < maxnest) do_sv_dump(level+1, file, SvRV(sv), nest+1, maxnest, dumpops, pvlim); + SvREFCNT_dec(d); return; } - if (type < SVt_PV) + if (type < SVt_PV) { + SvREFCNT_dec(d); return; + } if (type <= SVt_PVLV) { if (SvPVX(sv)) { Perl_dump_indent(aTHX_ level, file," PV = 0x%"UVxf" ", PTR2UV(SvPVX(sv))); @@ -1042,7 +1046,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo theoret = HvKEYS(sv); theoret += theoret * theoret/pow2; PerlIO_putc(file, '\n'); - Perl_dump_indent(aTHX_ level, file, " hash quality = %.1f%%", theoret/sum*100); + Perl_dump_indent(aTHX_ level, file, " hash quality = %.1"NVff"%%", theoret/sum*100); } PerlIO_putc(file, '\n'); Perl_dump_indent(aTHX_ level, file, " KEYS = %"IVdf"\n", (IV)HvKEYS(sv)); @@ -1178,6 +1182,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)IoFLAGS(sv)); break; } + SvREFCNT_dec(d); } void |