perldelta for Storable and vstrings

[perl5.git] / utf8.c

diff --git a/utf8.c b/utf8.c
index 3afa69c..8c3c891 100644 (file)
--- a/utf8.c
+++ b/utf8.c
@@ -1510,6 +1510,14 @@ Perl_is_uni_ascii(pTHX_ UV c)
 }
 
 bool
+Perl_is_uni_blank(pTHX_ UV c)
+{
+    U8 tmpbuf[UTF8_MAXBYTES+1];
+    uvchr_to_utf8(tmpbuf, c);
+    return is_utf8_blank(tmpbuf);
+}
+
+bool
 Perl_is_uni_space(pTHX_ UV c)
 {
     U8 tmpbuf[UTF8_MAXBYTES+1];
@@ -1619,7 +1627,7 @@ Perl__to_upper_title_latin1(pTHX_ const U8 c, U8* p, STRLEN *lenp, const char S_
                return 'S';
            default:
                Perl_croak(aTHX_ "panic: to_upper_title_latin1 did not expect '%c' to map to '%c'", c, LATIN_SMALL_LETTER_Y_WITH_DIAERESIS);
-               /* NOTREACHED */
+               assert(0); /* NOTREACHED */
        }
     }
 
@@ -1830,6 +1838,12 @@ Perl_is_uni_ascii_lc(pTHX_ UV c)
 }
 
 bool
+Perl_is_uni_blank_lc(pTHX_ UV c)
+{
+    return is_uni_blank(c);    /* XXX no locale support yet */
+}
+
+bool
 Perl_is_uni_space_lc(pTHX_ UV c)
 {
     return is_uni_space(c);    /* XXX no locale support yet */
@@ -2036,6 +2050,16 @@ Perl_is_utf8_ascii(pTHX_ const U8 *p)
 }
 
 bool
+Perl_is_utf8_blank(pTHX_ const U8 *p)
+{
+    dVAR;
+
+    PERL_ARGS_ASSERT_IS_UTF8_BLANK;
+
+    return is_utf8_common(p, &PL_utf8_blank, "XPosixBlank");
+}
+
+bool
 Perl_is_utf8_space(pTHX_ const U8 *p)
 {
     dVAR;
@@ -2428,8 +2452,8 @@ Perl_to_utf8_case(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp,
 
     /* Here, there was no mapping defined, which means that the code point maps
      * to itself.  Return the inputs */
-        len = UTF8SKIP(p);
-        Copy(p, ustrp, len, U8);
+    len = UTF8SKIP(p);
+    Copy(p, ustrp, len, U8);
 
     if (lenp)
         *lenp = len;
@@ -3165,24 +3189,6 @@ Perl_swash_fetch(pTHX_ SV *swash, const U8 *ptr, bool do_utf8)
            Copy(ptr, PL_last_swash_key, klen, U8);
     }
 
-    if (UTF8_IS_SUPER(ptr) && ckWARN_d(WARN_NON_UNICODE)) {
-       SV** const bitssvp = hv_fetchs(hv, "BITS", FALSE);
-
-       /* This outputs warnings for binary properties only, assuming that
-        * to_utf8_case() will output any for non-binary.  Also, surrogates
-        * aren't checked for, as that would warn on things like /\p{Gc=Cs}/ */
-
-       if (! bitssvp || SvUV(*bitssvp) == 1) {
-           /* User-defined properties can silently match above-Unicode */
-           SV** const user_defined_svp = hv_fetchs(hv, "USER_DEFINED", FALSE);
-           if (! user_defined_svp || ! SvUV(*user_defined_svp)) {
-               const UV code_point = utf8n_to_uvuni(ptr, UTF8_MAXBYTES, 0, 0);
-               Perl_warner(aTHX_ packWARN(WARN_NON_UNICODE),
-                   "Code point 0x%04"UVXf" is not Unicode, all \\p{} matches fail; all \\P{} matches succeed", code_point);
-           }
-       }
-    }
-
     switch ((int)((slen << 3) / needents)) {
     case 1:
        bit = 1 << (off & 7);
@@ -3805,7 +3811,7 @@ Perl__swash_inversion_hash(pTHX_ SV* const swash)
                                        (U8*) SvPVX(*entryp),
                                        (U8*) SvPVX(*entryp) + SvCUR(*entryp),
                                        0)));
-                       /*DEBUG_U(PerlIO_printf(Perl_debug_log, "Adding %"UVXf" to list for %"UVXf"\n", valid_utf8_to_uvchr((U8*) SvPVX(*entryp), 0), u));*/
+                       /*DEBUG_U(PerlIO_printf(Perl_debug_log, "%s: %d: Adding %"UVXf" to list for %"UVXf"\n", __FILE__, __LINE__, valid_utf8_to_uvchr((U8*) SvPVX(*entryp), 0), u));*/
                    }
                }
            }
@@ -3878,14 +3884,14 @@ Perl__swash_inversion_hash(pTHX_ SV* const swash)
            /* Make sure there is a mapping to itself on the list */
            if (! found_key) {
                av_push(list, newSVuv(val));
-               /*DEBUG_U(PerlIO_printf(Perl_debug_log, "Adding %"UVXf" to list for %"UVXf"\n", val, val));*/
+               /*DEBUG_U(PerlIO_printf(Perl_debug_log, "%s: %d: Adding %"UVXf" to list for %"UVXf"\n", __FILE__, __LINE__, val, val));*/
            }
 
 
            /* Simply add the value to the list */
            if (! found_inverse) {
                av_push(list, newSVuv(inverse));
-               /*DEBUG_U(PerlIO_printf(Perl_debug_log, "Adding %"UVXf" to list for %"UVXf"\n", inverse, val));*/
+               /*DEBUG_U(PerlIO_printf(Perl_debug_log, "%s: %d: Adding %"UVXf" to list for %"UVXf"\n", __FILE__, __LINE__, inverse, val));*/
            }
 
            /* swatch_get() increments the value of val for each element in the
@@ -4066,6 +4072,33 @@ Perl__swash_to_invlist(pTHX_ SV* const swash)
     return invlist;
 }
 
+bool
+Perl__is_swash_user_defined(pTHX_ SV* const swash)
+{
+    SV** ptr = hv_fetchs(MUTABLE_HV(SvRV(swash)), "USER_DEFINED", FALSE);
+
+    PERL_ARGS_ASSERT__IS_SWASH_USER_DEFINED;
+
+    if (! ptr) {
+        return FALSE;
+    }
+    return cBOOL(SvUV(*ptr));
+}
+
+SV*
+Perl__get_swash_invlist(pTHX_ SV* const swash)
+{
+    SV** ptr = hv_fetchs(MUTABLE_HV(SvRV(swash)), "INVLIST", FALSE);
+
+    PERL_ARGS_ASSERT__GET_SWASH_INVLIST;
+
+    if (! ptr) {
+        return NULL;
+    }
+
+    return *ptr;
+}
+
 /*
 =for apidoc uvchr_to_utf8