X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=dump.c;h=7c2834189490a55a0072bb62a5568c188fcdee6b;hb=4ee50d44aab4daa2990af918a17df7200b6e468c;hp=76aec2bd422ab87b97414fa5f3a68de705a0cc24;hpb=c737faaf63999e5a68ef536d362cea408ab990b7;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/dump.c b/dump.c
index 76aec2b..7c28341 100644
--- a/dump.c
+++ b/dump.c
@@ -106,17 +106,18 @@ Perl_dump_packsubs(pTHX_ const HV *stash)
     for (i = 0; i <= (I32) HvMAX(stash); i++) {
         const HE *entry;
 	for (entry = HvARRAY(stash)[i]; entry; entry = HeNEXT(entry)) {
-            const GV *gv = (GV*)HeVAL(entry);
-            const HV *hv;
+	    const GV * const gv = (GV*)HeVAL(entry);
 	    if (SvTYPE(gv) != SVt_PVGV || !GvGP(gv))
 		continue;
 	    if (GvCVu(gv))
 		dump_sub(gv);
 	    if (GvFORM(gv))
 		dump_form(gv);
-	    if (HeKEY(entry)[HeKLEN(entry)-1] == ':'
-		&& (hv = GvHV(gv)) && hv != PL_defstash)
-		dump_packsubs(hv);		/* nested package */
+	    if (HeKEY(entry)[HeKLEN(entry)-1] == ':') {
+		const HV * const hv = GvHV(gv);
+		if (hv && (hv != PL_defstash))
+		    dump_packsubs(hv);		/* nested package */
+	    }
 	}
     }
 }
@@ -207,15 +208,15 @@ Perl_pv_escape( pTHX_ SV *dsv, char const * const str,
                 const STRLEN count, const STRLEN max, 
                 STRLEN * const escaped, const U32 flags ) 
 {
-    char esc = (flags & PERL_PV_ESCAPE_RE) ? '%' : '\\';
-    char dq = (flags & PERL_PV_ESCAPE_QUOTE) ? '"' : esc;
+    const char esc = (flags & PERL_PV_ESCAPE_RE) ? '%' : '\\';
+    const char dq = (flags & PERL_PV_ESCAPE_QUOTE) ? '"' : esc;
     char octbuf[PV_ESCAPE_OCTBUFSIZE] = "%123456789ABCDF";
     STRLEN wrote = 0;    /* chars written so far */
     STRLEN chsize = 0;   /* size of data to be written */
     STRLEN readsize = 1; /* size of data just read */
     bool isuni= flags & PERL_PV_ESCAPE_UNI ? 1 : 0; /* is this unicode */
     const char *pv  = str;
-    const char *end = pv + count; /* end of string */
+    const char * const end = pv + count; /* end of string */
     octbuf[0] = esc;
 
     if (!flags & PERL_PV_ESCAPE_NOCLEAR) 
@@ -321,7 +322,7 @@ Perl_pv_pretty( pTHX_ SV *dsv, char const * const str, const STRLEN count,
   const STRLEN max, char const * const start_color, char const * const end_color, 
   const U32 flags ) 
 {
-    U8 dq = (flags & PERL_PV_PRETTY_QUOTE) ? '"' : '%';
+    const U8 dq = (flags & PERL_PV_PRETTY_QUOTE) ? '"' : '%';
     STRLEN escaped;
     
     if ( dq == '"' )
@@ -510,10 +511,8 @@ Perl_sv_peek(pTHX_ SV *sv)
 	sv_catpv(t, "()");
 
   finish:
-    if (unref) {
-	while (unref--)
-	    sv_catpv(t, ")");
-    }
+    while (unref--)
+	sv_catpv(t, ")");
     return SvPV_nolen(t);
 }
 
@@ -538,9 +537,9 @@ Perl_do_pmop_dump(pTHX_ I32 level, PerlIO *file, const PMOP *pm)
 	     (pm->op_private & OPpRUNTIME) ? " (RUNTIME)" : "");
     else
 	Perl_dump_indent(aTHX_ level, file, "PMf_PRE (RUNTIME)\n");
