This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Update Compress-Raw-Zlib to CPAN version 2.048
[perl5.git] / utf8.h
diff --git a/utf8.h b/utf8.h
index 5c7b513..e558bb6 100644 (file)
--- a/utf8.h
+++ b/utf8.h
@@ -1,6 +1,7 @@
 /*    utf8.h
  *
- *    Copyright (C) 2000, 2001, 2002, 2005, 2006, 2007, 2009 by Larry Wall and others
+ *    Copyright (C) 2000, 2001, 2002, 2005, 2006, 2007, 2009,
+ *    2010, 2011 by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
 #    define USE_UTF8_IN_NAMES (PL_hints & HINT_UTF8)
 #endif
 
+/* For to_utf8_fold_flags, q.v. */
+#define FOLD_FLAGS_LOCALE 0x1
+#define FOLD_FLAGS_FULL   0x2
+
 #define to_uni_fold(c, p, lenp) _to_uni_fold_flags(c, p, lenp, 1)
-#define to_utf8_fold(c, p, lenp) _to_utf8_fold_flags(c, p, lenp, 1)
+#define to_utf8_fold(c, p, lenp) _to_utf8_fold_flags(c, p, lenp, \
+                    FOLD_FLAGS_FULL, NULL)
+#define to_utf8_lower(a,b,c) _to_utf8_lower_flags(a,b,c,0, NULL)
+#define to_utf8_upper(a,b,c) _to_utf8_upper_flags(a,b,c,0, NULL)
+#define to_utf8_title(a,b,c) _to_utf8_title_flags(a,b,c,0, NULL)
 
 /* Source backward compatibility. */
 #define uvuni_to_utf8(d, uv)           uvuni_to_utf8_flags(d, uv, 0)
@@ -242,8 +251,10 @@ Perl's extended UTF-8 means we can have start bytes up to FF.
 
 #define IN_BYTES (CopHINTS_get(PL_curcop) & HINT_BYTES)
 #define DO_UTF8(sv) (SvUTF8(sv) && !IN_BYTES)
-#define IN_UNI_8_BIT ( (CopHINTS_get(PL_curcop) & HINT_UNI_8_BIT) \
-                       && ! IN_LOCALE_RUNTIME && ! IN_BYTES)
+#define IN_UNI_8_BIT \
+           (CopHINTS_get(PL_curcop) & (HINT_UNI_8_BIT|HINT_LOCALE_NOT_CHARS) \
+            && ! IN_LOCALE_RUNTIME && ! IN_BYTES)
+
 
 #define UTF8_ALLOW_EMPTY               0x0001  /* Allow a zero length string */
 
@@ -310,7 +321,7 @@ Perl's extended UTF-8 means we can have start bytes up to FF.
  */
 #ifdef EBCDIC /* Both versions assume well-formed UTF8 */
 #   define UTF8_IS_SURROGATE(s)  (*(s) == UTF_TO_NATIVE(0xF1)                   \
-      && (*((s) +1) == UTF_TO_NATIVE(0xB6)) || *((s) + 1) == UTF_TO_NATIVE(0xB7))
+    && ((*((s) +1) == UTF_TO_NATIVE(0xB6)) || *((s) + 1) == UTF_TO_NATIVE(0xB7)))
 #else
 #   define UTF8_IS_SURROGATE(s) (*(s) == 0xED && *((s) + 1) >= 0xA0)
 #endif
@@ -458,9 +469,7 @@ Perl's extended UTF-8 means we can have start bytes up to FF.
         toLOWER((input)[1]) == 's')
 #define SHARP_S_SKIP 2
 
-#ifdef EBCDIC
-/* IS_UTF8_CHAR() is not ported to EBCDIC */
-#else
+#ifndef EBCDIC
 #   define IS_UTF8_CHAR_1(p)   \
        ((p)[0] <= 0x7F)
 #   define IS_UTF8_CHAR_2(p)   \
@@ -532,6 +541,58 @@ Perl's extended UTF-8 means we can have start bytes up to FF.
 
 #   define IS_UTF8_CHAR_FAST(n) ((n) <= 4)
 
