/* 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)));
}
char *
-Perl_pv_uni_display(pTHX_ SV *dsv, U8 *spv, STRLEN len, STRLEN pvlim, UV flags)
-{
- int truncated = 0;
- char *s, *e;
-
- sv_setpvn(dsv, "", 0);
- for (s = (char *)spv, e = s + len; s < e; s += UTF8SKIP(s)) {
- UV u;
- if (pvlim && SvCUR(dsv) >= pvlim) {
- truncated++;
- break;
- }
- u = utf8_to_uvchr((U8*)s, 0);
- Perl_sv_catpvf(aTHX_ dsv, "\\x{%"UVxf"}", u);
- }
- if (truncated)
- sv_catpvn(dsv, "...", 3);
-
- return SvPVX(dsv);
-}
-
-char *
-Perl_sv_uni_display(pTHX_ SV *dsv, SV *ssv, STRLEN pvlim, UV flags)
-{
- return Perl_pv_uni_display(aTHX_ dsv, (U8*)SvPVX(ssv), SvCUR(ssv),
- pvlim, flags);
-}
-
-char *
Perl_sv_peek(pTHX_ SV *sv)
{
SV *t = sv_newmortal();
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)) {
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_substr, "substr(x)" },
{ PERL_MAGIC_defelem, "defelem(y)" },
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,");
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 (!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_) 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];
projects / p5sagit/p5-mst-13.2.git / blobdiff