-    if (pm->op_type != OP_PUSHRE && pm->op_pmreplroot) {
+    if (pm->op_type != OP_PUSHRE && pm->op_pmreplrootu.op_pmreplroot) {
 	Perl_dump_indent(aTHX_ level, file, "PMf_REPL = ");
-	op_dump(pm->op_pmreplroot);
+	op_dump(pm->op_pmreplrootu.op_pmreplroot);
     }
     if (pm->op_pmflags || (PM_GETRE(pm) && PM_GETRE(pm)->check_substr)) {
 	SV * const tmpsv = pm_description(pm);
@@ -555,7 +554,7 @@ static SV *
 S_pm_description(pTHX_ const PMOP *pm)
 {
     SV * const desc = newSVpvs("");
-    const REGEXP * regex = PM_GETRE(pm);
+    const REGEXP * const regex = PM_GETRE(pm);
     const U32 pmflags = pm->op_pmflags;
 
     if (pmflags & PMf_ONCE)
@@ -567,18 +566,20 @@ S_pm_description(pTHX_ const PMOP *pm)
     if (pmflags & PMf_USED)
         sv_catpv(desc, ":USED");
 #endif
-    if (regex->extflags & RXf_TAINTED)
-	sv_catpv(desc, ",TAINTED");
 
-
-    if (regex && regex->check_substr) {
-	if (!(regex->extflags & RXf_NOSCAN))
-	    sv_catpv(desc, ",SCANFIRST");
-	if (regex->extflags & RXf_CHECK_ALL)
-	    sv_catpv(desc, ",ALL");
+    if (regex) {
+        if (regex->extflags & RXf_TAINTED)
+            sv_catpv(desc, ",TAINTED");
+        if (regex->check_substr) {
+            if (!(regex->extflags & RXf_NOSCAN))
+                sv_catpv(desc, ",SCANFIRST");
+            if (regex->extflags & RXf_CHECK_ALL)
+                sv_catpv(desc, ",ALL");
+        }
+        if (regex->extflags & RXf_SKIPWHITE)
+            sv_catpv(desc, ",SKIPWHITE");
     }
-    if (regex->extflags & RXf_SKIPWHITE)
-	sv_catpv(desc, ",SKIPWHITE");
+
     if (pmflags & PMf_CONST)
 	sv_catpv(desc, ",CONST");
     if (pmflags & PMf_KEEP)
@@ -673,13 +674,13 @@ S_sequence(pTHX_ register const OP *o)
 	    sequence_tail(cLOOPo->op_lastop);
 	    break;
 
-	case OP_QR:
-	case OP_MATCH:
 	case OP_SUBST:
 	    hv_store(Sequence, key, len, newSVuv(++PL_op_seq), 0);
-	    sequence_tail(cPMOPo->op_pmreplstart);
+	    sequence_tail(cPMOPo->op_pmstashstartu.op_pmreplstart);
 	    break;
 
+	case OP_QR:
+	case OP_MATCH:
 	case OP_HELEM:
 	    break;
 
@@ -969,7 +970,7 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
 	Perl_dump_indent(aTHX_ level, file, "MADPROPS = {\n");
 	level++;
 	while (mp) {
-	    char tmp = mp->mad_key;
+	    const char tmp = mp->mad_key;
 	    sv_setpvn(tmpsv,"'",1);
 	    if (tmp)
 		sv_catpvn(tmpsv, &tmp, 1);
@@ -1272,8 +1273,8 @@ Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, const MAGIC *mg, I32 nest, I32
 	    Perl_dump_indent(aTHX_ level, file, "    MG_OBJ = 0x%"UVxf"\n", 
 	        PTR2UV(mg->mg_obj));
             if (mg->mg_type == PERL_MAGIC_qr) {
-                regexp *re=(regexp *)mg->mg_obj;
-                SV *dsv= sv_newmortal();
+		const regexp * const re = (regexp *)mg->mg_obj;
+		SV * const dsv = sv_newmortal();
                 const char * const s =  pv_pretty(dsv, re->wrapped, re->wraplen, 
                     60, NULL, NULL,
                     ( PERL_PV_PRETTY_QUOTE | PERL_PV_ESCAPE_RE | PERL_PV_PRETTY_ELIPSES |
@@ -1292,7 +1293,7 @@ Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, const MAGIC *mg, I32 nest, I32
 	    Perl_dump_indent(aTHX_ level, file, "    MG_PTR = 0x%"UVxf, PTR2UV(mg->mg_ptr));
 	    if (mg->mg_len >= 0) {
 		if (mg->mg_type != PERL_MAGIC_utf8) {
-		    SV *sv = newSVpvs("");
+		    SV * const sv = newSVpvs("");
 		    PerlIO_printf(file, " %s", pv_display(sv, mg->mg_ptr, mg->mg_len, 0, pvlim));
 		    SvREFCNT_dec(sv);
 		}
@@ -1307,7 +1308,7 @@ Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, const MAGIC *mg, I32 nest, I32
             PerlIO_putc(file, '\n');
         }
 	if (mg->mg_type == PERL_MAGIC_utf8) {
-	    STRLEN *cache = (STRLEN *) mg->mg_ptr;
+	    const STRLEN * const cache = (STRLEN *) mg->mg_ptr;
 	    if (cache) {
 		IV i;
 		for (i = 0; i < PERL_MAGIC_UTF8_CACHESIZE; i++)
@@ -1436,7 +1437,6 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
 	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,");
@@ -1582,7 +1582,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
     }
     if (type >= SVt_PVMG) {
 	if (type == SVt_PVMG && SvPAD_OUR(sv)) {
-	    HV *ost = SvOURSTASH(sv);
+	    HV * const ost = SvOURSTASH(sv);
 	    if (ost)
 		do_hv_dump(level, file, "  OURSTASH", ost);
 	} else {
@@ -1612,7 +1612,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
 	if (nest < maxnest && av_len((AV*)sv) >= 0) {
 	    int count;
 	    for (count = 0; count <=  av_len((AV*)sv) && count < maxnest; count++) {
-		SV** elt = av_fetch((AV*)sv,count,0);
+		SV** const elt = av_fetch((AV*)sv,count,0);
 
 		Perl_dump_indent(aTHX_ level + 1, file, "Elt No. %"IVdf"\n", (IV)count);
 		if (elt)
@@ -1709,14 +1709,12 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
 	    hv_iterinit(hv);
 	    while ((he = hv_iternext_flags(hv, HV_ITERNEXT_WANTPLACEHOLDERS))
                    && count--) {
-		SV *elt, *keysv;
-                const char *keypv;
 		STRLEN len;
 		const U32 hash = HeHASH(he);
+		SV * const keysv = hv_iterkeysv(he);
+		const char * const keypv = SvPV_const(keysv, len);
+		SV * const elt = hv_iterval(hv, he);
 
-		keysv = hv_iterkeysv(he);
-		keypv = SvPV_const(keysv, len);
-		elt = hv_iterval(hv, he);
 		Perl_dump_indent(aTHX_ level+1, file, "Elt %s ", pv_display(d, keypv, len, 0, pvlim));
 		if (SvUTF8(keysv))
 		    PerlIO_printf(file, "[UTF8 \"%s\"] ", sv_uni_display(d, keysv, 8 * sv_len_utf8(keysv), UNI_DISPLAY_QQ));
@@ -1751,7 +1749,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
 		do_op_dump(level+1, file, CvROOT(sv));
 	    }
 	} else {
-	    SV *constant = cv_const_sv((CV *)sv);
+	    SV * const constant = cv_const_sv((CV *)sv);
 
 	    Perl_dump_indent(aTHX_ level, file, "  XSUB = 0x%"UVxf"\n", PTR2UV(CvXSUB(sv)));
 
@@ -1980,7 +1978,7 @@ Perl_debop(pTHX_ const OP *o)
 }
 
 STATIC CV*
-S_deb_curcv(pTHX_ I32 ix)
+S_deb_curcv(pTHX_ const I32 ix)
 {
     dVAR;
     const PERL_CONTEXT * const cx = &cxstack[ix];
@@ -2010,7 +2008,7 @@ STATIC void
 S_debprof(pTHX_ const OP *o)
 {
     dVAR;
-    if (CopSTASH_eq(PL_curcop, PL_debstash) && !DEBUG_J_TEST_)
+    if (!DEBUG_J_TEST_ && CopSTASH_eq(PL_curcop, PL_debstash))
 	return;
     if (!PL_profiledata)
 	Newxz(PL_profiledata, MAXO, U32);
@@ -2037,8 +2035,7 @@ Perl_debprofdump(pTHX)
  *    XML variants of most of the above routines
  */
 
-STATIC
-void
+STATIC void
 S_xmldump_attr(pTHX_ I32 level, PerlIO *file, const char* pat, ...)
 {
     va_list args;
@@ -2104,7 +2101,7 @@ Perl_xmldump_packsubs(pTHX_ const HV *stash)
 void
 Perl_xmldump_sub(pTHX_ const GV *gv)
 {
-    SV *sv = sv_newmortal();
+    SV * const sv = sv_newmortal();
 
     gv_fullname3(sv, gv, Nullch);
     Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "\nSUB %s = ", SvPVX(sv));
@@ -2121,7 +2118,7 @@ Perl_xmldump_sub(pTHX_ const GV *gv)
 void
 Perl_xmldump_form(pTHX_ const GV *gv)
 {
-    SV *sv = sv_newmortal();
+    SV * const sv = sv_newmortal();
 
     gv_fullname3(sv, gv, Nullch);
     Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "\nFORMAT %s = ", SvPVX(sv));
@@ -2147,7 +2144,7 @@ char *
 Perl_sv_catxmlpvn(pTHX_ SV *dsv, char* pv, STRLEN len, int utf8)
 {
     unsigned int c;
-    char *e = pv + len;
+    const char * const e = pv + len;
     char *start = pv;
     STRLEN dsvcur;
     STRLEN cl;
@@ -2270,7 +2267,7 @@ Perl_sv_catxmlpvn(pTHX_ SV *dsv, char* pv, STRLEN len, int utf8)
 char *
 Perl_sv_xmlpeek(pTHX_ SV *sv)
 {
-    SV *t = sv_newmortal();
+    SV * const t = sv_newmortal();
     STRLEN n_a;
     int unref = 0;
 
@@ -2426,10 +2423,8 @@ Perl_sv_xmlpeek(pTHX_ SV *sv)
     sv_catpv(t, "\"");
 
   finish:
-    if (unref) {
-	while (unref--)
-	    sv_catpv(t, ")");
-    }
+    while (unref--)
+	sv_catpv(t, ")");
     return SvPV(t, n_a);
 }
 
@@ -2443,8 +2438,8 @@ Perl_do_pmop_xmldump(pTHX_ I32 level, PerlIO *file, const PMOP *pm)
     Perl_xmldump_indent(aTHX_ level, file, "<pmop \n");
     level++;
     if (PM_GETRE(pm)) {
-	char *s = PM_GETRE(pm)->precomp;
-	SV *tmpsv = newSVpvn("",0);
+	const char * const s = PM_GETRE(pm)->precomp;
+	SV * const tmpsv = newSVpvn("",0);
 	SvUTF8_on(tmpsv);
 	sv_catxmlpvn(tmpsv, s, strlen(s), 1);
 	Perl_xmldump_indent(aTHX_ level, file, "pre=\"%s\"\n",
@@ -2462,10 +2457,10 @@ Perl_do_pmop_xmldump(pTHX_ I32 level, PerlIO *file, const PMOP *pm)
     }
 
     level--;
-    if (pm->op_type != OP_PUSHRE && pm->op_pmreplroot) {
+    if (pm->op_type != OP_PUSHRE && pm->op_pmreplrootu.op_pmreplroot) {
 	Perl_xmldump_indent(aTHX_ level, file, ">\n");
 	Perl_xmldump_indent(aTHX_ level+1, file, "<pm_repl>\n");
-	do_op_xmldump(level+2, file, pm->op_pmreplroot);
+	do_op_xmldump(level+2, file, pm->op_pmreplrootu.op_pmreplroot);
 	Perl_xmldump_indent(aTHX_ level+1, file, "</pm_repl>\n");
 	Perl_xmldump_indent(aTHX_ level, file, "</pmop>\n");
     }
@@ -2523,7 +2518,7 @@ Perl_do_op_xmldump(pTHX_ I32 level, PerlIO *file, const OP *o)
     PerlIO_printf(file, " addr=\"0x%"UVxf" => 0x%"UVxf"\"", (UV)o, (UV)o->op_next);
 #endif
     if (o->op_flags) {
-	SV *tmpsv = newSVpvn("", 0);
+	SV * const tmpsv = newSVpvn("", 0);
 	switch (o->op_flags & OPf_WANT) {
 	case OPf_WANT_VOID:
 	    sv_catpv(tmpsv, ",VOID");
@@ -2554,7 +2549,7 @@ Perl_do_op_xmldump(pTHX_ I32 level, PerlIO *file, const OP *o)
 	SvREFCNT_dec(tmpsv);
     }
     if (o->op_private) {
-	SV *tmpsv = newSVpvn("", 0);
+	SV * const tmpsv = newSVpvn("", 0);
 	if (PL_opargs[o->op_type] & OA_TARGLEX) {
 	    if (o->op_private & OPpTARGET_MY)
 		sv_catpv(tmpsv, ",TARGET_MY");
@@ -2731,8 +2726,8 @@ Perl_do_op_xmldump(pTHX_ I32 level, PerlIO *file, const OP *o)
 	S_xmldump_attr(aTHX_ level, file, "padix=\"%" IVdf "\"", (IV)cPADOPo->op_padix);
 #else
 	if (cSVOPo->op_sv) {
-	    SV *tmpsv1 = newSV(0);
-	    SV *tmpsv2 = newSVpvn("",0);
+	    SV * const tmpsv1 = newSV(0);
+	    SV * const tmpsv2 = newSVpvn("",0);
 	    char *s;
 	    STRLEN len;
 	    SvUTF8_on(tmpsv1);
@@ -2821,8 +2816,10 @@ Perl_do_op_xmldump(pTHX_ I32 level, PerlIO *file, const OP *o)
     }
 
     if (PL_madskills && o->op_madprop) {
-	SV *tmpsv = newSVpvn("", 0);
-	MADPROP* mp = o->op_madprop;
+	char prevkey = '\0';
+	SV * const tmpsv = newSVpvn("", 0);
+	const MADPROP* const mp = o->op_madprop;
+
 	sv_utf8_upgrade(tmpsv);
 	if (!contents) {
 	    contents = 1;
@@ -2835,6 +2832,10 @@ Perl_do_op_xmldump(pTHX_ I32 level, PerlIO *file, const OP *o)
 	    sv_setpvn(tmpsv,"\"",1);
 	    if (tmp)
 		sv_catxmlpvn(tmpsv, &tmp, 1, 0);
+	    if ((tmp == '_') || (tmp == '#')) /* '_' '#' whitespace belong to the previous token. */
+		sv_catxmlpvn(tmpsv, &prevkey, 1, 0);
+	    else
+		prevkey = tmp;
 	    sv_catpv(tmpsv, "\"");
 	    switch (mp->mad_type) {
 	    case MAD_NULL: