This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Use new case changing macros
[perl5.git] / utf8.c
diff --git a/utf8.c b/utf8.c
index 01ea070..90d0722 100644 (file)
--- a/utf8.c
+++ b/utf8.c
@@ -90,7 +90,7 @@ Perl_is_ascii_string(const U8 *s, STRLEN len)
 /*
 =for apidoc uvuni_to_utf8_flags
 
-Adds the UTF-8 representation of the code point C<uv> to the end
+Adds the UTF-8 representation of the Unicode code point C<uv> to the end
 of the string C<d>; C<d> should have at least C<UTF8_MAXBYTES+1> free
 bytes available. The return value is the pointer to the byte after the
 end of the new character. In other words,
@@ -109,6 +109,10 @@ This is the recommended Unicode-aware way of saying
 
     *(d++) = uv;
 
+where uv is a code point expressed in Latin-1 or above, not the platform's
+native character set.  B<Almost all code should instead use L</uvchr_to_utf8>
+or L</uvchr_to_utf8_flags>>.
+
 This function will convert to UTF-8 (and not warn) even code points that aren't
 legal Unicode or are problematic, unless C<flags> contains one or more of the
 following flags:
@@ -119,8 +123,9 @@ UNICODE_DISALLOW_SURROGATE is set, the function will fail and return NULL.
 If both flags are set, the function will both warn and return NULL.
 
 The UNICODE_WARN_NONCHAR and UNICODE_DISALLOW_NONCHAR flags correspondingly
-affect how the function handles a Unicode non-character.  And, likewise for the
-UNICODE_WARN_SUPER and UNICODE_DISALLOW_SUPER flags, and code points that are
+affect how the function handles a Unicode non-character.  And likewise, the
+UNICODE_WARN_SUPER and UNICODE_DISALLOW_SUPER flags, affect the handling of
+code points that are
 above the Unicode maximum of 0x10FFFF.  Code points above 0x7FFF_FFFF (which are
 even less portable) can be warned and/or disallowed even if other above-Unicode
 code points are accepted by the UNICODE_WARN_FE_FF and UNICODE_DISALLOW_FE_FF
@@ -258,7 +263,7 @@ Perl_uvuni_to_utf8_flags(pTHX_ U8 *d, UV uv, UV flags)
        return d;
     }
 #endif
-#endif /* Loop style */
+#endif /* Non loop style */
 }
 
 /*
@@ -275,7 +280,7 @@ or less you should use the IS_UTF8_CHAR(), for lengths of five or more
 you should use the _slow().  In practice this means that the _slow()
 will be used very rarely, since the maximum Unicode code point (as of
 Unicode 4.1) is U+10FFFF, which encodes in UTF-8 to four bytes.  Only
-the "Perl extended UTF-8" (the infamous 'v-strings') will encode into
+the "Perl extended UTF-8" (e.g, the infamous 'v-strings') will encode into
 five bytes or more.
 
 =cut */
@@ -1425,17 +1430,22 @@ Perl_utf16_to_utf8(pTHX_ U8* p, U8* d, I32 bytelen, I32 *newlen)
            *d++ = (U8)(( uv        & 0x3f) | 0x80);
            continue;
        }
