X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=dump.c;h=2a3439aca8e714cdd95caa3199e28514500662bd;hb=b69c7e13638df93b8184f0ab25c064bbde4b32e0;hp=26373b5f151253a0daaf0faea8923a13500bb4b8;hpb=040713559c543892d178ea76922b4743ec560c80;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/dump.c b/dump.c
index 26373b5..2a3439a 100644
--- a/dump.c
+++ b/dump.c
@@ -219,8 +219,10 @@ Perl_pv_escape( pTHX_ SV *dsv, char const * const str,
     const char * const end = pv + count; /* end of string */
     octbuf[0] = esc;
 
-    if (!flags & PERL_PV_ESCAPE_NOCLEAR) 
+    if (!(flags & PERL_PV_ESCAPE_NOCLEAR)) {
+	    /* This won't alter the UTF-8 flag */
 	    sv_setpvn(dsv, "", 0);
+    }
     
     if ((flags & PERL_PV_ESCAPE_UNI_DETECT) && is_utf8_string((U8*)pv, count))
         isuni = 1;
@@ -279,6 +281,12 @@ Perl_pv_escape( pTHX_ SV *dsv, char const * const str,
             sv_catpvn(dsv, octbuf, chsize);
             wrote += chsize;
 	} else {
+	    /* If PERL_PV_ESCAPE_NOBACKSLASH is set then bytes in the range
+	       128-255 can be appended raw to the dsv. If dsv happens to be
+	       UTF-8 then we need catpvf to upgrade them for us.
+	       Or add a new API call sv_catpvc(). Think about that name, and
+	       how to keep it clear that it's unlike the s of catpvs, which is
+	       really an array octets, not a string.  */
             Perl_sv_catpvf( aTHX_ dsv, "%c", c);
 	    wrote++;
 	}
@@ -325,12 +333,15 @@ Perl_pv_pretty( pTHX_ SV *dsv, char const * const str, const STRLEN count,
     const U8 dq = (flags & PERL_PV_PRETTY_QUOTE) ? '"' : '%';
     STRLEN escaped;
     
+    if (!(flags & PERL_PV_PRETTY_NOCLEAR)) {
+	    /* This won't alter the UTF-8 flag */
+	    sv_setpvn(dsv, "", 0);
+    }
+
     if ( dq == '"' )
-        sv_setpvn(dsv, "\"", 1);
+        sv_catpvn(dsv, "\"", 1);
     else if ( flags & PERL_PV_PRETTY_LTGT )
-        sv_setpvn(dsv, "<", 1);
-    else 
-        sv_setpvn(dsv, "", 0);
+        sv_catpvn(dsv, "<", 1);
         
     if ( start_color != NULL ) 
         Perl_sv_catpv( aTHX_ dsv, start_color);
@@ -1879,7 +1890,10 @@ void
 Perl_sv_dump(pTHX_ SV *sv)
 {
     dVAR;
-    do_sv_dump(0, Perl_debug_log, sv, 0, 0, 0, 0);
+    if (SvROK(sv))
+	do_sv_dump(0, Perl_debug_log, sv, 0, 4, 0, 0);
+    else
+	do_sv_dump(0, Perl_debug_log, sv, 0, 0, 0, 0);
 }
 
 int
@@ -2101,7 +2115,7 @@ Perl_xmldump_sub(pTHX_ const GV *gv)
 {
     SV * const sv = sv_newmortal();
 
-    gv_fullname3(sv, gv, Nullch);
+    gv_fullname3(sv, gv, NULL);
     Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "\nSUB %s = ", SvPVX(sv));
     if (CvXSUB(GvCV(gv)))
 	Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "(xsub 0x%"UVxf" %d)\n",
@@ -2118,7 +2132,7 @@ Perl_xmldump_form(pTHX_ const GV *gv)
 {
     SV * const sv = sv_newmortal();
 
-    gv_fullname3(sv, gv, Nullch);
+    gv_fullname3(sv, gv, NULL);
     Perl_xmldump_indent(aTHX_ 0, PL_xmlfp, "\nFORMAT %s = ", SvPVX(sv));
     if (CvROOT(GvFORM(gv)))
 	op_xmldump(CvROOT(GvFORM(gv)));
@@ -2223,16 +2237,16 @@ Perl_sv_catxmlpvn(pTHX_ SV *dsv, const char *pv, STRLEN len, int utf8)
 	    Perl_sv_catpvf(aTHX_ dsv, "STUPIDXML(#x%X)", c);
 	    break;
 	case '<':
-	    Perl_sv_catpvf(aTHX_ dsv, "&lt;");
+	    sv_catpvs(dsv, "&lt;");
 	    break;
 	case '>':
-	    Perl_sv_catpvf(aTHX_ dsv, "&gt;");
+	    sv_catpvs(dsv, "&gt;");
 	    break;
 	case '&':
-	    Perl_sv_catpvf(aTHX_ dsv, "&amp;");
+	    sv_catpvs(dsv, "&amp;");
 	    break;
 	case '"':
-	    Perl_sv_catpvf(aTHX_ dsv, "&#34;");
+	    sv_catpvs(dsv, "&#34;");
 	    break;
 	default:
 	    if (c < 0xD800) {
@@ -2240,7 +2254,8 @@ Perl_sv_catxmlpvn(pTHX_ SV *dsv, const char *pv, STRLEN len, int utf8)
 		    Perl_sv_catpvf(aTHX_ dsv, "&#x%X;", c);
 		}
 		else {
-		    Perl_sv_catpvf(aTHX_ dsv, "%c", c);
+		    const char string = (char) c;
+		    sv_catpvn(dsv, &string, 1);
 		}
 		break;
 	    }
@@ -2436,10 +2451,9 @@ 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)) {
-	const char * const s = PM_GETRE(pm)->precomp;
-	SV * const tmpsv = newSVpvn("",0);
+	const regexp *const r = PM_GETRE(pm);
+	SV * const tmpsv = newSVpvn(r->precomp,r->prelen);
 	SvUTF8_on(tmpsv);
-	sv_catxmlpvn(tmpsv, s, strlen(s), 1);
 	Perl_xmldump_indent(aTHX_ level, file, "pre=\"%s\"\n",
 	     SvPVX(tmpsv));
 	SvREFCNT_dec(tmpsv);
@@ -2733,7 +2747,7 @@ Perl_do_op_xmldump(pTHX_ I32 level, PerlIO *file, const OP *o)
 	    ENTER;
 	    SAVEFREESV(tmpsv1);
 	    SAVEFREESV(tmpsv2);
-	    gv_fullname3(tmpsv1, (GV*)cSVOPo->op_sv, Nullch);
+	    gv_fullname3(tmpsv1, (GV*)cSVOPo->op_sv, NULL);
 	    s = SvPV(tmpsv1,len);
 	    sv_catxmlpvn(tmpsv2, s, len, 1);
 	    S_xmldump_attr(aTHX_ level, file, "gv=\"%s\"", SvPV(tmpsv2, len));