Turn the I/O Unicode error by default on, but the

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

diff --git a/utf8.c b/utf8.c
index 01d3ae7..cf3f48d 100644 (file)
--- a/utf8.c
+++ b/utf8.c
@@ -1,6 +1,6 @@
 /*    utf8.c
  *
- *    Copyright (c) 1998-2001, Larry Wall
+ *    Copyright (c) 1998-2002, Larry Wall
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -54,7 +54,7 @@ is the recommended Unicode-aware way of saying
 U8 *
 Perl_uvuni_to_utf8_flags(pTHX_ U8 *d, UV uv, UV flags)
 {
-    if (ckWARN_d(WARN_UTF8)) {
+    if (ckWARN(WARN_UTF8)) {
         if (UNICODE_IS_SURROGATE(uv) &&
             !(flags & UNICODE_ALLOW_SURROGATE))
              Perl_warner(aTHX_ WARN_UTF8, "UTF-16 surrogate 0x%04"UVxf, uv);
@@ -1292,9 +1292,7 @@ Perl_to_utf8_case(pTHX_ U8 *p, U8* ustrp, STRLEN *lenp, SV **swashp,char *normal
     if (!*swashp)
         *swashp = swash_init("utf8", normal, &PL_sv_undef, 4, 0);
     uv = swash_fetch(*swashp, p, TRUE);
-    if (uv)
-        uv = UNI_TO_NATIVE(uv);
-    else {
+    if (!uv) {
         HV *hv;
         SV *keysv;
         HE *he;
@@ -1315,8 +1313,24 @@ Perl_to_utf8_case(pTHX_ U8 *p, U8* ustrp, STRLEN *lenp, SV **swashp,char *normal
                   ustrp[1] = UTF8_EIGHT_BIT_LO(c);
                   *lenp = 2;
              }
+#ifdef EBCDIC
+             {
+                  U8 tmpbuf[UTF8_MAXLEN_FOLD+1];
+                  U8 *d = tmpbuf;
+                  U8 *t, *tend;
+                  STRLEN tlen;
+
+                  for (t = ustrp, tend = t + *lenp; t < tend; t += tlen) {
+                       UV c = utf8_to_uvchr(t, &tlen);
+                       d = uvchr_to_utf8(d, UNI_TO_NATIVE(c));
+                  }
+                  *lenp = d - tmpbuf; 
+                  Copy(tmpbuf, ustrp, *lenp, U8);
+             }
+#endif
              return utf8_to_uvchr(ustrp, 0);
         }
+        uv  = NATIVE_TO_UNI(uv);
     }
     if (lenp)
        *lenp = UNISKIP(uv);