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 (file)
--- 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 (file)
--- 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;
                 }
             }