-       if (uv >= 0xd800 && uv <= 0xdbff) {     /* surrogates */
+#define FIRST_HIGH_SURROGATE UNICODE_SURROGATE_FIRST
+#define LAST_HIGH_SURROGATE  0xDBFF
+#define FIRST_LOW_SURROGATE  0xDC00
+#define LAST_LOW_SURROGATE   UNICODE_SURROGATE_LAST
+       if (uv >= FIRST_HIGH_SURROGATE && uv <= LAST_HIGH_SURROGATE) {
            if (p >= pend) {
                Perl_croak(aTHX_ "Malformed UTF-16 surrogate");
            } else {
                UV low = (p[0] << 8) + p[1];
                p += 2;
-               if (low < 0xdc00 || low > 0xdfff)
+               if (low < FIRST_LOW_SURROGATE || low > LAST_LOW_SURROGATE)
                    Perl_croak(aTHX_ "Malformed UTF-16 surrogate");
-               uv = ((uv - 0xd800) << 10) + (low - 0xdc00) + 0x10000;
+               uv = ((uv - FIRST_HIGH_SURROGATE) << 10)
+                                       + (low - FIRST_LOW_SURROGATE) + 0x10000;
            }
-       } else if (uv >= 0xdc00 && uv <= 0xdfff) {
+       } else if (uv >= FIRST_LOW_SURROGATE && uv <= LAST_LOW_SURROGATE) {
            Perl_croak(aTHX_ "Malformed UTF-16 surrogate");
        }
        if (uv < 0x10000) {
@@ -1479,6 +1489,14 @@ Perl_utf16_to_utf8_reversed(pTHX_ U8* p, U8* d, I32 bytelen, I32 *newlen)
     return utf16_to_utf8(p, d, bytelen, newlen);
 }
 
+bool
+Perl__is_uni_FOO(pTHX_ const U8 classnum, const UV c)
+{
+    U8 tmpbuf[UTF8_MAXBYTES+1];
+    uvchr_to_utf8(tmpbuf, c);
+    return _is_utf8_FOO(classnum, tmpbuf);
+}
+
 /* for now these are all defined (inefficiently) in terms of the utf8 versions.
  * Note that the macros in handy.h that call these short-circuit calling them
  * for Latin-1 range inputs */
@@ -1488,7 +1506,7 @@ Perl_is_uni_alnum(pTHX_ UV c)
 {
     U8 tmpbuf[UTF8_MAXBYTES+1];
     uvchr_to_utf8(tmpbuf, c);
-    return is_utf8_alnum(tmpbuf);
+    return _is_utf8_FOO(_CC_WORDCHAR, tmpbuf);
 }
 
 bool
@@ -1496,11 +1514,13 @@ Perl_is_uni_alnumc(pTHX_ UV c)
 {
     U8 tmpbuf[UTF8_MAXBYTES+1];
     uvchr_to_utf8(tmpbuf, c);
-    return is_utf8_alnumc(tmpbuf);
+    return _is_utf8_FOO(_CC_ALPHANUMERIC, tmpbuf);
 }
 
-bool    /* Internal function so we can deprecate the external one, and call
-           this one from other deprecated functions in this file */
+/* Internal function so we can deprecate the external one, and call
+   this one from other deprecated functions in this file */
+
+PERL_STATIC_INLINE bool
 S_is_utf8_idfirst(pTHX_ const U8 *p)
 {
     dVAR;
@@ -1520,6 +1540,14 @@ Perl_is_uni_idfirst(pTHX_ UV c)
 }
 
 bool
+Perl__is_uni_perl_idcont(pTHX_ UV c)
+{
+    U8 tmpbuf[UTF8_MAXBYTES+1];
+    uvchr_to_utf8(tmpbuf, c);
+    return _is_utf8_perl_idcont(tmpbuf);
+}
+
+bool
 Perl__is_uni_perl_idstart(pTHX_ UV c)
 {
     U8 tmpbuf[UTF8_MAXBYTES+1];
@@ -1532,7 +1560,7 @@ Perl_is_uni_alpha(pTHX_ UV c)
 {
     U8 tmpbuf[UTF8_MAXBYTES+1];
     uvchr_to_utf8(tmpbuf, c);
-    return is_utf8_alpha(tmpbuf);
+    return _is_utf8_FOO(_CC_ALPHA, tmpbuf);
 }
 
 bool
@@ -1558,7 +1586,7 @@ Perl_is_uni_digit(pTHX_ UV c)
 {
     U8 tmpbuf[UTF8_MAXBYTES+1];
     uvchr_to_utf8(tmpbuf, c);
-    return is_utf8_digit(tmpbuf);
+    return _is_utf8_FOO(_CC_DIGIT, tmpbuf);
 }
 
 bool
@@ -1566,7 +1594,7 @@ Perl_is_uni_upper(pTHX_ UV c)
 {
     U8 tmpbuf[UTF8_MAXBYTES+1];
     uvchr_to_utf8(tmpbuf, c);
-    return is_utf8_upper(tmpbuf);
+    return _is_utf8_FOO(_CC_UPPER, tmpbuf);
 }
 
 bool
@@ -1574,7 +1602,7 @@ Perl_is_uni_lower(pTHX_ UV c)
 {
     U8 tmpbuf[UTF8_MAXBYTES+1];
     uvchr_to_utf8(tmpbuf, c);
-    return is_utf8_lower(tmpbuf);
+    return _is_utf8_FOO(_CC_LOWER, tmpbuf);
 }
 
 bool
@@ -1588,7 +1616,7 @@ Perl_is_uni_graph(pTHX_ UV c)
 {
     U8 tmpbuf[UTF8_MAXBYTES+1];
     uvchr_to_utf8(tmpbuf, c);
-    return is_utf8_graph(tmpbuf);
+    return _is_utf8_FOO(_CC_GRAPH, tmpbuf);
 }
 
 bool
@@ -1596,7 +1624,7 @@ Perl_is_uni_print(pTHX_ UV c)
 {
     U8 tmpbuf[UTF8_MAXBYTES+1];
     uvchr_to_utf8(tmpbuf, c);
-    return is_utf8_print(tmpbuf);
+    return _is_utf8_FOO(_CC_PRINT, tmpbuf);
 }
 
 bool
@@ -1604,7 +1632,7 @@ Perl_is_uni_punct(pTHX_ UV c)
 {
     U8 tmpbuf[UTF8_MAXBYTES+1];
     uvchr_to_utf8(tmpbuf, c);
-    return is_utf8_punct(tmpbuf);
+    return _is_utf8_FOO(_CC_PUNCT, tmpbuf);
 }
 
 bool
@@ -1841,16 +1869,16 @@ Perl_is_uni_alnum_lc(pTHX_ UV c)
     if (c < 256) {
         return isALNUM_LC(UNI_TO_NATIVE(c));
     }
-    return is_uni_alnum(c);
+    return _is_uni_FOO(_CC_WORDCHAR, c);
 }
 
 bool
 Perl_is_uni_alnumc_lc(pTHX_ UV c)
 {
     if (c < 256) {
-        return isALNUMC_LC(UNI_TO_NATIVE(c));
+        return isALPHANUMERIC_LC(UNI_TO_NATIVE(c));
     }
-    return is_uni_alnumc(c);
+    return _is_uni_FOO(_CC_ALPHANUMERIC, c);
 }
 
 bool
@@ -1868,7 +1896,7 @@ Perl_is_uni_alpha_lc(pTHX_ UV c)
     if (c < 256) {
         return isALPHA_LC(UNI_TO_NATIVE(c));
     }
-    return is_uni_alpha(c);
+    return _is_uni_FOO(_CC_ALPHA, c);
 }
 
 bool
