diff options
author | Andy Lester <andy@petdance.com> | 2006-04-15 19:29:36 -0500 |
---|---|---|
committer | Steve Peters <steve@fisharerojo.org> | 2006-04-16 13:43:01 +0000 |
commit | 4199688e3d699f53e17448d3bad6e93e57d49dcc (patch) | |
tree | 9667d257d8ef4381e46e10218217872bf54427d2 /dump.c | |
parent | aa0a69cb4bc6ac8103067b4dd5c2d09748f9d78d (diff) | |
download | perl-4199688e3d699f53e17448d3bad6e93e57d49dcc.tar.gz |
dump.c patch redux
Message-ID: <20060416052936.GA19143@petdance.com>
p4raw-id: //depot/perl@27845
Diffstat (limited to 'dump.c')
-rw-r--r-- | dump.c | 94 |
1 files changed, 40 insertions, 54 deletions
@@ -365,33 +365,7 @@ Perl_do_pmop_dump(pTHX_ I32 level, PerlIO *file, const PMOP *pm) 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); } @@ -399,6 +373,44 @@ Perl_do_pmop_dump(pTHX_ I32 level, PerlIO *file, const PMOP *pm) 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) { @@ -2256,33 +2268,7 @@ Perl_do_pmop_xmldump(pTHX_ I32 level, PerlIO *file, const PMOP *pm) 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); } |