This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
utf8.c: Allow Changed behavior of utf8 under locale
authorKarl Williamson <public@khwilliamson.com>
Wed, 14 Dec 2011 04:48:19 +0000 (21:48 -0700)
committerKarl Williamson <public@khwilliamson.com>
Thu, 15 Dec 2011 23:25:51 +0000 (16:25 -0700)
This changes the 4 case changing functions to take extra parameters to
specify if the utf8 string is to be processed under locale rules when
the code points are < 256.  The current functions are changed to macros
that call the new versions so that current behavior is unchanged.

An additional, static, function is created that makes sure that the
255/256 boundary is not crossed during the case change.

embed.fnc
embed.h
proto.h
utf8.c
utf8.h

index 470b11d..3fc270a 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1386,11 +1386,14 @@ Ap      |void   |taint_env
 Ap     |void   |taint_proper   |NULLOK const char* f|NN const char *const s
 Apd    |UV     |to_utf8_case   |NN const U8 *p|NN U8* ustrp|NULLOK STRLEN *lenp \
                                |NN SV **swashp|NN const char *normal|NULLOK const char *special
-Apd    |UV     |to_utf8_lower  |NN const U8 *p|NN U8* ustrp|NULLOK STRLEN *lenp
-Apd    |UV     |to_utf8_upper  |NN const U8 *p|NN U8* ustrp|NULLOK STRLEN *lenp
-Apd    |UV     |to_utf8_title  |NN const U8 *p|NN U8* ustrp|NULLOK STRLEN *lenp
+Apdm   |UV     |to_utf8_lower  |NN const U8 *p|NN U8* ustrp|NULLOK STRLEN *lenp
+EXMp   |UV     |_to_utf8_lower_flags   |NN const U8 *p|NN U8* ustrp|NULLOK STRLEN *lenp|const bool flags|NULLOK bool* tainted_ptr
+Apdm   |UV     |to_utf8_upper  |NN const U8 *p|NN U8* ustrp|NULLOK STRLEN *lenp
+EXMp   |UV     |_to_utf8_upper_flags   |NN const U8 *p|NN U8* ustrp|NULLOK STRLEN *lenp|const bool flags|NULLOK bool* tainted_ptr
+Apdm   |UV     |to_utf8_title  |NN const U8 *p|NN U8* ustrp|NULLOK STRLEN *lenp
+EXMp   |UV     |_to_utf8_title_flags   |NN const U8 *p|NN U8* ustrp|NULLOK STRLEN *lenp|const bool flags|NULLOK bool* tainted_ptr
 Ampd   |UV     |to_utf8_fold   |NN const U8 *p|NN U8* ustrp|NULLOK STRLEN *lenp
-AMp    |UV     |_to_utf8_fold_flags|NN const U8 *p|NN U8* ustrp|NULLOK STRLEN *lenp|U8 flags
+EXMp   |UV     |_to_utf8_fold_flags|NN const U8 *p|NN U8* ustrp|NULLOK STRLEN *lenp|U8 flags|NULLOK bool* tainted_ptr
 #if defined(PERL_IN_MG_C) || defined(PERL_IN_PP_C)
 p      |bool   |translate_substr_offsets|STRLEN curlen|IV pos1_iv \
                                         |bool pos1_is_uv|IV len_iv \
@@ -2142,6 +2145,7 @@ sn        |NV|mulexp10    |NV value|I32 exponent
 
 #if defined(PERL_IN_UTF8_C)
 sRn    |STRLEN |is_utf8_char_slow|NN const U8 *s|const STRLEN len
+sRM    |UV     |check_locale_boundary_crossing|NN const U8* const p|const UV result|NN U8* const ustrp|NN STRLEN *lenp
 sR     |bool   |is_utf8_common |NN const U8 *const p|NN SV **swash|NN const char * const swashname
 sR     |SV*    |swash_get      |NN SV* swash|UV start|UV span
 #endif
diff --git a/embed.h b/embed.h
index d05dd8a..8c9257d 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -28,7 +28,6 @@
 
 #define Gv_AMupdate(a,b)       Perl_Gv_AMupdate(aTHX_ a,b)
 #define _to_uni_fold_flags(a,b,c,d)    Perl__to_uni_fold_flags(aTHX_ a,b,c,d)
