/* 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.
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)));
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)) {
else if (o->op_type == OP_AASSIGN) {
if (o->op_private & OPpASSIGN_COMMON)
sv_catpv(tmpsv, ",COMMON");
- if (o->op_private & OPpASSIGN_HASH)
- sv_catpv(tmpsv, ",HASH");
}
else if (o->op_type == OP_SASSIGN) {
if (o->op_private & OPpASSIGN_BACKWARDS)
sv_catpv(tmpsv, ",NOPAREN");
if (o->op_private & OPpENTERSUB_INARGS)
sv_catpv(tmpsv, ",INARGS");
+ if (o->op_private & OPpENTERSUB_NOMOD)
+ sv_catpv(tmpsv, ",NOMOD");
}
else {
switch (o->op_private & OPpDEREF) {
else if (o->op_type == OP_FLOP) {
if (o->op_private & OPpFLIP_LINENUM)
sv_catpv(tmpsv, ",LINENUM");
- } else if (o->op_type == OP_RV2CV) {
+ }
+ else if (o->op_type == OP_RV2CV) {
if (o->op_private & OPpLVAL_INTRO)
sv_catpv(tmpsv, ",INTRO");
}
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);
}
-/* map magic types to the symbolic name
+/* map magic types to the symbolic names
* (with the PERL_MAGIC_ prefixed stripped)
*/
{ 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)" },
{ 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_vstring, "vstring(V)" },
{ PERL_MAGIC_substr, "substr(x)" },
{ PERL_MAGIC_defelem, "defelem(y)" },
{ PERL_MAGIC_ext, "ext(~)" },
if (mg->mg_flags) {
Perl_dump_indent(aTHX_ level, file, " MG_FLAGS = 0x%02X\n", mg->mg_flags);
- if (mg->mg_flags & MGf_TAINTEDDIR)
+ if (mg->mg_type == PERL_MAGIC_envelem &&
+ mg->mg_flags & MGf_TAINTEDDIR)
Perl_dump_indent(aTHX_ level, file, " TAINTEDDIR\n");
if (mg->mg_flags & MGf_REFCOUNTED)
Perl_dump_indent(aTHX_ level, file, " REFCOUNTED\n");
if (mg->mg_flags & MGf_GSKIP)
Perl_dump_indent(aTHX_ level, file, " GSKIP\n");
- if (mg->mg_flags & MGf_MINMATCH)
+ if (mg->mg_type == PERL_MAGIC_regex_global &&
+ mg->mg_flags & MGf_MINMATCH)
Perl_dump_indent(aTHX_ level, file, " MINMATCH\n");
}
if (mg->mg_obj) {
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,");
return;
}
if (type >= SVt_PVIV || type == SVt_IV) {
- if (SvIsUV(sv))
+ if (SvIsUV(sv)
+#ifdef PERL_COPY_ON_WRITE
+ || SvIsCOW(sv)
+#endif
+ )
Perl_dump_indent(aTHX_ level, file, " UV = %"UVuf, (UV)SvUVX(sv));
else
Perl_dump_indent(aTHX_ level, file, " IV = %"IVdf, (IV)SvIVX(sv));
if (SvOOK(sv))
PerlIO_printf(file, " (OFFSET)");
+#ifdef PERL_COPY_ON_WRITE
+ if (SvIsCOW_shared_hash(sv))
+ PerlIO_printf(file, " (HASH)");
+ else if (SvIsCOW_normal(sv))
+ PerlIO_printf(file, " (COW from 0x%"UVxf")", (UV)SvUVX(sv));
+#endif
PerlIO_putc(file, '\n');
}
if (type >= SVt_PVNV || type == SVt_NV) {
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));
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++;
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;
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);
}
if (type == SVt_PVFM)
Perl_dump_indent(aTHX_ level, file, " LINES = %"IVdf"\n", (IV)FmLINES(sv));
Perl_dump_indent(aTHX_ level, file, " PADLIST = 0x%"UVxf"\n", PTR2UV(CvPADLIST(sv)));
- if (nest < maxnest && CvPADLIST(sv)) {
- AV* padlist = CvPADLIST(sv);
- AV* pad_name = (AV*)*av_fetch(padlist, 0, FALSE);
- AV* pad = (AV*)*av_fetch(padlist, 1, FALSE);
- SV** pname = AvARRAY(pad_name);
- SV** ppad = AvARRAY(pad);
- I32 ix;
-
- for (ix = 1; ix <= AvFILL(pad_name); ix++) {
- if (SvPOK(pname[ix]))
- Perl_dump_indent(aTHX_ level,
- /* %5d below is enough whitespace. */
- file,
- "%5d. 0x%"UVxf" (%s\"%s\" %"IVdf"-%"IVdf")\n",
- (int)ix, PTR2UV(ppad[ix]),
- SvFAKE(pname[ix]) ? "FAKE " : "",
- SvPVX(pname[ix]),
- (IV)SvNVX(pname[ix]),
- (IV)SvIVX(pname[ix]));
- }
+ if (nest < maxnest) {
+ do_dump_pad(level+1, file, CvPADLIST(sv), 0);
}
{
CV *outside = CvOUTSIDE(sv);
{
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;
}
"WARNING: %"UVxf" changed from %"UVxf" to %"UVxf"\n",
PTR2UV(PL_watchaddr), PTR2UV(PL_watchok),
PTR2UV(*PL_watchaddr));
- if (DEBUG_p_TEST_) debstack();
+ if (DEBUG_s_TEST_) {
+ if (DEBUG_v_TEST_) {
+ PerlIO_printf(Perl_debug_log, "\n");
+ deb_stack_all();
+ }
+ else
+ debstack();
+ }
+
+
if (DEBUG_t_TEST_) debop(PL_op);
if (DEBUG_P_TEST_) debprof(PL_op);
}
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:
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];