op_dump(pm->op_pmreplroot);
}
if (pm->op_pmflags || (PM_GETRE(pm) && PM_GETRE(pm)->check_substr)) {
- SV * const tmpsv = newSVpvs("");
- if (pm->op_pmdynflags & PMdf_USED)
- sv_catpv(tmpsv, ",USED");
- if (pm->op_pmdynflags & PMdf_TAINTED)
- sv_catpv(tmpsv, ",TAINTED");
- if (pm->op_pmflags & PMf_ONCE)
- sv_catpv(tmpsv, ",ONCE");
- if (PM_GETRE(pm) && PM_GETRE(pm)->check_substr
- && !(PM_GETRE(pm)->reganch & ROPT_NOSCAN))
- sv_catpv(tmpsv, ",SCANFIRST");
- if (PM_GETRE(pm) && PM_GETRE(pm)->check_substr
- && PM_GETRE(pm)->reganch & ROPT_CHECK_ALL)
- sv_catpv(tmpsv, ",ALL");
- if (pm->op_pmflags & PMf_SKIPWHITE)
- sv_catpv(tmpsv, ",SKIPWHITE");
- if (pm->op_pmflags & PMf_CONST)
- sv_catpv(tmpsv, ",CONST");
- if (pm->op_pmflags & PMf_KEEP)
- sv_catpv(tmpsv, ",KEEP");
- if (pm->op_pmflags & PMf_GLOBAL)
- sv_catpv(tmpsv, ",GLOBAL");
- if (pm->op_pmflags & PMf_CONTINUE)
- sv_catpv(tmpsv, ",CONTINUE");
- if (pm->op_pmflags & PMf_RETAINT)
- sv_catpv(tmpsv, ",RETAINT");
- if (pm->op_pmflags & PMf_EVAL)
- sv_catpv(tmpsv, ",EVAL");
+ SV * const tmpsv = pm_description(pm);
Perl_dump_indent(aTHX_ level, file, "PMFLAGS = (%s)\n", SvCUR(tmpsv) ? SvPVX_const(tmpsv) + 1 : "");
SvREFCNT_dec(tmpsv);
}
Perl_dump_indent(aTHX_ level-1, file, "}\n");
}
+static
+SV *
+S_pm_description(pTHX_ const PMOP *pm)
+{
+ SV * const desc = newSVpvs("");
+ const REGEXP * regex = PM_GETRE(pm);
+ const U32 pmflags = pm->op_pmflags;
+
+ if (pm->op_pmdynflags & PMdf_USED)
+ sv_catpv(desc, ",USED");
+ if (pm->op_pmdynflags & PMdf_TAINTED)
+ sv_catpv(desc, ",TAINTED");
+
+ if (pmflags & PMf_ONCE)
+ sv_catpv(desc, ",ONCE");
+ if (regex && regex->check_substr) {
+ if (!(regex->reganch & ROPT_NOSCAN))
+ sv_catpv(desc, ",SCANFIRST");
+ if (regex->reganch & ROPT_CHECK_ALL)
+ sv_catpv(desc, ",ALL");
+ }
+ if (pmflags & PMf_SKIPWHITE)
+ sv_catpv(desc, ",SKIPWHITE");
+ if (pmflags & PMf_CONST)
+ sv_catpv(desc, ",CONST");
+ if (pmflags & PMf_KEEP)
+ sv_catpv(desc, ",KEEP");
+ if (pmflags & PMf_GLOBAL)
+ sv_catpv(desc, ",GLOBAL");
+ if (pmflags & PMf_CONTINUE)
+ sv_catpv(desc, ",CONTINUE");
+ if (pmflags & PMf_RETAINT)
+ sv_catpv(desc, ",RETAINT");
+ if (pmflags & PMf_EVAL)
+ sv_catpv(desc, ",EVAL");
+ return desc;
+}
+
void
Perl_pmop_dump(pTHX_ PMOP *pm)
{
Perl_dump_indent(aTHX_ level, file, " LINES_LEFT = %"IVdf"\n", (IV)IoLINES_LEFT(sv));
if (IoTOP_NAME(sv))
Perl_dump_indent(aTHX_ level, file, " TOP_NAME = \"%s\"\n", IoTOP_NAME(sv));
- do_gv_dump (level, file, " TOP_GV", IoTOP_GV(sv));
+ if (!IoTOP_GV(sv) || SvTYPE(IoTOP_GV(sv)) == SVt_PVGV)
+ do_gv_dump (level, file, " TOP_GV", IoTOP_GV(sv));
+ else {
+ Perl_dump_indent(aTHX_ level, file, " TOP_GV = 0x%"UVxf"\n",
+ PTR2UV(IoTOP_GV(sv)));
+ do_sv_dump (level+1, file, (SV *) IoTOP_GV(sv), nest+1, maxnest,
+ dumpops, pvlim);
+ }
+ /* Source filters hide things that are not GVs in these three, so let's
+ be careful out there. */
if (IoFMT_NAME(sv))
Perl_dump_indent(aTHX_ level, file, " FMT_NAME = \"%s\"\n", IoFMT_NAME(sv));
- do_gv_dump (level, file, " FMT_GV", IoFMT_GV(sv));
+ if (!IoFMT_GV(sv) || SvTYPE(IoFMT_GV(sv)) == SVt_PVGV)
+ do_gv_dump (level, file, " FMT_GV", IoFMT_GV(sv));
+ else {
+ Perl_dump_indent(aTHX_ level, file, " FMT_GV = 0x%"UVxf"\n",
+ PTR2UV(IoFMT_GV(sv)));
+ do_sv_dump (level+1, file, (SV *) IoFMT_GV(sv), nest+1, maxnest,
+ dumpops, pvlim);
+ }
if (IoBOTTOM_NAME(sv))
Perl_dump_indent(aTHX_ level, file, " BOTTOM_NAME = \"%s\"\n", IoBOTTOM_NAME(sv));
- do_gv_dump (level, file, " BOTTOM_GV", IoBOTTOM_GV(sv));
+ if (!IoBOTTOM_GV(sv) || SvTYPE(IoBOTTOM_GV(sv)) == SVt_PVGV)
+ do_gv_dump (level, file, " BOTTOM_GV", IoBOTTOM_GV(sv));
+ else {
+ Perl_dump_indent(aTHX_ level, file, " BOTTOM_GV = 0x%"UVxf"\n",
+ PTR2UV(IoBOTTOM_GV(sv)));
+ do_sv_dump (level+1, file, (SV *) IoBOTTOM_GV(sv), nest+1, maxnest,
+ dumpops, pvlim);
+ }
Perl_dump_indent(aTHX_ level, file, " SUBPROCESS = %"IVdf"\n", (IV)IoSUBPROCESS(sv));
if (isPRINT(IoTYPE(sv)))
Perl_dump_indent(aTHX_ level, file, " TYPE = '%c'\n", IoTYPE(sv));
else
Perl_xmldump_indent(aTHX_ level, file, "pre=\"\" when=\"RUN\"\n");
if (pm->op_pmflags || (PM_GETRE(pm) && PM_GETRE(pm)->check_substr)) {
- SV *tmpsv = newSVpvn("", 0);
- if (pm->op_pmdynflags & PMdf_USED)
- sv_catpv(tmpsv, ",USED");
- if (pm->op_pmdynflags & PMdf_TAINTED)
- sv_catpv(tmpsv, ",TAINTED");
- if (pm->op_pmflags & PMf_ONCE)
- sv_catpv(tmpsv, ",ONCE");
- if (PM_GETRE(pm) && PM_GETRE(pm)->check_substr
- && !(PM_GETRE(pm)->reganch & ROPT_NOSCAN))
- sv_catpv(tmpsv, ",SCANFIRST");
- if (PM_GETRE(pm) && PM_GETRE(pm)->check_substr
- && PM_GETRE(pm)->reganch & ROPT_CHECK_ALL)
- sv_catpv(tmpsv, ",ALL");
- if (pm->op_pmflags & PMf_SKIPWHITE)
- sv_catpv(tmpsv, ",SKIPWHITE");
- if (pm->op_pmflags & PMf_CONST)
- sv_catpv(tmpsv, ",CONST");
- if (pm->op_pmflags & PMf_KEEP)
- sv_catpv(tmpsv, ",KEEP");
- if (pm->op_pmflags & PMf_GLOBAL)
- sv_catpv(tmpsv, ",GLOBAL");
- if (pm->op_pmflags & PMf_CONTINUE)
- sv_catpv(tmpsv, ",CONTINUE");
- if (pm->op_pmflags & PMf_RETAINT)
- sv_catpv(tmpsv, ",RETAINT");
- if (pm->op_pmflags & PMf_EVAL)
- sv_catpv(tmpsv, ",EVAL");
+ SV * const tmpsv = pmflags_description(pm);
Perl_xmldump_indent(aTHX_ level, file, "pmflags=\"%s\"\n", SvCUR(tmpsv) ? SvPVX(tmpsv) + 1 : "");
SvREFCNT_dec(tmpsv);
}