diff options
| -rw-r--r-- | ext/B/B.xs | 28 | ||||
| -rw-r--r-- | utf8.c | 2 |
2 files changed, 29 insertions, 1 deletions
diff --git a/ext/B/B.xs b/ext/B/B.xs index 76f96e078a..885a73c6d9 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? */ @@ -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; } } |