-#define _to_utf8_fold_flags(a,b,c,d)   Perl__to_utf8_fold_flags(aTHX_ a,b,c,d)
 #define amagic_call(a,b,c,d)   Perl_amagic_call(aTHX_ a,b,c,d)
 #define amagic_deref_call(a,b) Perl_amagic_deref_call(aTHX_ a,b)
 #define apply_attrs_string(a,b,c,d)    Perl_apply_attrs_string(aTHX_ a,b,c,d)
 #define to_uni_upper(a,b,c)    Perl_to_uni_upper(aTHX_ a,b,c)
 #define to_uni_upper_lc(a)     Perl_to_uni_upper_lc(aTHX_ a)
 #define to_utf8_case(a,b,c,d,e,f)      Perl_to_utf8_case(aTHX_ a,b,c,d,e,f)
-#define to_utf8_lower(a,b,c)   Perl_to_utf8_lower(aTHX_ a,b,c)
-#define to_utf8_title(a,b,c)   Perl_to_utf8_title(aTHX_ a,b,c)
-#define to_utf8_upper(a,b,c)   Perl_to_utf8_upper(aTHX_ a,b,c)
 #define unpack_str(a,b,c,d,e,f,g,h)    Perl_unpack_str(aTHX_ a,b,c,d,e,f,g,h)
 #define unpackstring(a,b,c,d,e)        Perl_unpackstring(aTHX_ a,b,c,d,e)
 #define unsharepvn(a,b,c)      Perl_unsharepvn(aTHX_ a,b,c)
 #endif
 #if defined(PERL_CORE) || defined(PERL_EXT)
 #define _is_utf8__perl_idstart(a)      Perl__is_utf8__perl_idstart(aTHX_ a)
+#define _to_utf8_fold_flags(a,b,c,d,e) Perl__to_utf8_fold_flags(aTHX_ a,b,c,d,e)
+#define _to_utf8_lower_flags(a,b,c,d,e)        Perl__to_utf8_lower_flags(aTHX_ a,b,c,d,e)
+#define _to_utf8_title_flags(a,b,c,d,e)        Perl__to_utf8_title_flags(aTHX_ a,b,c,d,e)
+#define _to_utf8_upper_flags(a,b,c,d,e)        Perl__to_utf8_upper_flags(aTHX_ a,b,c,d,e)
 #define av_reify(a)            Perl_av_reify(aTHX_ a)
 #define is_utf8_X_L(a)         Perl_is_utf8_X_L(aTHX_ a)
 #define is_utf8_X_LV(a)                Perl_is_utf8_X_LV(aTHX_ a)
 #  endif
 #  if defined(PERL_IN_UTF8_C)
 #define _to_fold_latin1(a,b,c,d)       Perl__to_fold_latin1(aTHX_ a,b,c,d)
+#define check_locale_boundary_crossing(a,b,c,d)        S_check_locale_boundary_crossing(aTHX_ a,b,c,d)
 #define is_utf8_char_slow      S_is_utf8_char_slow
 #define is_utf8_common(a,b,c)  S_is_utf8_common(aTHX_ a,b,c)
 #define swash_get(a,b,c)       S_swash_get(aTHX_ a,b,c)