@@ -1904,7 +1932,7 @@ Perl_is_uni_digit_lc(pTHX_ UV c)
     if (c < 256) {
         return isDIGIT_LC(UNI_TO_NATIVE(c));
     }
-    return is_uni_digit(c);
+    return _is_uni_FOO(_CC_DIGIT, c);
 }
 
 bool
@@ -1913,7 +1941,7 @@ Perl_is_uni_upper_lc(pTHX_ UV c)
     if (c < 256) {
         return isUPPER_LC(UNI_TO_NATIVE(c));
     }
-    return is_uni_upper(c);
+    return _is_uni_FOO(_CC_UPPER, c);
 }
 
 bool
@@ -1922,7 +1950,7 @@ Perl_is_uni_lower_lc(pTHX_ UV c)
     if (c < 256) {
         return isLOWER_LC(UNI_TO_NATIVE(c));
     }
-    return is_uni_lower(c);
+    return _is_uni_FOO(_CC_LOWER, c);
 }
 
 bool
@@ -1940,7 +1968,7 @@ Perl_is_uni_graph_lc(pTHX_ UV c)
     if (c < 256) {
         return isGRAPH_LC(UNI_TO_NATIVE(c));
     }
-    return is_uni_graph(c);
+    return _is_uni_FOO(_CC_GRAPH, c);
 }
 
 bool
@@ -1949,7 +1977,7 @@ Perl_is_uni_print_lc(pTHX_ UV c)
     if (c < 256) {
         return isPRINT_LC(UNI_TO_NATIVE(c));
     }
-    return is_uni_print(c);
+    return _is_uni_FOO(_CC_PRINT, c);
 }
 
 bool
@@ -1958,7 +1986,7 @@ Perl_is_uni_punct_lc(pTHX_ UV c)
     if (c < 256) {
         return isPUNCT_LC(UNI_TO_NATIVE(c));
     }
-    return is_uni_punct(c);
+    return _is_uni_FOO(_CC_PUNCT, c);
 }
 
 bool
