/* dump.c
*
- * Copyright (c) 1991-2002, Larry Wall
+ * Copyright (c) 1991-2003, 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.
SV *sv = sv_newmortal();
gv_fullname3(sv, gv, Nullch);
- Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nSUB %"SVf" = ", sv);
+ 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%"UVxf" %d)\n",
PTR2UV(CvXSUB(GvCV(gv))),
SV *sv = sv_newmortal();
gv_fullname3(sv, gv, Nullch);
- Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nFORMAT %"SVf" = ", sv);
+ Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nFORMAT %s = ", SvPVX(sv));
if (CvROOT(GvFORM(gv)))
op_dump(CvROOT(GvFORM(gv)));
else
sv_catpv(t, "(");
unref++;
}
- else if (DEBUG_R_TEST_ && SvREFCNT(sv) > 1) {
- Perl_sv_catpvf(aTHX_ t, "<%"UVuf">", (UV)SvREFCNT(sv));
+ else if (DEBUG_R_TEST_) {
+ int is_tmp = 0;
+ I32 ix;
+ /* is this SV on the tmps stack? */
+ for (ix=PL_tmps_ix; ix>=0; ix--) {
+ if (PL_tmps_stack[ix] == sv) {
+ is_tmp = 1;
+ break;
+ }
+ }
+ if (SvREFCNT(sv) > 1)
+ Perl_sv_catpvf(aTHX_ t, "<%"UVuf"%s>", (UV)SvREFCNT(sv),
+ is_tmp ? "T" : "");
+ else if (is_tmp)
+ sv_catpv(t, "<T>");
}
-
if (SvROK(sv)) {
sv_catpv(t, "\\");
if (SvCUR(t) + unref > 10) {
#else
if (cSVOPo->op_sv) {
SV *tmpsv = NEWSV(0,0);
+ STRLEN n_a;
ENTER;
SAVEFREESV(tmpsv);
gv_fullname3(tmpsv, (GV*)cSVOPo->op_sv, Nullch);
- Perl_dump_indent(aTHX_ level, file, "GV = %"SVf"\n", tmpsv);
+ Perl_dump_indent(aTHX_ level, file, "GV = %s\n", SvPV(tmpsv, n_a));
LEAVE;
}
else
break;
case OP_CONST:
case OP_METHOD_NAMED:
- Perl_dump_indent(aTHX_ level, file, "SV = %s\n", SvPEEK(cSVOPo->op_sv));
+ Perl_dump_indent(aTHX_ level, file, "SV = %s\n", SvPEEK(cSVOPo_sv));
break;
case OP_SETSTATE:
case OP_NEXTSTATE:
sv = sv_newmortal();
PerlIO_printf(Perl_debug_log, "{\n");
gv_fullname3(sv, gv, Nullch);
- Perl_dump_indent(aTHX_ 1, Perl_debug_log, "GV_NAME = %"SVf"", sv);
+ Perl_dump_indent(aTHX_ 1, Perl_debug_log, "GV_NAME = %s", SvPVX(sv));
if (gv != GvEGV(gv)) {
gv_efullname3(sv, GvEGV(gv), Nullch);
- Perl_dump_indent(aTHX_ 1, Perl_debug_log, "-> %"SVf"", sv);
+ Perl_dump_indent(aTHX_ 1, Perl_debug_log, "-> %s", SvPVX(sv));
}
PerlIO_putc(Perl_debug_log, '\n');
Perl_dump_indent(aTHX_ 0, Perl_debug_log, "}\n");
{ PERL_MAGIC_uvar_elem, "uvar_elem(v)" },
{ PERL_MAGIC_vec, "vec(v)" },
{ PERL_MAGIC_vstring, "vstring(V)" },
+ { PERL_MAGIC_utf8, "utf8(w)" },
{ PERL_MAGIC_substr, "substr(x)" },
{ PERL_MAGIC_defelem, "defelem(y)" },
{ PERL_MAGIC_ext, "ext(~)" },
else if (v == &PL_vtbl_amagic) s = "amagic";
else if (v == &PL_vtbl_amagicelem) s = "amagicelem";
else if (v == &PL_vtbl_backref) s = "backref";
+ else if (v == &PL_vtbl_utf8) s = "utf8";
if (s)
Perl_dump_indent(aTHX_ level, file, " MG_VIRTUAL = &PL_vtbl_%s\n", s);
else
if (mg->mg_ptr) {
Perl_dump_indent(aTHX_ level, file, " MG_PTR = 0x%"UVxf, PTR2UV(mg->mg_ptr));
if (mg->mg_len >= 0) {
- SV *sv = newSVpvn("", 0);
- PerlIO_printf(file, " %s", pv_display(sv, mg->mg_ptr, mg->mg_len, 0, pvlim));
- SvREFCNT_dec(sv);
+ if (mg->mg_type != PERL_MAGIC_utf8) {
+ SV *sv = newSVpvn("", 0);
+ PerlIO_printf(file, " %s", pv_display(sv, mg->mg_ptr, mg->mg_len, 0, pvlim));
+ SvREFCNT_dec(sv);
+ }
}
else if (mg->mg_len == HEf_SVKEY) {
PerlIO_puts(file, " => HEf_SVKEY\n");
PerlIO_puts(file, " ???? - please notify IZ");
PerlIO_putc(file, '\n');
}
+ if (mg->mg_type == PERL_MAGIC_utf8) {
+ STRLEN *cache = (STRLEN *) mg->mg_ptr;
+ if (cache) {
+ IV i;
+ for (i = 0; i < PERL_MAGIC_UTF8_CACHESIZE; i++)
+ Perl_dump_indent(aTHX_ level, file,
+ " %2"IVdf": %"UVuf" -> %"UVuf"\n",
+ i,
+ (UV)cache[i * 2],
+ (UV)cache[i * 2 + 1]);
+ }
+ }
}
}
if (CvMETHOD(sv)) sv_catpv(d, "METHOD,");
if (CvLOCKED(sv)) sv_catpv(d, "LOCKED,");
if (CvWEAKOUTSIDE(sv)) sv_catpv(d, "WEAKOUTSIDE,");
+ if (CvASSERTION(sv)) sv_catpv(d, "ASSERTION,");
break;
case SVt_PVHV:
if (HvSHAREKEYS(sv)) sv_catpv(d, "SHAREKEYS,");
break;
case SVt_PVCV:
if (SvPOK(sv))
- Perl_dump_indent(aTHX_ level, file, " PROTOTYPE = \"%"SVf"\"\n", sv);
+ Perl_dump_indent(aTHX_ level, file, " PROTOTYPE = \"%s\"\n", SvPV_nolen(sv));
/* FALL THROUGH */
case SVt_PVFM:
do_hv_dump(level, file, " COMP_STASH", CvSTASH(sv));