diff --git a/proto.h b/proto.h
index ff84a22..3fc81e3 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -35,12 +35,30 @@ PERL_CALLCONV UV    Perl__to_uni_fold_flags(pTHX_ UV c, U8 *p, STRLEN *lenp, U8 fla
 #define PERL_ARGS_ASSERT__TO_UNI_FOLD_FLAGS    \
        assert(p); assert(lenp)
 
-PERL_CALLCONV UV       Perl__to_utf8_fold_flags(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, U8 flags)
+PERL_CALLCONV UV       Perl__to_utf8_fold_flags(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, U8 flags, bool* tainted_ptr)
                        __attribute__nonnull__(pTHX_1)
                        __attribute__nonnull__(pTHX_2);
 #define PERL_ARGS_ASSERT__TO_UTF8_FOLD_FLAGS   \
        assert(p); assert(ustrp)
 
+PERL_CALLCONV UV       Perl__to_utf8_lower_flags(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, const bool flags, bool* tainted_ptr)
+                       __attribute__nonnull__(pTHX_1)
+                       __attribute__nonnull__(pTHX_2);
+#define PERL_ARGS_ASSERT__TO_UTF8_LOWER_FLAGS  \
+       assert(p); assert(ustrp)
+
+PERL_CALLCONV UV       Perl__to_utf8_title_flags(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, const bool flags, bool* tainted_ptr)
+                       __attribute__nonnull__(pTHX_1)
+                       __attribute__nonnull__(pTHX_2);
+#define PERL_ARGS_ASSERT__TO_UTF8_TITLE_FLAGS  \
+       assert(p); assert(ustrp)
+
+PERL_CALLCONV UV       Perl__to_utf8_upper_flags(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, const bool flags, bool* tainted_ptr)
+                       __attribute__nonnull__(pTHX_1)
+                       __attribute__nonnull__(pTHX_2);
+#define PERL_ARGS_ASSERT__TO_UTF8_UPPER_FLAGS  \
+       assert(p); assert(ustrp)
+
 PERL_CALLCONV PADOFFSET        Perl_allocmy(pTHX_ const char *const name, const STRLEN len, const U32 flags)
                        __attribute__nonnull__(pTHX_1);
 #define PERL_ARGS_ASSERT_ALLOCMY       \
@@ -4438,23 +4456,17 @@ PERL_CALLCONV UV        Perl_to_utf8_case(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, S
                        __attribute__nonnull__(pTHX_1)
                        __attribute__nonnull__(pTHX_2); */
 
-PERL_CALLCONV UV       Perl_to_utf8_lower(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp)
+/* PERL_CALLCONV UV    Perl_to_utf8_lower(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp)
                        __attribute__nonnull__(pTHX_1)
-                       __attribute__nonnull__(pTHX_2);
-#define PERL_ARGS_ASSERT_TO_UTF8_LOWER \
-       assert(p); assert(ustrp)
+                       __attribute__nonnull__(pTHX_2); */
 
-PERL_CALLCONV UV       Perl_to_utf8_title(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp)
+/* PERL_CALLCONV UV    Perl_to_utf8_title(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp)
                        __attribute__nonnull__(pTHX_1)
-                       __attribute__nonnull__(pTHX_2);
-#define PERL_ARGS_ASSERT_TO_UTF8_TITLE \
-       assert(p); assert(ustrp)
+                       __attribute__nonnull__(pTHX_2); */
 
-PERL_CALLCONV UV       Perl_to_utf8_upper(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp)
+/* PERL_CALLCONV UV    Perl_to_utf8_upper(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp)
                        __attribute__nonnull__(pTHX_1)
-                       __attribute__nonnull__(pTHX_2);
-#define PERL_ARGS_ASSERT_TO_UTF8_UPPER \
-       assert(p); assert(ustrp)
+                       __attribute__nonnull__(pTHX_2); */
 
 PERL_CALLCONV bool     Perl_try_amagic_bin(pTHX_ int method, int flags);
 PERL_CALLCONV bool     Perl_try_amagic_un(pTHX_ int method, int flags);
@@ -7025,6 +7037,14 @@ PERL_CALLCONV UV Perl__to_fold_latin1(pTHX_ const U8 c, U8 *p, STRLEN *lenp, con
 #define PERL_ARGS_ASSERT__TO_FOLD_LATIN1       \
        assert(p); assert(lenp)
 
+STATIC UV      S_check_locale_boundary_crossing(pTHX_ const U8* const p, const UV result, U8* const ustrp, STRLEN *lenp)
+                       __attribute__warn_unused_result__
+                       __attribute__nonnull__(pTHX_1)
+                       __attribute__nonnull__(pTHX_3)
+                       __attribute__nonnull__(pTHX_4);
+#define PERL_ARGS_ASSERT_CHECK_LOCALE_BOUNDARY_CROSSING        \
+       assert(p); assert(ustrp); assert(lenp)
+
 STATIC STRLEN  S_is_utf8_char_slow(const U8 *s, const STRLEN len)
                        __attribute__warn_unused_result__
                        __attribute__nonnull__(1);
diff --git a/utf8.c b/utf8.c
index a8c3832..4889e7e 100644 (file)
--- a/utf8.c
+++ b/utf8.c
@@ -2108,6 +2108,53 @@ Perl_to_utf8_case(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp,
     return len ? utf8_to_uvchr(ustrp, 0) : 0;
 }
 
+STATIC UV
+S_check_locale_boundary_crossing(pTHX_ const U8* const p, const UV result, U8* const ustrp, STRLEN *lenp)
+{
+    /* This is called when changing the case of a utf8-encoded character above
+     * the Latin1 range, and the operation is in locale.  If the result
+     * contains a character that crosses the 255/256 boundary, disallow the
+     * change, and return the original code point.  See L<perlfunc/lc> for why;
+     *
+     * p       points to the original string whose case was changed
+     * result  the code point of the first character in the changed-case string
+     * ustrp   points to the changed-case string (<result> represents its first char)
+     * lenp    points to the length of <ustrp> */
+
+    UV original;    /* To store the first code point of <p> */
+
+    PERL_ARGS_ASSERT_CHECK_LOCALE_BOUNDARY_CROSSING;
+
+    assert(! UTF8_IS_INVARIANT(*p) && ! UTF8_IS_DOWNGRADEABLE_START(*p));
+
+    /* We know immediately if the first character in the string crosses the
+     * boundary, so can skip */
+    if (result > 255) {
+
+       /* Look at every character in the result; if any cross the
+       * boundary, the whole thing is disallowed */
+       U8* s = ustrp + UTF8SKIP(ustrp);
+       U8* e = ustrp + *lenp;
+       while (s < e) {
+           if (UTF8_IS_INVARIANT(*s) || UTF8_IS_DOWNGRADEABLE_START(*s))
+           {
+               goto bad_crossing;
+           }
+           s += UTF8SKIP(s);
+       }
+
+       /* Here, no characters crossed, result is ok as-is */
+       return result;
+    }
+
+bad_crossing:
+
+    /* Failed, have to return the original */
+    original = utf8_to_uvchr(p, lenp);
+    Copy(p, ustrp, *lenp, char);
+    return original;
+}
+
 /*
 =for apidoc to_utf8_upper
 
@@ -2121,22 +2168,61 @@ The first character of the uppercased version is returned
 
 =cut */
 
+/* Not currently externally documented, and subject to change:
+ * <flags> is set iff locale semantics are to be used for code points < 256
+ * <tainted_ptr> if non-null, *tainted_ptr will be set TRUE iff locale rules
+ *              were used in the calculation; otherwise unchanged. */
+
 UV
-Perl_to_utf8_upper(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp)
+Perl__to_utf8_upper_flags(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, const bool flags, bool* tainted_ptr)
 {
     dVAR;
 
-    PERL_ARGS_ASSERT_TO_UTF8_UPPER;
+    UV result;
+
+    PERL_ARGS_ASSERT__TO_UTF8_UPPER_FLAGS;
 
     if (UTF8_IS_INVARIANT(*p)) {
+       if (flags) {
+           result = toUPPER_LC(*p);
+       }
+       else {
        return _to_upper_title_latin1(*p, ustrp, lenp, 'S');
+       }
     }
     else if UTF8_IS_DOWNGRADEABLE_START(*p) {
+       if (flags) {
+           result = toUPPER_LC(TWO_BYTE_UTF8_TO_UNI(*p, *(p+1)));
+       }
+       else {
        return _to_upper_title_latin1(TWO_BYTE_UTF8_TO_UNI(*p, *(p+1)),
                                      ustrp, lenp, 'S');
+       }
+    }
+    else {  /* utf8, ord above 255 */
+       result = CALL_UPPER_CASE(p, ustrp, lenp);
+
+       if (flags) {
+           result = check_locale_boundary_crossing(p, result, ustrp, lenp);
+       }
+       return result;
+    }
+
+    /* Here, used locale rules.  Convert back to utf8 */
+    if (UTF8_IS_INVARIANT(result)) {
+       *ustrp = (U8) result;
+       *lenp = 1;
+    }
+    else {
+       *ustrp = UTF8_EIGHT_BIT_HI(result);
+       *(ustrp + 1) = UTF8_EIGHT_BIT_LO(result);
+       *lenp = 2;
     }
 
-    return CALL_UPPER_CASE(p, ustrp, lenp);
+    if (tainted_ptr) {
+       *tainted_ptr = TRUE;
+    }
+    return result;
 }
 
 /*
@@ -2152,22 +2238,63 @@ The first character of the titlecased version is returned
 
 =cut */
 
+/* Not currently externally documented, and subject to change:
+ * <flags> is set iff locale semantics are to be used for code points < 256
+ *        Since titlecase is not defined in POSIX, uppercase is used instead
+ *        for these/
+ * <tainted_ptr> if non-null, *tainted_ptr will be set TRUE iff locale rules
+ *              were used in the calculation; otherwise unchanged. */
+
 UV
-Perl_to_utf8_title(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp)
+Perl__to_utf8_title_flags(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, const bool flags, bool* tainted_ptr)
 {
     dVAR;
 
-    PERL_ARGS_ASSERT_TO_UTF8_TITLE;
+    UV result;
+
+    PERL_ARGS_ASSERT__TO_UTF8_TITLE_FLAGS;
 
     if (UTF8_IS_INVARIANT(*p)) {
+       if (flags) {
+           result = toUPPER_LC(*p);
+       }
+       else {
        return _to_upper_title_latin1(*p, ustrp, lenp, 's');
+       }
     }
     else if UTF8_IS_DOWNGRADEABLE_START(*p) {
+       if (flags) {
+           result = toUPPER_LC(TWO_BYTE_UTF8_TO_UNI(*p, *(p+1)));
+       }
+       else {
        return _to_upper_title_latin1(TWO_BYTE_UTF8_TO_UNI(*p, *(p+1)),
                                      ustrp, lenp, 's');
+       }
     }
+    else {  /* utf8, ord above 255 */
+       result = CALL_TITLE_CASE(p, ustrp, lenp);
 
-    return CALL_TITLE_CASE(p, ustrp, lenp);
+       if (flags) {
+           result = check_locale_boundary_crossing(p, result, ustrp, lenp);
+       }
+       return result;
+    }
+
+    /* Here, used locale rules.  Convert back to utf8 */
+    if (UTF8_IS_INVARIANT(result)) {
+       *ustrp = (U8) result;
+       *lenp = 1;
+    }
+    else {
+       *ustrp = UTF8_EIGHT_BIT_HI(result);
+       *(ustrp + 1) = UTF8_EIGHT_BIT_LO(result);
+       *lenp = 2;
+    }
+
+    if (tainted_ptr) {
+       *tainted_ptr = TRUE;
+    }
+    return result;
 }
 
 /*
@@ -2183,21 +2310,61 @@ The first character of the lowercased version is returned
 
 =cut */
 
+/* Not currently externally documented, and subject to change:
+ * <flags> is set iff locale semantics are to be used for code points < 256
+ * <tainted_ptr> if non-null, *tainted_ptr will be set TRUE iff locale rules
+ *              were used in the calculation; otherwise unchanged. */
+
 UV
-Perl_to_utf8_lower(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp)
+Perl__to_utf8_lower_flags(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, const bool flags, bool* tainted_ptr)
 {
+    UV result;
+
     dVAR;
 
-    PERL_ARGS_ASSERT_TO_UTF8_LOWER;
+    PERL_ARGS_ASSERT__TO_UTF8_LOWER_FLAGS;
 
     if (UTF8_IS_INVARIANT(*p)) {
+       if (flags) {
+           result = toLOWER_LC(*p);
+       }
+       else {
        return to_lower_latin1(*p, ustrp, lenp);
+       }
     }
     else if UTF8_IS_DOWNGRADEABLE_START(*p) {
+       if (flags) {
+           result = toLOWER_LC(TWO_BYTE_UTF8_TO_UNI(*p, *(p+1)));
+       }
+       else {
        return to_lower_latin1(TWO_BYTE_UTF8_TO_UNI(*p, *(p+1)), ustrp, lenp);
+       }
     }
+    else {  /* utf8, ord above 255 */
+       result = CALL_LOWER_CASE(p, ustrp, lenp);
+
+       if (flags) {
+           result = check_locale_boundary_crossing(p, result, ustrp, lenp);
+       }
 
-    return CALL_LOWER_CASE(p, ustrp, lenp);
+       return result;
+    }
+
+    /* Here, used locale rules.  Convert back to utf8 */
+    if (UTF8_IS_INVARIANT(result)) {
+       *ustrp = (U8) result;
+       *lenp = 1;
+    }
+    else {
+       *ustrp = UTF8_EIGHT_BIT_HI(result);
+       *(ustrp + 1) = UTF8_EIGHT_BIT_LO(result);
+       *lenp = 2;
+    }
+
+    if (tainted_ptr) {
+       *tainted_ptr = TRUE;
+    }
+    return result;
 }
 
 /*
@@ -2214,25 +2381,67 @@ The first character of the foldcased version is returned
 
 =cut */
 
-/* Not currently externally documented is 'flags', which currently is non-zero
- * if full case folds are to be used; otherwise simple folds */
+/* Not currently externally documented, and subject to change,
+ * in <flags>
+ *     bit FOLD_FLAGS_LOCALE is set iff locale semantics are to be used for code
+ *                           points < 256.  Since foldcase is not defined in
+ *                           POSIX, lowercase is used instead
+ *      bit FOLD_FLAGS_FULL   is set iff full case folds are to be used;
+ *                           otherwise simple folds
+ * <tainted_ptr> if non-null, *tainted_ptr will be set TRUE iff locale rules
+ *              were used in the calculation; otherwise unchanged. */
 
 UV
-Perl__to_utf8_fold_flags(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, U8 flags)
+Perl__to_utf8_fold_flags(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, U8 flags, bool* tainted_ptr)
 {
     dVAR;
 
+    UV result;
+
     PERL_ARGS_ASSERT__TO_UTF8_FOLD_FLAGS;
 
     if (UTF8_IS_INVARIANT(*p)) {
-       return _to_fold_latin1(*p, ustrp, lenp, flags);
+       if (flags & FOLD_FLAGS_LOCALE) {
+           result = toLOWER_LC(*p);
+       }
+       else {
+       return _to_fold_latin1(*p, ustrp, lenp, cBOOL(flags & FOLD_FLAGS_FULL));
+       }
     }
     else if UTF8_IS_DOWNGRADEABLE_START(*p) {
+       if (flags & FOLD_FLAGS_LOCALE) {
+           result = toLOWER_LC(TWO_BYTE_UTF8_TO_UNI(*p, *(p+1)));
+       }
+       else {
        return _to_fold_latin1(TWO_BYTE_UTF8_TO_UNI(*p, *(p+1)),
-                                                   ustrp, lenp, flags);
+                                  ustrp, lenp, cBOOL(flags & FOLD_FLAGS_FULL));
+       }
     }
+    else {  /* utf8, ord above 255 */
+       result = CALL_FOLD_CASE(p, ustrp, lenp, flags);
 
-    return CALL_FOLD_CASE(p, ustrp, lenp, flags);
+       if ((flags & FOLD_FLAGS_LOCALE)) {
+           result = check_locale_boundary_crossing(p, result, ustrp, lenp);
+       }
+
+       return result;
+    }
+
+    /* Here, used locale rules.  Convert back to utf8 */
+    if (UTF8_IS_INVARIANT(result)) {
+       *ustrp = (U8) result;
+       *lenp = 1;
+    }
+    else {
+       *ustrp = UTF8_EIGHT_BIT_HI(result);
+       *(ustrp + 1) = UTF8_EIGHT_BIT_LO(result);
+       *lenp = 2;
+    }
+
+    if (tainted_ptr) {
+       *tainted_ptr = TRUE;
+    }
+    return result;
 }
 
 /* Note:
diff --git a/utf8.h b/utf8.h
index 6aa4412..d57a3ef 100644 (file)
--- a/utf8.h
+++ b/utf8.h
 #    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)