#include "proto.h"
+static const char* const svtypenames[SVt_LAST] = {
+ "NULL",
+ "IV",
+ "NV",
+ "RV",
+ "BIND",
+ "PV",
+ "PVIV",
+ "PVNV",
+ "PVMG",
+ "PVGV",
+ "PVLV",
+ "PVAV",
+ "PVHV",
+ "PVCV",
+ "PVFM",
+ "PVIO"
+};
+
+
+static const char* const svshorttypenames[SVt_LAST] = {
+ "UNDEF",
+ "IV",
+ "NV",
+ "RV",
+ "BIND",
+ "PV",
+ "PVIV",
+ "PVNV",
+ "PVMG",
+ "GV",
+ "PVLV",
+ "AV",
+ "HV",
+ "CV",
+ "FM",
+ "IO"
+};
+
#define Sequence PL_op_sequence
void
sv_setpvn(dsv, "", 0);
if ( start_color != NULL )
- Perl_sv_catpvf( aTHX_ dsv, "%s", start_color);
+ Perl_sv_catpv( aTHX_ dsv, start_color);
pv_escape( dsv, str, count, max, &escaped, flags | PERL_PV_ESCAPE_NOCLEAR );
if ( end_color != NULL )
- Perl_sv_catpvf( aTHX_ dsv, "%s", end_color);
+ Perl_sv_catpv( aTHX_ dsv, end_color);
if ( dq == '"' )
sv_catpvn( dsv, "\"", 1 );
dVAR;
SV * const t = sv_newmortal();
int unref = 0;
+ U32 type;
sv_setpvn(t, "", 0);
retry:
sv = (SV*)SvRV(sv);
goto retry;
}
- switch (SvTYPE(sv)) {
- default:
- sv_catpv(t, "FREED");
+ type = SvTYPE(sv);
+ if (type == SVt_PVCV) {
+ Perl_sv_catpvf(aTHX_ t, "CV(%s)", CvGV(sv) ? GvNAME(CvGV(sv)) : "");
goto finish;
+ } else if (type < SVt_LAST) {
+ sv_catpv(t, svshorttypenames[type]);
- case SVt_NULL:
- sv_catpv(t, "UNDEF");
- goto finish;
- case SVt_IV:
- sv_catpv(t, "IV");
- break;
- case SVt_NV:
- sv_catpv(t, "NV");
- break;
- case SVt_RV:
- sv_catpv(t, "RV");
- break;
- case SVt_PV:
- sv_catpv(t, "PV");
- break;
- case SVt_PVIV:
- sv_catpv(t, "PVIV");
- break;
- case SVt_PVNV:
- sv_catpv(t, "PVNV");
- break;
- case SVt_PVMG:
- sv_catpv(t, "PVMG");
- break;
- case SVt_PVLV:
- sv_catpv(t, "PVLV");
- break;
- case SVt_PVAV:
- sv_catpv(t, "AV");
- break;
- case SVt_PVHV:
- sv_catpv(t, "HV");
- break;
- case SVt_PVCV:
- if (CvGV(sv))
- Perl_sv_catpvf(aTHX_ t, "CV(%s)", GvNAME(CvGV(sv)));
- else
- sv_catpv(t, "CV()");
+ if (type == SVt_NULL)
+ goto finish;
+ } else {
+ sv_catpv(t, "FREED");
goto finish;
- case SVt_PVGV:
- sv_catpv(t, "GV");
- break;
- case SVt_PVBM:
- sv_catpv(t, "BM");
- break;
- case SVt_PVFM:
- sv_catpv(t, "FM");
- break;
- case SVt_PVIO:
- sv_catpv(t, "IO");
- break;
}
if (SvPOKp(sv)) {
if (pmflags & PMf_ONCE)
sv_catpv(desc, ",ONCE");
if (regex && regex->check_substr) {
- if (!(regex->reganch & ROPT_NOSCAN))
+ if (!(regex->extflags & RXf_NOSCAN))
sv_catpv(desc, ",SCANFIRST");
- if (regex->reganch & ROPT_CHECK_ALL)
+ if (regex->extflags & RXf_CHECK_ALL)
sv_catpv(desc, ",ALL");
}
if (pmflags & PMf_SKIPWHITE)
#ifdef DUMPADDR
Perl_dump_indent(aTHX_ level, file, "ADDR = 0x%"UVxf" => 0x%"UVxf"\n", (UV)o, (UV)o->op_next);
#endif
- if (o->op_flags) {
+ if (o->op_flags || o->op_latefree || o->op_latefreed) {
SV * const tmpsv = newSVpvs("");
switch (o->op_flags & OPf_WANT) {
case OPf_WANT_VOID:
sv_catpv(tmpsv, ",MOD");
if (o->op_flags & OPf_SPECIAL)
sv_catpv(tmpsv, ",SPECIAL");
+ if (o->op_latefree)
+ sv_catpv(tmpsv, ",LATEFREE");
+ if (o->op_latefreed)
+ sv_catpv(tmpsv, ",LATEFREED");
Perl_dump_indent(aTHX_ level, file, "FLAGS = (%s)\n", SvCUR(tmpsv) ? SvPVX_const(tmpsv) + 1 : "");
SvREFCNT_dec(tmpsv);
}
{ PERL_MAGIC_sv, "sv(\\0)" },
{ PERL_MAGIC_arylen, "arylen(#)" },
{ PERL_MAGIC_rhash, "rhash(%)" },
+ { PERL_MAGIC_regdata_names, "regdata_names(+)" },
{ PERL_MAGIC_pos, "pos(.)" },
{ PERL_MAGIC_symtab, "symtab(:)" },
{ PERL_MAGIC_backref, "backref(<)" },
(int)(PL_dumpindent*level), "", (IV)SvREFCNT(sv),
(int)(PL_dumpindent*level), "");
- 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 & SVpad_NAME && (type == SVt_PVMG || type == SVt_PVNV))) {
+ if (flags & SVs_PADSTALE) sv_catpv(d, "PADSTALE,");
+ }
+ if (!(flags & SVpad_NAME && type == SVt_PVMG)) {
+ 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 (flags & SVs_OBJECT) sv_catpv(d, "OBJECT,");
if (flags & SVs_GMG) sv_catpv(d, "GMG,");
if (flags & SVp_IOK) sv_catpv(d, "pIOK,");
if (flags & SVp_NOK) sv_catpv(d, "pNOK,");
if (flags & SVp_POK) sv_catpv(d, "pPOK,");
- if (flags & SVp_SCREAM && type != SVt_PVHV)
+ if (flags & SVp_SCREAM && type != SVt_PVHV && !isGV_with_GP(sv)) {
+ if (SvPCS_IMPORTED(sv))
+ sv_catpv(d, "PCS_IMPORTED,");
+ else
sv_catpv(d, "SCREAM,");
+ }
switch (type) {
case SVt_PVCV:
if (GvASSUMECV(sv)) sv_catpv(d, "ASSUMECV,");
if (GvIN_PAD(sv)) sv_catpv(d, "IN_PAD,");
}
- if (SvPAD_OUR(sv)) sv_catpv(d, "OUR,");
- if (SvPAD_STATE(sv)) sv_catpv(d, "STATE,");
- if (SvPAD_TYPED(sv)) sv_catpv(d, "TYPED,");
if (isGV_with_GP(sv) && GvIMPORTED(sv)) {
sv_catpv(d, "IMPORT");
if (GvIMPORTED(sv) == GVf_IMPORTED)
sv_catpv(d, " ),");
}
}
+ if (SvTAIL(sv)) sv_catpv(d, "TAIL,");
+ if (SvVALID(sv)) sv_catpv(d, "VALID,");
/* FALL THROUGH */
default:
+ evaled_or_uv:
if (SvEVALED(sv)) sv_catpv(d, "EVALED,");
if (SvIsUV(sv) && !(flags & SVf_ROK)) sv_catpv(d, "IsUV,");
break;
- case SVt_PVBM:
- if (SvTAIL(sv)) sv_catpv(d, "TAIL,");
- if (SvVALID(sv)) sv_catpv(d, "VALID,");
- break;
case SVt_PVMG:
if (SvPAD_TYPED(sv)) sv_catpv(d, "TYPED,");
+ if (SvPAD_OUR(sv)) sv_catpv(d, "OUR,");
+ if (SvPAD_STATE(sv)) sv_catpv(d, "STATE,");
break;
+ case SVt_PVNV:
+ if (SvPAD_STATE(sv)) sv_catpv(d, "STATE,");
+ goto evaled_or_uv;
case SVt_PVAV:
break;
}
sv->sv_debug_cloned ? " (cloned)" : "");
#endif
Perl_dump_indent(aTHX_ level, file, "SV = ");
- switch (type) {
- case SVt_NULL:
- PerlIO_printf(file, "NULL%s\n", s);
- SvREFCNT_dec(d);
- return;
- case SVt_IV:
- PerlIO_printf(file, "IV%s\n", s);
- break;
- case SVt_NV:
- PerlIO_printf(file, "NV%s\n", s);
- break;
- case SVt_RV:
- PerlIO_printf(file, "RV%s\n", s);
- break;
- case SVt_PV:
- PerlIO_printf(file, "PV%s\n", s);
- break;
- case SVt_PVIV:
- PerlIO_printf(file, "PVIV%s\n", s);
- break;
- case SVt_PVNV:
- PerlIO_printf(file, "PVNV%s\n", s);
- break;
- case SVt_PVBM:
- PerlIO_printf(file, "PVBM%s\n", s);
- break;
- case SVt_PVMG:
- PerlIO_printf(file, "PVMG%s\n", s);
- break;
- case SVt_PVLV:
- PerlIO_printf(file, "PVLV%s\n", s);
- break;
- case SVt_PVAV:
- PerlIO_printf(file, "PVAV%s\n", s);
- break;
- case SVt_PVHV:
- PerlIO_printf(file, "PVHV%s\n", s);
- break;
- case SVt_PVCV:
- PerlIO_printf(file, "PVCV%s\n", s);
- break;
- case SVt_PVGV:
- PerlIO_printf(file, "PVGV%s\n", s);
- break;
- case SVt_PVFM:
- PerlIO_printf(file, "PVFM%s\n", s);
- break;
- case SVt_PVIO:
- PerlIO_printf(file, "PVIO%s\n", s);
- break;
- default:
+ if (type < SVt_LAST) {
+ PerlIO_printf(file, "%s%s\n", svtypenames[type], s);
+
+ if (type == SVt_NULL) {
+ SvREFCNT_dec(d);
+ return;
+ }
+ } else {
PerlIO_printf(file, "UNKNOWN(0x%"UVxf") %s\n", (UV)type, s);
SvREFCNT_dec(d);
return;
case SVt_PVGV:
sv_catpv(t, " GV=\"");
break;
- case SVt_PVBM:
- sv_catpv(t, " BM=\"");
+ case SVt_BIND:
+ sv_catpv(t, " BIND=\"");
break;
case SVt_PVFM:
sv_catpv(t, " FM=\"");
level++;
if (PM_GETRE(pm)) {
char *s = PM_GETRE(pm)->precomp;
- SV *tmpsv = newSV(0);
+ SV *tmpsv = newSVpvn("",0);
SvUTF8_on(tmpsv);
sv_catxmlpvn(tmpsv, s, strlen(s), 1);
Perl_xmldump_indent(aTHX_ level, file, "pre=\"%s\"\n",
#else
if (cSVOPo->op_sv) {
SV *tmpsv1 = newSV(0);
- SV *tmpsv2 = newSV(0);
+ SV *tmpsv2 = newSVpvn("",0);
char *s;
STRLEN len;
SvUTF8_on(tmpsv1);
projects / p5sagit/p5-mst-13.2.git / blobdiff