@@ -2020,20 +2048,42 @@ S_is_utf8_common(pTHX_ const U8 *const p, SV **swash,
     PERL_ARGS_ASSERT_IS_UTF8_COMMON;
 
     /* The API should have included a length for the UTF-8 character in <p>,
-     * but it doesn't.  We therefor assume that p has been validated at least
+     * but it doesn't.  We therefore assume that p has been validated at least
      * as far as there being enough bytes available in it to accommodate the
      * character without reading beyond the end, and pass that number on to the
      * validating routine */
-    if (!is_utf8_char_buf(p, p + UTF8SKIP(p)))
-       return FALSE;
+    if (! is_utf8_char_buf(p, p + UTF8SKIP(p))) {
+        if (ckWARN_d(WARN_UTF8)) {
+            Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED,WARN_UTF8),
+                   "Passing malformed UTF-8 to \"%s\" is deprecated", swashname);
+            if (ckWARN(WARN_UTF8)) {    /* This will output details as to the
+                                           what the malformation is */
+                utf8_to_uvchr_buf(p, p + UTF8SKIP(p), NULL);
+            }
+        }
+        return FALSE;
+    }
     if (!*swash) {
         U8 flags = _CORE_SWASH_INIT_ACCEPT_INVLIST;
         *swash = _core_swash_init("utf8", swashname, &PL_sv_undef, 1, 0, NULL, &flags);
     }
+
     return swash_fetch(*swash, p, TRUE) != 0;
 }
 
 bool
+Perl__is_utf8_FOO(pTHX_ const U8 classnum, const U8 *p)
+{
+    dVAR;
+
+    PERL_ARGS_ASSERT__IS_UTF8_FOO;
+
+    assert(classnum < _FIRST_NON_SWASH_CC);
+
+    return is_utf8_common(p, &PL_utf8_swash_ptrs[classnum], swash_property_names[classnum]);
+}
+
+bool
 Perl_is_utf8_alnum(pTHX_ const U8 *p)
 {
     dVAR;
@@ -2043,7 +2093,7 @@ Perl_is_utf8_alnum(pTHX_ const U8 *p)
     /* NOTE: "IsWord", not "IsAlnum", since Alnum is a true
      * descendant of isalnum(3), in other words, it doesn't
      * contain the '_'. --jhi */
-    return is_utf8_common(p, &PL_utf8_alnum, "IsWord");
+    return is_utf8_common(p, &PL_utf8_swash_ptrs[_CC_WORDCHAR], "IsWord");
 }
 
 bool
@@ -2053,7 +2103,7 @@ Perl_is_utf8_alnumc(pTHX_ const U8 *p)
 
     PERL_ARGS_ASSERT_IS_UTF8_ALNUMC;
 
-    return is_utf8_common(p, &PL_utf8_alnumc, "IsAlnum");
+    return is_utf8_common(p, &PL_utf8_swash_ptrs[_CC_ALPHANUMERIC], "IsAlnum");
 }
 
 bool
@@ -2090,6 +2140,17 @@ Perl__is_utf8_perl_idstart(pTHX_ const U8 *p)
 }
 
 bool
+Perl__is_utf8_perl_idcont(pTHX_ const U8 *p)
+{
+    dVAR;
+
+    PERL_ARGS_ASSERT__IS_UTF8_PERL_IDCONT;
+
+    return is_utf8_common(p, &PL_utf8_perl_idcont, "_Perl_IDCont");
+}
+
+
+bool
 Perl_is_utf8_idcont(pTHX_ const U8 *p)
 {
     dVAR;
@@ -2116,7 +2177,7 @@ Perl_is_utf8_alpha(pTHX_ const U8 *p)
 
     PERL_ARGS_ASSERT_IS_UTF8_ALPHA;
 
-    return is_utf8_common(p, &PL_utf8_alpha, "IsAlpha");
+    return is_utf8_common(p, &PL_utf8_swash_ptrs[_CC_ALPHA], "IsAlpha");
 }
 
 bool
@@ -2182,7 +2243,7 @@ Perl_is_utf8_digit(pTHX_ const U8 *p)
 
     PERL_ARGS_ASSERT_IS_UTF8_DIGIT;
 
-    return is_utf8_common(p, &PL_utf8_digit, "IsDigit");
+    return is_utf8_common(p, &PL_utf8_swash_ptrs[_CC_DIGIT], "IsDigit");
 }
 
 bool
@@ -2204,7 +2265,7 @@ Perl_is_utf8_upper(pTHX_ const U8 *p)
 
     PERL_ARGS_ASSERT_IS_UTF8_UPPER;
 
-    return is_utf8_common(p, &PL_utf8_upper, "IsUppercase");
+    return is_utf8_common(p, &PL_utf8_swash_ptrs[_CC_UPPER], "IsUppercase");
 }
 
 bool