+#else  /* EBCDIC */
+
+/* This is an attempt to port IS_UTF8_CHAR to EBCDIC based on eyeballing.
+ * untested.  If want to exclude surrogates and above-Unicode, see the
+ * definitions for UTF8_IS_SURROGATE  and UTF8_IS_SUPER */
+#   define IS_UTF8_CHAR_1(p)   \
+       (NATIVE_TO_ASCII((p)[0]) <= 0x9F)
+#   define IS_UTF8_CHAR_2(p)   \
+       (NATIVE_TO_I8((p)[0]) >= 0xC5 && NATIVE_TO_I8((p)[0]) <= 0xDF && \
+        NATIVE_TO_I8((p)[1]) >= 0xA0 && NATIVE_TO_I8((p)[1]) <= 0xBF)
+#   define IS_UTF8_CHAR_3(p)   \
+       (NATIVE_TO_I8((p)[0]) == 0xE1 && NATIVE_TO_I8((p)[1]) <= 0xEF && \
+        NATIVE_TO_I8((p)[1]) >= 0xA0 && NATIVE_TO_I8((p)[1]) <= 0xBF && \
+        NATIVE_TO_I8((p)[2]) >= 0xA0 && NATIVE_TO_I8((p)[2]) <= 0xBF)
+#   define IS_UTF8_CHAR_4a(p)  \
+       (NATIVE_TO_I8((p)[0]) == 0xF0 && \
+        NATIVE_TO_I8((p)[1]) >= 0xB0 && NATIVE_TO_I8((p)[1]) <= 0xBF && \
+        NATIVE_TO_I8((p)[2]) >= 0xA0 && NATIVE_TO_I8((p)[2]) <= 0xBF && \
+        NATIVE_TO_I8((p)[3]) >= 0xA0 && NATIVE_TO_I8((p)[3]) <= 0xBF)
+#   define IS_UTF8_CHAR_4b(p)  \
+       (NATIVE_TO_I8((p)[0]) >= 0xF1 && NATIVE_TO_I8((p)[0]) <= 0xF7 && \
+        NATIVE_TO_I8((p)[1]) >= 0xA0 && NATIVE_TO_I8((p)[1]) <= 0xBF && \
+        NATIVE_TO_I8((p)[2]) >= 0xA0 && NATIVE_TO_I8((p)[2]) <= 0xBF && \
+        NATIVE_TO_I8((p)[3]) >= 0xA0 && NATIVE_TO_I8((p)[3]) <= 0xBF)
+#   define IS_UTF8_CHAR_5a(p)  \
+       (NATIVE_TO_I8((p)[0]) == 0xF8 && \
+        NATIVE_TO_I8((p)[1]) >= 0xA8 && NATIVE_TO_I8((p)[1]) <= 0xBF && \
+        NATIVE_TO_I8((p)[1]) >= 0xA0 && NATIVE_TO_I8((p)[1]) <= 0xBF && \
+        NATIVE_TO_I8((p)[2]) >= 0xA0 && NATIVE_TO_I8((p)[2]) <= 0xBF && \
+        NATIVE_TO_I8((p)[3]) >= 0xA0 && NATIVE_TO_I8((p)[3]) <= 0xBF)
+#   define IS_UTF8_CHAR_5b(p)  \
+        (NATIVE_TO_I8((p)[0]) >= 0xF9 && NATIVE_TO_I8((p)[1]) <= 0xFB && \
+        NATIVE_TO_I8((p)[1]) >= 0xA0 && NATIVE_TO_I8((p)[1]) <= 0xBF && \
+        NATIVE_TO_I8((p)[1]) >= 0xA0 && NATIVE_TO_I8((p)[1]) <= 0xBF && \
+        NATIVE_TO_I8((p)[2]) >= 0xA0 && NATIVE_TO_I8((p)[2]) <= 0xBF && \
+        NATIVE_TO_I8((p)[3]) >= 0xA0 && NATIVE_TO_I8((p)[3]) <= 0xBF)
+
+#   define IS_UTF8_CHAR_4(p)   \
+       (IS_UTF8_CHAR_4a(p) || \
+        IS_UTF8_CHAR_4b(p))
+#   define IS_UTF8_CHAR_5(p)   \
+       (IS_UTF8_CHAR_5a(p) || \
+        IS_UTF8_CHAR_5b(p))
+#   define IS_UTF8_CHAR(p, n)  \
+       ((n) == 1 ? IS_UTF8_CHAR_1(p) : \
+        (n) == 2 ? IS_UTF8_CHAR_2(p) : \
+        (n) == 3 ? IS_UTF8_CHAR_3(p) : \
+        (n) == 4 ? IS_UTF8_CHAR_4(p) : \
+        (n) == 5 ? IS_UTF8_CHAR_5(p) : 0)
+
+#   define IS_UTF8_CHAR_FAST(n) ((n) <= 5)
+
 #endif /* IS_UTF8_CHAR() for UTF-8 */
 
 /*