RE: Net/Ping/t/510_ping_udp.t fails on Windows Vista

[p5sagit/p5-mst-13.2.git] / dump.c

diff --git a/dump.c b/dump.c
index 26373b5..2a3439a 100644 (file)
--- 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));