From: Andy Lester <andy@petdance.com>
Date: Sun, 16 Apr 2006 00:29:36 +0000 (-0500)
Subject: dump.c patch redux
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=4199688e3d699f53e17448d3bad6e93e57d49dcc;p=p5sagit%2Fp5-mst-13.2.git

dump.c patch redux
Message-ID: <20060416052936.GA19143@petdance.com>

p4raw-id: //depot/perl@27845
---

diff --git a/dump.c b/dump.c
index 7081662..e548585 100644
--- a/dump.c
+++ b/dump.c
@@ -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);
     }
diff --git a/embed.fnc b/embed.fnc
index 08bc2e4..ac1ec46 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -1335,6 +1335,7 @@ s	|CV*	|deb_curcv	|I32 ix
 s	|void	|debprof	|NN const OP *o
 s	|void	|sequence	|NULLOK const OP *o
 s	|UV	|sequence_num	|NULLOK const OP *o
+s	|SV*	|pm_description	|NN const PMOP *pm
 #endif
 
 #if defined(PERL_IN_SCOPE_C) || defined(PERL_DECL_PROT)
diff --git a/embed.h b/embed.h
index 2afc074..68d3b2e 100644
--- a/embed.h
+++ b/embed.h
@@ -1354,6 +1354,7 @@
 #define debprof			S_debprof
 #define sequence		S_sequence
 #define sequence_num		S_sequence_num
+#define pm_description		S_pm_description
 #endif
 #endif
 #if defined(PERL_IN_SCOPE_C) || defined(PERL_DECL_PROT)
@@ -3508,6 +3509,7 @@
 #define debprof(a)		S_debprof(aTHX_ a)
 #define sequence(a)		S_sequence(aTHX_ a)
 #define sequence_num(a)		S_sequence_num(aTHX_ a)
+#define pm_description(a)	S_pm_description(aTHX_ a)
 #endif
 #endif
 #if defined(PERL_IN_SCOPE_C) || defined(PERL_DECL_PROT)
diff --git a/proto.h b/proto.h
index 1cd6131..4808040 100644
--- a/proto.h
+++ b/proto.h
@@ -3673,6 +3673,9 @@ STATIC void	S_debprof(pTHX_ const OP *o)
 
 STATIC void	S_sequence(pTHX_ const OP *o);
 STATIC UV	S_sequence_num(pTHX_ const OP *o);
+STATIC SV*	S_pm_description(pTHX_ const PMOP *pm)
+			__attribute__nonnull__(pTHX_1);
+
 #endif
 
 #if defined(PERL_IN_SCOPE_C) || defined(PERL_DECL_PROT)