@@ -2214,7 +2275,7 @@ Perl_is_utf8_lower(pTHX_ const U8 *p)
 
     PERL_ARGS_ASSERT_IS_UTF8_LOWER;
 
-    return is_utf8_common(p, &PL_utf8_lower, "IsLowercase");
+    return is_utf8_common(p, &PL_utf8_swash_ptrs[_CC_LOWER], "IsLowercase");
 }
 
 bool
@@ -2234,7 +2295,7 @@ Perl_is_utf8_graph(pTHX_ const U8 *p)
 
     PERL_ARGS_ASSERT_IS_UTF8_GRAPH;
 
-    return is_utf8_common(p, &PL_utf8_graph, "IsGraph");
+    return is_utf8_common(p, &PL_utf8_swash_ptrs[_CC_GRAPH], "IsGraph");
 }
 
 bool
@@ -2244,7 +2305,7 @@ Perl_is_utf8_print(pTHX_ const U8 *p)
 
     PERL_ARGS_ASSERT_IS_UTF8_PRINT;
 
-    return is_utf8_common(p, &PL_utf8_print, "IsPrint");
+    return is_utf8_common(p, &PL_utf8_swash_ptrs[_CC_PRINT], "IsPrint");
 }
 
 bool
@@ -2254,7 +2315,7 @@ Perl_is_utf8_punct(pTHX_ const U8 *p)
 
     PERL_ARGS_ASSERT_IS_UTF8_PUNCT;
 
-    return is_utf8_common(p, &PL_utf8_punct, "IsPunct");
+    return is_utf8_common(p, &PL_utf8_swash_ptrs[_CC_PUNCT], "IsPunct");
 }
 
 bool
@@ -2268,33 +2329,24 @@ Perl_is_utf8_xdigit(pTHX_ const U8 *p)
 }
 
 bool
-Perl_is_utf8_mark(pTHX_ const U8 *p)
+Perl__is_utf8_mark(pTHX_ const U8 *p)
 {
     dVAR;
 
-    PERL_ARGS_ASSERT_IS_UTF8_MARK;
+    PERL_ARGS_ASSERT__IS_UTF8_MARK;
 
     return is_utf8_common(p, &PL_utf8_mark, "IsM");
 }
 
-bool
-Perl_is_utf8_X_regular_begin(pTHX_ const U8 *p)
-{
-    dVAR;
-
-    PERL_ARGS_ASSERT_IS_UTF8_X_REGULAR_BEGIN;
-
-    return is_utf8_common(p, &PL_utf8_X_regular_begin, "_X_Regular_Begin");
-}
 
 bool
-Perl_is_utf8_X_extend(pTHX_ const U8 *p)
+Perl_is_utf8_mark(pTHX_ const U8 *p)
 {
     dVAR;
 
-    PERL_ARGS_ASSERT_IS_UTF8_X_EXTEND;
+    PERL_ARGS_ASSERT_IS_UTF8_MARK;
 
-    return is_utf8_common(p, &PL_utf8_X_extend, "_X_Extend");
+    return _is_utf8_mark(p);
 }
 
 /*
@@ -2497,15 +2549,7 @@ bad_crossing:
 /*
 =for apidoc to_utf8_upper
 
-Convert the UTF-8 encoded character at C<p> to its uppercase version and
-store that in UTF-8 in C<ustrp> and its length in bytes in C<lenp>.  Note
-that the ustrp needs to be at least UTF8_MAXBYTES_CASE+1 bytes since
-the uppercase version may be longer than the original character.
-
-The first character of the uppercased version is returned
-(but note, as explained above, that there may be more.)
-
-The character at C<p> is assumed by this routine to be well-formed.
+Instead use L</toUPPER_utf8>.
 
 =cut */
 
