X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=utf8.c;h=6fc4acd2140acebdb4dfc30e5fdbd5bd9b4092c8;hb=36e7a0659715b23ab06e40d482d1dd04ea9043a6;hp=4913b44eb509d96bd36f04544a1e860c4b6ab2bd;hpb=d2dcd0fb0e5b4b6b0e01e4cff08a37dff0d015ce;p=p5sagit%2Fp5-mst-13.2.git diff --git a/utf8.c b/utf8.c index 4913b44..6fc4acd 100644 --- a/utf8.c +++ b/utf8.c @@ -841,7 +841,7 @@ bool Perl_is_uni_alnum(pTHX_ UV c) { U8 tmpbuf[UTF8_MAXLEN+1]; - uvchr_to_utf8(tmpbuf, (UV)c); + uvchr_to_utf8(tmpbuf, c); return is_utf8_alnum(tmpbuf); } @@ -849,7 +849,7 @@ bool Perl_is_uni_alnumc(pTHX_ UV c) { U8 tmpbuf[UTF8_MAXLEN+1]; - uvchr_to_utf8(tmpbuf, (UV)c); + uvchr_to_utf8(tmpbuf, c); return is_utf8_alnumc(tmpbuf); } @@ -857,7 +857,7 @@ bool Perl_is_uni_idfirst(pTHX_ UV c) { U8 tmpbuf[UTF8_MAXLEN+1]; - uvchr_to_utf8(tmpbuf, (UV)c); + uvchr_to_utf8(tmpbuf, c); return is_utf8_idfirst(tmpbuf); } @@ -865,7 +865,7 @@ bool Perl_is_uni_alpha(pTHX_ UV c) { U8 tmpbuf[UTF8_MAXLEN+1]; - uvchr_to_utf8(tmpbuf, (UV)c); + uvchr_to_utf8(tmpbuf, c); return is_utf8_alpha(tmpbuf); } @@ -873,7 +873,7 @@ bool Perl_is_uni_ascii(pTHX_ UV c) { U8 tmpbuf[UTF8_MAXLEN+1]; - uvchr_to_utf8(tmpbuf, (UV)c); + uvchr_to_utf8(tmpbuf, c); return is_utf8_ascii(tmpbuf); } @@ -881,7 +881,7 @@ bool Perl_is_uni_space(pTHX_ UV c) { U8 tmpbuf[UTF8_MAXLEN+1]; - uvchr_to_utf8(tmpbuf, (UV)c); + uvchr_to_utf8(tmpbuf, c); return is_utf8_space(tmpbuf); } @@ -889,7 +889,7 @@ bool Perl_is_uni_digit(pTHX_ UV c) { U8 tmpbuf[UTF8_MAXLEN+1]; - uvchr_to_utf8(tmpbuf, (UV)c); + uvchr_to_utf8(tmpbuf, c); return is_utf8_digit(tmpbuf); } @@ -897,7 +897,7 @@ bool Perl_is_uni_upper(pTHX_ UV c) { U8 tmpbuf[UTF8_MAXLEN+1]; - uvchr_to_utf8(tmpbuf, (UV)c); + uvchr_to_utf8(tmpbuf, c); return is_utf8_upper(tmpbuf); } @@ -905,7 +905,7 @@ bool Perl_is_uni_lower(pTHX_ UV c) { U8 tmpbuf[UTF8_MAXLEN+1]; - uvchr_to_utf8(tmpbuf, (UV)c); + uvchr_to_utf8(tmpbuf, c); return is_utf8_lower(tmpbuf); } @@ -913,7 +913,7 @@ bool Perl_is_uni_cntrl(pTHX_ UV c) { U8 tmpbuf[UTF8_MAXLEN+1]; - uvchr_to_utf8(tmpbuf, (UV)c); + uvchr_to_utf8(tmpbuf, c); return is_utf8_cntrl(tmpbuf); } @@ -921,7 +921,7 @@ bool Perl_is_uni_graph(pTHX_ UV c) { U8 tmpbuf[UTF8_MAXLEN+1]; - uvchr_to_utf8(tmpbuf, (UV)c); + uvchr_to_utf8(tmpbuf, c); return is_utf8_graph(tmpbuf); } @@ -929,7 +929,7 @@ bool Perl_is_uni_print(pTHX_ UV c) { U8 tmpbuf[UTF8_MAXLEN+1]; - uvchr_to_utf8(tmpbuf, (UV)c); + uvchr_to_utf8(tmpbuf, c); return is_utf8_print(tmpbuf); } @@ -937,7 +937,7 @@ bool Perl_is_uni_punct(pTHX_ UV c) { U8 tmpbuf[UTF8_MAXLEN+1]; - uvchr_to_utf8(tmpbuf, (UV)c); + uvchr_to_utf8(tmpbuf, c); return is_utf8_punct(tmpbuf); } @@ -945,7 +945,7 @@ bool Perl_is_uni_xdigit(pTHX_ UV c) { U8 tmpbuf[UTF8_MAXLEN_UCLC+1]; - uvchr_to_utf8(tmpbuf, (UV)c); + uvchr_to_utf8(tmpbuf, c); return is_utf8_xdigit(tmpbuf); } @@ -953,7 +953,7 @@ UV Perl_to_uni_upper(pTHX_ UV c, U8* p, STRLEN *lenp) { U8 tmpbuf[UTF8_MAXLEN_UCLC+1]; - uvchr_to_utf8(tmpbuf, (UV)c); + uvchr_to_utf8(tmpbuf, c); return to_utf8_upper(tmpbuf, p, lenp); } @@ -961,7 +961,7 @@ UV Perl_to_uni_title(pTHX_ UV c, U8* p, STRLEN *lenp) { U8 tmpbuf[UTF8_MAXLEN_UCLC+1]; - uvchr_to_utf8(tmpbuf, (UV)c); + uvchr_to_utf8(tmpbuf, c); return to_utf8_title(tmpbuf, p, lenp); } @@ -969,7 +969,7 @@ UV Perl_to_uni_lower(pTHX_ UV c, U8* p, STRLEN *lenp) { U8 tmpbuf[UTF8_MAXLEN_UCLC+1]; - uvchr_to_utf8(tmpbuf, (UV)c); + uvchr_to_utf8(tmpbuf, c); return to_utf8_lower(tmpbuf, p, lenp); } @@ -977,7 +977,7 @@ UV Perl_to_uni_fold(pTHX_ UV c, U8* p, STRLEN *lenp) { U8 tmpbuf[UTF8_MAXLEN_FOLD+1]; - uvchr_to_utf8(tmpbuf, (UV)c); + uvchr_to_utf8(tmpbuf, c); return to_utf8_fold(tmpbuf, p, lenp); } @@ -1270,97 +1270,109 @@ The "ustrp" is a pointer to the character buffer to put the conversion result to. The "lenp" is a pointer to the length of the result. -The "swash" is a pointer to the swash to use. +The "swashp" is a pointer to the swash to use. -The "normal" is a string like "ToLower" which means the swash -$utf8::ToLower, which is stored in lib/unicore/To/Lower.pl, -and loaded by SWASHGET, using lib/utf8_heavy.pl. +Both the special and normal mappings are stored lib/unicore/To/Foo.pl, +and loaded by SWASHGET, using lib/utf8_heavy.pl. The special (usually, +but not always, a multicharacter mapping), is tried first. -The "special" is a string like "utf8::ToSpecLower", which means -the hash %utf8::ToSpecLower, which is stored in the same file, -lib/unicore/To/Lower.pl, and also loaded by SWASHGET. The access -to the hash is by Perl_to_utf8_case(). +The "special" is a string like "utf8::ToSpecLower", which means the +hash %utf8::ToSpecLower. The access to the hash is through +Perl_to_utf8_case(). -=cut - */ +The "normal" is a string like "ToLower" which means the swash +%utf8::ToLower. + +=cut */ UV Perl_to_utf8_case(pTHX_ U8 *p, U8* ustrp, STRLEN *lenp, SV **swashp, char *normal, char *special) { - UV uv; + UV uv0, uv1; + U8 tmpbuf[UTF8_MAXLEN_FOLD+1]; + STRLEN len = 0; - if (!*swashp) - *swashp = swash_init("utf8", normal, &PL_sv_undef, 4, 0); - uv = swash_fetch(*swashp, p, TRUE); - if (!uv) { + uv0 = utf8_to_uvchr(p, 0); + /* The NATIVE_TO_UNI() and UNI_TO_NATIVE() mappings + * are necessary in EBCDIC, they are redundant no-ops + * in ASCII-ish platforms, and hopefully optimized away. */ + uv1 = NATIVE_TO_UNI(uv0); + uvuni_to_utf8(tmpbuf, uv1); + + if (!*swashp) /* load on-demand */ + *swashp = swash_init("utf8", normal, &PL_sv_undef, 4, 0); + + if (special) { + /* It might be "special" (sometimes, but not always, + * a multicharacter mapping) */ HV *hv; SV *keysv; HE *he; - - uv = utf8_to_uvchr(p, 0); - + SV *val; + if ((hv = get_hv(special, FALSE)) && - (keysv = sv_2mortal(Perl_newSVpvf(aTHX_ "%04"UVXf, uv))) && - (he = hv_fetch_ent(hv, keysv, FALSE, 0))) { - SV *val = HeVAL(he); - STRLEN len; - char *s = SvPV(val, len); - - if (len > 1) { - Copy(s, ustrp, len, U8); + (keysv = sv_2mortal(Perl_newSVpvf(aTHX_ "%04"UVXf, uv1))) && + (he = hv_fetch_ent(hv, keysv, FALSE, 0)) && + (val = HeVAL(he))) { + char *s; + + s = SvPV(val, len); + if (len == 1) + len = uvuni_to_utf8(ustrp, NATIVE_TO_UNI(*(U8*)s)) - ustrp; + else { #ifdef EBCDIC - { - /* If we have EBCDIC we need to remap the - * characters coming in from the "special" - * (usually, but not always multicharacter) - * mapping, since any characters in the low 256 - * are in Unicode code points, not EBCDIC. - * If we either had a bit in the "special" - * mappings indicating "contains lower 256", - * or if we on EBCDIC platforms regenerate the - * lib/unicore/To/Foo.pl, we could do without - * this, but for now, let's do it this way. - * --jhi */ - - U8 tmpbuf[UTF8_MAXLEN_FOLD+1]; - U8 *d = tmpbuf; - U8 *t, *tend; - STRLEN tlen; + /* If we have EBCDIC we need to remap the characters + * since any characters in the low 256 are Unicode + * code points, not EBCDIC. */ + U8 *t = (U8*)s, *tend = t + len, *d; + + d = tmpbuf; + if (SvUTF8(val)) { + STRLEN tlen = 0; - for (t = ustrp, tend = t + len; t < tend; t += tlen) { + while (t < tend) { UV c = utf8_to_uvchr(t, &tlen); - - if (tlen > 0) + if (tlen > 0) { d = uvchr_to_utf8(d, UNI_TO_NATIVE(c)); + t += tlen; + } else break; } - len = d - tmpbuf; - Copy(tmpbuf, ustrp, len, U8); } -#endif - } - else { - U8 c = UNI_TO_NATIVE(*s); - - if (NATIVE_IS_INVARIANT(c)) - ustrp[0] = c; else { - ustrp[0] = UTF8_EIGHT_BIT_HI(c); - ustrp[1] = UTF8_EIGHT_BIT_LO(c); - len = 2; + while (t < tend) { + d = uvchr_to_utf8(d, UNI_TO_NATIVE(*t)); + t++; + } } + len = d - tmpbuf; + Copy(tmpbuf, ustrp, len, U8); +#else + Copy(s, ustrp, len, U8); +#endif } - if (lenp) - *lenp = len; - return utf8_to_uvchr(ustrp, 0); } - uv = NATIVE_TO_UNI(uv); } + + if (!len && *swashp) { + UV uv2 = swash_fetch(*swashp, tmpbuf, TRUE); + + if (uv2) { + /* It was "normal" (a single character mapping). */ + UV uv3 = UNI_TO_NATIVE(uv2); + + len = uvchr_to_utf8(ustrp, uv3) - ustrp; + } + } + + if (!len) /* Neither: just copy. */ + len = uvchr_to_utf8(ustrp, uv0) - ustrp; + if (lenp) - *lenp = UNISKIP(uv); - uvuni_to_utf8(ustrp, uv); - return uv; + *lenp = len; + + return len ? utf8_to_uvchr(ustrp, 0) : 0; } /* @@ -1843,7 +1855,7 @@ Perl_ibcmp_utf8(pTHX_ const char *s1, char **pe1, register UV l1, bool u1, const if (u1) to_utf8_fold(p1, foldbuf1, &foldlen1); else { - natbuf[0] = NATIVE_TO_UNI(*p1); + natbuf[0] = *p1; to_utf8_fold(natbuf, foldbuf1, &foldlen1); } q1 = foldbuf1; @@ -1853,7 +1865,7 @@ Perl_ibcmp_utf8(pTHX_ const char *s1, char **pe1, register UV l1, bool u1, const if (u2) to_utf8_fold(p2, foldbuf2, &foldlen2); else { - natbuf[0] = NATIVE_TO_UNI(*p2); + natbuf[0] = *p2; to_utf8_fold(natbuf, foldbuf2, &foldlen2); } q2 = foldbuf2;