Regen perlmodlib. (TODO: why does Pod::t::basic get listed?)

[p5sagit/p5-mst-13.2.git] / utf8.c

diff --git a/utf8.c b/utf8.c
index 576231f..f900724 100644 (file)
--- a/utf8.c
+++ b/utf8.c
@@ -1220,6 +1220,8 @@ Perl_to_utf8_case(pTHX_ U8 *p, U8* ustrp, STRLEN *lenp, SV **swashp,char *normal
         HE *he;
 
         uv = utf8_to_uvchr(p, 0);
+        if (uv <= 0xff)
+            uv = NATIVE_TO_UTF(uv);
 
         if ((hv    = get_hv(special, FALSE)) &&
             (keysv = sv_2mortal(Perl_newSVpvf(aTHX_ "%04"UVXf, uv))) &&
@@ -1230,6 +1232,7 @@ Perl_to_utf8_case(pTHX_ U8 *p, U8* ustrp, STRLEN *lenp, SV **swashp,char *normal
              if (*lenp > 1 || UNI_IS_INVARIANT(c))
                   Copy(s, ustrp, *lenp, U8);
              else {
+                  c = UTF_TO_NATIVE(c);
                   /* something in the 0x80..0xFF range */
                   ustrp[0] = UTF8_EIGHT_BIT_HI(c);
                   ustrp[1] = UTF8_EIGHT_BIT_LO(c);
@@ -1515,4 +1518,31 @@ Perl_utf8n_to_uvchr(pTHX_ U8 *s, STRLEN curlen, STRLEN *retlen, U32 flags)
     return UNI_TO_NATIVE(uv);
 }
 
+char *
+Perl_pv_uni_display(pTHX_ SV *dsv, U8 *spv, STRLEN len, STRLEN pvlim, UV flags)
+{
+    int truncated = 0;
+    char *s, *e;
 
+    sv_setpvn(dsv, "", 0);
+    for (s = (char *)spv, e = s + len; s < e; s += UTF8SKIP(s)) {
+        UV u;
+        if (pvlim && SvCUR(dsv) >= pvlim) {
+             truncated++;
+             break;
+        }
+        u = utf8_to_uvchr((U8*)s, 0);
+        Perl_sv_catpvf(aTHX_ dsv, "\\x{%"UVxf"}", u);
+    }
+    if (truncated)
+        sv_catpvn(dsv, "...", 3);
+    
+    return SvPVX(dsv);
+}
+
+char *
+Perl_sv_uni_display(pTHX_ SV *dsv, SV *ssv, STRLEN pvlim, UV flags)
+{
+  return Perl_pv_uni_display(aTHX_ dsv, (U8*)SvPVX(ssv), SvCUR(ssv),
+                            pvlim, flags);
+}