@@ -2569,15 +2613,7 @@ Perl__to_utf8_upper_flags(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, const bool
 /*
 =for apidoc to_utf8_title
 
-Convert the UTF-8 encoded character at C<p> to its titlecase version and
-store that in UTF-8 in C<ustrp> and its length in bytes in C<lenp>.  Note
-that the C<ustrp> needs to be at least UTF8_MAXBYTES_CASE+1 bytes since the
-titlecase version may be longer than the original character.
-
-The first character of the titlecased version is returned
-(but note, as explained above, that there may be more.)
-
-The character at C<p> is assumed by this routine to be well-formed.
+Instead use L</toTITLE_utf8>.
 
 =cut */
 
@@ -2643,15 +2679,7 @@ Perl__to_utf8_title_flags(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, const bool
 /*
 =for apidoc to_utf8_lower
 
-Convert the UTF-8 encoded character at C<p> to its lowercase version and
-store that in UTF-8 in ustrp and its length in bytes in C<lenp>.  Note
-that the C<ustrp> needs to be at least UTF8_MAXBYTES_CASE+1 bytes since the
-lowercase version may be longer than the original character.
-
-The first character of the lowercased version is returned
-(but note, as explained above, that there may be more.)
-
-The character at C<p> is assumed by this routine to be well-formed.
+Instead use L</toLOWER_utf8>.
 
 =cut */
 
@@ -2716,16 +2744,7 @@ Perl__to_utf8_lower_flags(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, const bool
 /*
 =for apidoc to_utf8_fold
 
-Convert the UTF-8 encoded character at C<p> to its foldcase version and
-store that in UTF-8 in C<ustrp> and its length in bytes in C<lenp>.  Note
-that the C<ustrp> needs to be at least UTF8_MAXBYTES_CASE+1 bytes since the
-foldcase version may be longer than the original character (up to
-three characters).
-
-The first character of the foldcased version is returned
-(but note, as explained above, that there may be more.)
-
-The character at C<p> is assumed by this routine to be well-formed.
+Instead use L</toFOLD_utf8>.
 
 =cut */
 
@@ -2757,7 +2776,7 @@ Perl__to_utf8_fold_flags(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, U8 flags, b
 
     if (UTF8_IS_INVARIANT(*p)) {
        if (flags & FOLD_FLAGS_LOCALE) {
-           result = toLOWER_LC(*p);
+           result = toFOLD_LC(*p);
        }
        else {
            return _to_fold_latin1(*p, ustrp, lenp,
@@ -2766,7 +2785,7 @@ Perl__to_utf8_fold_flags(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, U8 flags, b
     }
     else if UTF8_IS_DOWNGRADEABLE_START(*p) {
        if (flags & FOLD_FLAGS_LOCALE) {
-           result = toLOWER_LC(TWO_BYTE_UTF8_TO_UNI(*p, *(p+1)));
+           result = toFOLD_LC(TWO_BYTE_UTF8_TO_UNI(*p, *(p+1)));
        }
        else {
            return _to_fold_latin1(TWO_BYTE_UTF8_TO_UNI(*p, *(p+1)),
@@ -3179,7 +3198,6 @@ Perl_swash_fetch(pTHX_ SV *swash, const U8 *ptr, bool do_utf8)
      * So the key in the hash (klen) is length of encoded char -1
      */
     klen = UTF8SKIP(ptr) - 1;
-    off  = ptr[klen];
 
     if (klen == 0) {
       /* If char is invariant then swatch is for all the invariant chars
@@ -4383,9 +4401,12 @@ The pointer to the PV of the C<dsv> is returned.
 char *
 Perl_sv_uni_display(pTHX_ SV *dsv, SV *ssv, STRLEN pvlim, UV flags)
 {
+    const char * const ptr =
+        isREGEXP(ssv) ? RX_WRAPPED((REGEXP*)ssv) : SvPVX_const(ssv);
+
     PERL_ARGS_ASSERT_SV_UNI_DISPLAY;
 
-     return Perl_pv_uni_display(aTHX_ dsv, (const U8*)SvPVX_const(ssv),
+    return Perl_pv_uni_display(aTHX_ dsv, (const U8*)ptr,
                                SvCUR(ssv), pvlim, flags);
 }
 
@@ -4559,8 +4580,7 @@ Perl_foldEQ_utf8_flags(pTHX_ const char *s1, char **pe1, UV l1, bool u1, const c
                        return 0;
                    }
                    n1 = 1;
-                   *foldbuf1 = toLOWER(*p1);   /* Folds in the ASCII range are
-                                                  just lowercased */
+                   *foldbuf1 = toFOLD(*p1);
                }
                else if (u1) {
                    to_utf8_fold(p1, foldbuf1, &n1);
@@ -4607,7 +4627,7 @@ Perl_foldEQ_utf8_flags(pTHX_ const char *s1, char **pe1, UV l1, bool u1, const c
                        return 0;
                    }
                    n2 = 1;
-                   *foldbuf2 = toLOWER(*p2);
+                   *foldbuf2 = toFOLD(*p2);
                }
                else if (u2) {
                    to_utf8_fold(p2, foldbuf2, &n2);