From: Nicholas Clark <nick@ccl4.org>
Date: Sat, 6 Oct 2007 15:04:04 +0000 (+0000)
Subject: Add a new flag PERL_PV_PRETTY_NOCLEAR (actually just
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=881a015edde9e00018b9cadaf8ea296c17cdfc50;p=p5sagit%2Fp5-mst-13.2.git

Add a new flag PERL_PV_PRETTY_NOCLEAR (actually just
PERL_PV_ESCAPE_NOCLEAR), and change Perl_pv_pretty() so that if this
bit is set, the output SV is not reset to an empty string.

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

diff --git a/dump.c b/dump.c
index d4fe8b5..ece587a 100644
--- a/dump.c
+++ b/dump.c
@@ -333,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);
diff --git a/perl.h b/perl.h
index 31a0c58..98e0dd0 100644
--- a/perl.h
+++ b/perl.h
@@ -5875,6 +5875,8 @@ extern void moncontrol(int);
 #define PERL_PV_ESCAPE_NOCLEAR      0x4000
 #define PERL_PV_ESCAPE_RE           0x8000
 
+#define PERL_PV_PRETTY_NOCLEAR      PERL_PV_ESCAPE_NOCLEAR
+
 /* used by pv_display in dump.c*/
 #define PERL_PV_PRETTY_DUMP  PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_QUOTE
 #define PERL_PV_PRETTY_REGPROP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_LTGT|PERL_PV_ESCAPE_RE