/* 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_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) {
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:
{ PERL_MAGIC_taint, "taint(t)" },
{ PERL_MAGIC_uvar_elem, "uvar_elem(v)" },
{ PERL_MAGIC_vec, "vec(v)" },
- { PERL_MAGIC_vstring, "v-string(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_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 (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]);
+ }
+ }
}
}
char *s;
U32 flags;
U32 type;
- STRLEN n_a;
if (!sv) {
Perl_dump_indent(aTHX_ level, file, "SV = 0\n");
(int)(PL_dumpindent*level), "", (IV)SvREFCNT(sv),
(int)(PL_dumpindent*level), "");
- if (flags & SVs_PADBUSY) sv_catpv(d, "PADBUSY,");
+ if (flags & SVs_PADSTALE) sv_catpv(d, "PADSTALE,");
if (flags & SVs_PADTMP) sv_catpv(d, "PADTMP,");
if (flags & SVs_PADMY) sv_catpv(d, "PADMY,");
if (flags & SVs_TEMP) sv_catpv(d, "TEMP,");
if (CvLVALUE(sv)) sv_catpv(d, "LVALUE,");
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,");
sv_catpv(d, "TYPED,");
break;
}
- if (SvPOK(sv) && SvUTF8(sv))
+ if ((SvPOK(sv) || SvPOKp(sv)) && SvUTF8(sv))
sv_catpv(d, "UTF8");
if (*(SvEND(d) - 1) == ',')
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) {
SvREFCNT_dec(d);
break;
case SVt_PVCV:
if (SvPOK(sv))
- Perl_dump_indent(aTHX_ level, file, " PROTOTYPE = \"%s\"\n", SvPV(sv,n_a));
+ 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));
do_gvgv_dump(level, file, " GVGV::GV", CvGV(sv));
Perl_dump_indent(aTHX_ level, file, " FILE = \"%s\"\n", CvFILE(sv));
Perl_dump_indent(aTHX_ level, file, " DEPTH = %"IVdf"\n", (IV)CvDEPTH(sv));
-#ifdef USE_5005THREADS
- Perl_dump_indent(aTHX_ level, file, " MUTEXP = 0x%"UVxf"\n", PTR2UV(CvMUTEXP(sv)));
- Perl_dump_indent(aTHX_ level, file, " OWNER = 0x%"UVxf"\n", PTR2UV(CvOWNER(sv)));
-#endif /* USE_5005THREADS */
Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)CvFLAGS(sv));
+ Perl_dump_indent(aTHX_ level, file, " OUTSIDE_SEQ = %"UVuf"\n", (UV)CvOUTSIDE_SEQ(sv));
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);
AV *padlist, *comppad;
CV *cv;
SV *sv;
- STRLEN n_a;
if (CopSTASH_eq(PL_curcop, PL_debstash) && !DEBUG_J_TEST_)
return 0;
if (cGVOPo_gv) {
sv = NEWSV(0,0);
gv_fullname3(sv, cGVOPo_gv, Nullch);
- PerlIO_printf(Perl_debug_log, "(%s)", SvPV(sv, n_a));
+ PerlIO_printf(Perl_debug_log, "(%s)", SvPV_nolen(sv));
SvREFCNT_dec(sv);
}
else