This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Add a new flag PERL_PV_PRETTY_NOCLEAR (actually just
authorNicholas Clark <nick@ccl4.org>
Sat, 6 Oct 2007 15:04:04 +0000 (15:04 +0000)
committerNicholas Clark <nick@ccl4.org>
Sat, 6 Oct 2007 15:04:04 +0000 (15:04 +0000)
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

dump.c
perl.h

diff --git a/dump.c b/dump.c
index d4fe8b5..ece587a 100644 (file)
--- 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 (file)
--- 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