From: Rafael Garcia-Suarez <rgarciasuarez@gmail.com>
Date: Mon, 18 Mar 2002 23:14:31 +0000 (+0100)
Subject: B::perlstring and unicode
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d79a7a3d6c6ab340cac86730d02550f83fa03489;p=p5sagit%2Fp5-mst-13.2.git

B::perlstring and unicode
Message-ID: <20020318231431.A699@rafael>

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

diff --git a/ext/B/B.xs b/ext/B/B.xs
index 76f96e0..885a73c 100644
--- a/ext/B/B.xs
+++ b/ext/B/B.xs
@@ -233,6 +233,34 @@ cstring(pTHX_ SV *sv, bool perlstyle)
 
     if (!SvOK(sv))
 	sv_setpvn(sstr, "0", 1);
+    else if (perlstyle && SvUTF8(sv))
+    {
+	SV *tmpsv = sv_newmortal(); /* Temporary SV to feed sv_uni_display */
+	len = SvCUR(sv);
+	s = sv_uni_display(tmpsv, sv, 8*len, UNI_DISPLAY_QQ);
+	sv_setpv(sstr,"\"");
+	while (*s)
+	{
+	    if (*s == '"')
+		sv_catpv(sstr, "\\\"");
+	    else if (*s == '$')
+		sv_catpv(sstr, "\\$");
+	    else if (*s == '@')
+		sv_catpv(sstr, "\\@");
+	    else if (*s == '\\')
+	    {
+		if (strchr("nrftax\\",*(s+1)))
+		    sv_catpvn(sstr, s++, 2);
+		else
+		    sv_catpv(sstr, "\\\\");
+	    }
+	    else /* should always be printable */
+		sv_catpvn(sstr, s, 1);
+	    ++s;
+	}
+	sv_catpv(sstr, "\"");
+	return sstr;
+    }
     else
     {
 	/* XXX Optimise? */
diff --git a/utf8.c b/utf8.c
index 82c1f50..f16cb66 100644
--- a/utf8.c
+++ b/utf8.c
@@ -1751,7 +1751,7 @@ Perl_pv_uni_display(pTHX_ SV *dsv, U8 *spv, STRLEN len, STRLEN pvlim, UV flags)
 		 case '\a':
 		     Perl_sv_catpvf(aTHX_ dsv, "\\a"); ok = TRUE; break;
 		 case '\\':
-		     Perl_sv_catpvf(aTHX_ dsv, "\\" ); ok = TRUE; break;
+		     Perl_sv_catpvf(aTHX_ dsv, "\\\\" ); ok = TRUE; break;
 		 default: break;
 		 }
 	     }