X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=dump.c;h=7828e9431b6b854b583f9b74c37b4fe60f7c2b12;hb=a840ab597585fec96aedc683feb16b1a3292efa0;hp=321fecc233b54402a7a3dfbda4ff59970fc0f4f9;hpb=95f0a2f1ffc68ef908768ec5d39e4102afd28c1e;p=p5sagit%2Fp5-mst-13.2.git diff --git a/dump.c b/dump.c index 321fecc..7828e94 100644 --- a/dump.c +++ b/dump.c @@ -1,6 +1,6 @@ /* dump.c * - * Copyright (c) 1991-2001, Larry Wall + * Copyright (c) 1991-2002, 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. @@ -75,8 +75,8 @@ Perl_dump_sub(pTHX_ GV *gv) gv_fullname3(sv, gv, Nullch); Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nSUB %s = ", SvPVX(sv)); if (CvXSUB(GvCV(gv))) - Perl_dump_indent(aTHX_ 0, Perl_debug_log, "(xsub 0x%lx %d)\n", - (long)CvXSUB(GvCV(gv)), + Perl_dump_indent(aTHX_ 0, Perl_debug_log, "(xsub 0x%"UVxf" %d)\n", + PTR2UV(CvXSUB(GvCV(gv))), (int)CvXSUBANY(GvCV(gv)).any_i32); else if (CvROOT(GvCV(gv))) op_dump(CvROOT(GvCV(gv))); @@ -279,13 +279,14 @@ Perl_sv_peek(pTHX_ SV *sv) Perl_sv_catpvf(aTHX_ t, "%s)", pv_display(tmp, SvPVX(sv), SvCUR(sv), SvLEN(sv), 127)); if (SvUTF8(sv)) Perl_sv_catpvf(aTHX_ t, " [UTF8 \"%s\"]", - sv_uni_display(tmp, sv, 8 * sv_len_utf8(sv), 0)); + sv_uni_display(tmp, sv, 8 * sv_len_utf8(sv), + UNI_DISPLAY_QQ)); SvREFCNT_dec(tmp); } } else if (SvNOKp(sv)) { STORE_NUMERIC_LOCAL_SET_STANDARD(); - Perl_sv_catpvf(aTHX_ t, "(%g)",SvNVX(sv)); + Perl_sv_catpvf(aTHX_ t, "(%"NVgf")",SvNVX(sv)); RESTORE_NUMERIC_LOCAL(); } else if (SvIOKp(sv)) { @@ -616,7 +617,7 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o) case OP_GVSV: case OP_GV: #ifdef USE_ITHREADS - Perl_dump_indent(aTHX_ level, file, "PADIX = %d\n", cPADOPo->op_padix); + Perl_dump_indent(aTHX_ level, file, "PADIX = %" IVdf "\n", (IV)cPADOPo->op_padix); #else if (cSVOPo->op_sv) { SV *tmpsv = NEWSV(0,0); @@ -730,7 +731,7 @@ Perl_gv_dump(pTHX_ GV *gv) } -/* map magic types to the symbolic name +/* map magic types to the symbolic names * (with the PERL_MAGIC_ prefixed stripped) */ @@ -746,6 +747,7 @@ static struct { char type; char *name; } magic_names[] = { { PERL_MAGIC_env, "env(E)" }, { PERL_MAGIC_isa, "isa(I)" }, { PERL_MAGIC_dbfile, "dbfile(L)" }, + { PERL_MAGIC_shared, "shared(N)" }, { PERL_MAGIC_tied, "tied(P)" }, { PERL_MAGIC_sig, "sig(S)" }, { PERL_MAGIC_uvar, "uvar(U)" }, @@ -759,12 +761,14 @@ static struct { char type; char *name; } magic_names[] = { { PERL_MAGIC_nkeys, "nkeys(k)" }, { PERL_MAGIC_dbline, "dbline(l)" }, { PERL_MAGIC_mutex, "mutex(m)" }, + { PERL_MAGIC_shared_scalar, "shared_scalar(n)" }, { PERL_MAGIC_collxfrm, "collxfrm(o)" }, { PERL_MAGIC_tiedelem, "tiedelem(p)" }, { PERL_MAGIC_tiedscalar, "tiedscalar(q)" }, { PERL_MAGIC_qr, "qr(r)" }, { PERL_MAGIC_sigelem, "sigelem(s)" }, { PERL_MAGIC_taint, "taint(t)" }, + { PERL_MAGIC_uvar_elem, "uvar_elem(v)" }, { PERL_MAGIC_vec, "vec(v)" }, { PERL_MAGIC_substr, "substr(x)" }, { PERL_MAGIC_defelem, "defelem(y)" }, @@ -975,10 +979,12 @@ 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,"); break; case SVt_PVHV: if (HvSHAREKEYS(sv)) sv_catpv(d, "SHAREKEYS,"); if (HvLAZYDEL(sv)) sv_catpv(d, "LAZYDEL,"); + if (HvHASKFLAGS(sv)) sv_catpv(d, "HASKFLAGS,"); break; case SVt_PVGV: if (GvINTRO(sv)) sv_catpv(d, "INTRO,"); @@ -1115,7 +1121,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo PerlIO_printf(file, "( %s . ) ", pv_display(d, SvPVX(sv)-SvIVX(sv), SvIVX(sv), 0, pvlim)); PerlIO_printf(file, "%s", pv_display(d, SvPVX(sv), SvCUR(sv), SvLEN(sv), pvlim)); if (SvUTF8(sv)) /* the 8? \x{....} */ - PerlIO_printf(file, " [UTF8 \"%s\"]", sv_uni_display(d, sv, 8 * sv_len_utf8(sv), 0)); + PerlIO_printf(file, " [UTF8 \"%s\"]", sv_uni_display(d, sv, 8 * sv_len_utf8(sv), UNI_DISPLAY_QQ)); PerlIO_printf(file, "\n"); Perl_dump_indent(aTHX_ level, file, " CUR = %"IVdf"\n", (IV)SvCUR(sv)); Perl_dump_indent(aTHX_ level, file, " LEN = %"IVdf"\n", (IV)SvLEN(sv)); @@ -1179,7 +1185,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo PerlIO_printf(file, " ("); Zero(freq, FREQ_MAX + 1, int); - for (i = 0; i <= HvMAX(sv); i++) { + for (i = 0; (STRLEN)i <= HvMAX(sv); i++) { HE* h; int count = 0; for (h = HvARRAY(sv)[i]; h; h = HeNEXT(h)) count++; @@ -1236,7 +1242,8 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo int count = maxnest - nest; hv_iterinit(hv); - while ((he = hv_iternext(hv)) && count--) { + while ((he = hv_iternext_flags(hv, HV_ITERNEXT_WANTPLACEHOLDERS)) + && count--) { SV *elt, *keysv; char *keypv; STRLEN len; @@ -1247,7 +1254,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo elt = hv_iterval(hv, he); 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), 0)); + PerlIO_printf(file, "[UTF8 \"%s\"] ", sv_uni_display(d, keysv, 8 * sv_len_utf8(keysv), UNI_DISPLAY_QQ)); PerlIO_printf(file, "HASH = 0x%"UVxf"\n", (UV)hash); do_sv_dump(level+1, file, elt, nest+1, maxnest, dumpops, pvlim); } @@ -1372,7 +1379,7 @@ Perl_runops_debug(pTHX) { if (!PL_op) { if (ckWARN_d(WARN_DEBUGGING)) - Perl_warner(aTHX_ WARN_DEBUGGING, "NULL OP IN RUN"); + Perl_warner(aTHX_ packWARN(WARN_DEBUGGING), "NULL OP IN RUN"); return 0; } @@ -1401,6 +1408,10 @@ Perl_debop(pTHX_ OP *o) CV *cv; SV *sv; STRLEN n_a; + + 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: @@ -1468,6 +1479,8 @@ Perl_watch(pTHX_ char **addr) STATIC void S_debprof(pTHX_ OP *o) { + if (CopSTASH_eq(PL_curcop, PL_debstash) && !DEBUG_J_TEST_) + return; if (!PL_profiledata) Newz(000, PL_profiledata, MAXO, U32); ++PL_profiledata[o->op_type];