From d79a7a3d6c6ab340cac86730d02550f83fa03489 Mon Sep 17 00:00:00 2001 From: Rafael Garcia-Suarez Date: Tue, 19 Mar 2002 00:14:31 +0100 Subject: [PATCH] B::perlstring and unicode Message-ID: <20020318231431.A699@rafael> p4raw-id: //depot/perl@15308 --- ext/B/B.xs | 28 ++++++++++++++++++++++++++++ utf8.c | 2 +- 2 files changed, 29 insertions(+), 1 deletion(-) 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; } } -- 1.8.3.1