X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=utf8.c;h=01d3ae7a6d609c453d52597090ba52e174c2d691;hb=235bddc8d16c512a7d89f327f65cee68b1f5848c;hp=500ac4bc4347285c20b6d4cb6c11b48cffbb249b;hpb=d3e7953240b22e0c70f8c91e5ca8c47138b3ac50;p=p5sagit%2Fp5-mst-13.2.git diff --git a/utf8.c b/utf8.c index 500ac4b..01d3ae7 100644 --- a/utf8.c +++ b/utf8.c @@ -24,9 +24,9 @@ #define PERL_IN_UTF8_C #include "perl.h" -/* Unicode support */ +/* +=head1 Unicode Support -/* =for apidoc A|U8 *|uvuni_to_utf8_flags|U8 *d|UV uv|UV flags Adds the UTF8 representation of the Unicode codepoint C to the end @@ -1646,8 +1646,8 @@ Allows length and flags to be passed to low level routine. =cut */ -/* On ASCII machines this is normally a macro but we want a - real function in case XS code wants it +/* On ASCII machines this is normally a macro but we want + a real function in case XS code wants it */ #undef Perl_utf8n_to_uvchr UV @@ -1663,7 +1663,14 @@ Perl_utf8n_to_uvchr(pTHX_ U8 *s, STRLEN curlen, STRLEN *retlen, U32 flags) Build to the scalar dsv a displayable version of the string spv, length len, the displayable version being at most pvlim bytes long (if longer, the rest is truncated and "..." will be appended). -The flags argument is currently unused but available for future extensions. + +The flags argument can have UNI_DISPLAY_ISPRINT set to display +isPRINT()able characters as themselves, UNI_DISPLAY_BACKSLASH +to display the \\[nrfta\\] as the backslashed versions (like '\n') +(UNI_DISPLAY_BACKSLASH is preferred over UNI_DISPLAY_ISPRINT for \\). +UNI_DISPLAY_QQ (and its alias UNI_DISPLAY_REGEX) have both +UNI_DISPLAY_BACKSLASH and UNI_DISPLAY_ISPRINT turned on. + The pointer to the PV of the dsv is returned. =cut */ @@ -1676,12 +1683,39 @@ Perl_pv_uni_display(pTHX_ SV *dsv, U8 *spv, STRLEN len, STRLEN pvlim, UV flags) sv_setpvn(dsv, "", 0); for (s = (char *)spv, e = s + len; s < e; s += UTF8SKIP(s)) { UV u; + bool ok = FALSE; + if (pvlim && SvCUR(dsv) >= pvlim) { truncated++; break; } u = utf8_to_uvchr((U8*)s, 0); - Perl_sv_catpvf(aTHX_ dsv, "\\x{%"UVxf"}", u); + if (u < 256) { + if (!ok && (flags & UNI_DISPLAY_BACKSLASH)) { + switch (u & 0xFF) { + case '\n': + Perl_sv_catpvf(aTHX_ dsv, "\\n"); ok = TRUE; break; + case '\r': + Perl_sv_catpvf(aTHX_ dsv, "\\r"); ok = TRUE; break; + case '\t': + Perl_sv_catpvf(aTHX_ dsv, "\\t"); ok = TRUE; break; + case '\f': + Perl_sv_catpvf(aTHX_ dsv, "\\f"); ok = TRUE; break; + case '\a': + Perl_sv_catpvf(aTHX_ dsv, "\\a"); ok = TRUE; break; + case '\\': + Perl_sv_catpvf(aTHX_ dsv, "\\" ); ok = TRUE; break; + default: break; + } + } + /* isPRINT() is the locale-blind version. */ + if (!ok && (flags & UNI_DISPLAY_ISPRINT) && isPRINT(u & 0xFF)) { + Perl_sv_catpvf(aTHX_ dsv, "%c", u); + ok = TRUE; + } + } + if (!ok) + Perl_sv_catpvf(aTHX_ dsv, "\\x{%"UVxf"}", u); } if (truncated) sv_catpvn(dsv, "...", 3); @@ -1693,9 +1727,11 @@ Perl_pv_uni_display(pTHX_ SV *dsv, U8 *spv, STRLEN len, STRLEN pvlim, UV flags) =for apidoc A|char *|sv_uni_display|SV *dsv|SV *ssv|STRLEN pvlim|UV flags Build to the scalar dsv a displayable version of the scalar sv, -he displayable version being at most pvlim bytes long +the displayable version being at most pvlim bytes long (if longer, the rest is truncated and "..." will be appended). -The flags argument is currently unused but available for future extensions. + +The flags argument is as in pv_uni_display(). + The pointer to the PV of the dsv is returned. =cut */ @@ -1707,12 +1743,24 @@ Perl_sv_uni_display(pTHX_ SV *dsv, SV *ssv, STRLEN pvlim, UV flags) } /* -=for apidoc A|I32|ibcmp_utf8|const char *s1|bool u1|register I32 len1|const char *s2|bool u2|register I32 len2 +=for apidoc A|I32|ibcmp_utf8|const char *s1|char **pe1|register UV l1|bool u1|const char *s2|char **pe2|register UV l2|bool u2 Return true if the strings s1 and s2 differ case-insensitively, false if not (if they are equal case-insensitively). If u1 is true, the string s1 is assumed to be in UTF-8-encoded Unicode. If u2 is true, -the string s2 is assumed to be in UTF-8-encoded Unicode. +the string s2 is assumed to be in UTF-8-encoded Unicode. If u1 or u2 +are false, the respective string is assumed to be in native 8-bit +encoding. + +If the pe1 and pe2 are non-NULL, the scanning pointers will be copied +in there (they will point at the beginning of the I character). +If the pointers behind pe1 or pe2 are non-NULL, they are the end +pointers beyond which scanning will not continue under any +circustances. If the byte lengths l1 and l2 are non-zero, s1+l1 and +s2+l2 will be used as goal end pointers that will also stop the scan, +and which qualify towards defining a successful match: all the scans +that define an explicit length must reach their goal pointers for +a match to succeed). For case-insensitiveness, the "casefolding" of Unicode is used instead of upper/lowercasing both the characters, see @@ -1720,48 +1768,83 @@ http://www.unicode.org/unicode/reports/tr21/ (Case Mappings). =cut */ I32 -Perl_ibcmp_utf8(pTHX_ const char *s1, bool u1, register I32 len1, const char *s2, bool u2, register I32 len2) +Perl_ibcmp_utf8(pTHX_ const char *s1, char **pe1, register UV l1, bool u1, const char *s2, char **pe2, register UV l2, bool u2) { register U8 *p1 = (U8*)s1; register U8 *p2 = (U8*)s2; - register U8 *e1 = p1 + len1; - register U8 *e2 = p2 + len2; - STRLEN l1, l2; - UV c1, c2; - STRLEN foldlen1, foldlen2; + register U8 *e1 = 0, *f1 = 0, *q1 = 0; + register U8 *e2 = 0, *f2 = 0, *q2 = 0; + STRLEN n1 = 0, n2 = 0; U8 foldbuf1[UTF8_MAXLEN_FOLD+1]; U8 foldbuf2[UTF8_MAXLEN_FOLD+1]; + U8 natbuf[1+1]; + STRLEN foldlen1, foldlen2; + bool match; - while (p1 < e1 && p2 < e2) { - if (u1) { - if (p1 + UTF8SKIP(p1) > e1) - break; - c1 = utf8_to_uvchr((U8*)p1, &l1); - } else { - c1 = NATIVE_TO_UNI(*p1); - l1 = 1; + if (pe1) + e1 = *(U8**)pe1; + if (e1 == 0 || (l1 && l1 < e1 - (U8*)s1)) + f1 = (U8*)s1 + l1; + if (pe2) + e2 = *(U8**)pe2; + if (e2 == 0 || (l2 && l2 < e2 - (U8*)s2)) + f2 = (U8*)s2 + l2; + + if ((e1 == 0 && f1 == 0) || (e2 == 0 && f2 == 0) || (f1 == 0 && f2 == 0)) + return 1; /* mismatch; possible infinite loop or false positive */ + + while ((e1 == 0 || p1 < e1) && + (f1 == 0 || p1 < f1) && + (e2 == 0 || p2 < e2) && + (f2 == 0 || p2 < f2)) { + if (n1 == 0) { + if (u1) + to_utf8_fold(p1, foldbuf1, &foldlen1); + else { + natbuf[0] = NATIVE_TO_UNI(*p1); + to_utf8_fold(natbuf, foldbuf1, &foldlen1); + } + q1 = foldbuf1; + n1 = foldlen1; } - if (u2) { - if (p2 + UTF8SKIP(p2) > e2) - break; - c2 = utf8_to_uvchr((U8*)p2, &l2); - } else { - c2 = NATIVE_TO_UNI(*p2); - l2 = 1; + if (n2 == 0) { + if (u2) + to_utf8_fold(p2, foldbuf2, &foldlen2); + else { + natbuf[0] = NATIVE_TO_UNI(*p2); + to_utf8_fold(natbuf, foldbuf2, &foldlen2); + } + q2 = foldbuf2; + n2 = foldlen2; } - if (c1 != c2) { - to_uni_fold(c1, foldbuf1, &foldlen1); - c1 = utf8_to_uvchr(foldbuf1, 0); - - to_uni_fold(c2, foldbuf2, &foldlen2); - c2 = utf8_to_uvchr(foldbuf2, 0); - - if (c1 != c2 || foldlen1 != foldlen2) - return 1; /* mismatch */ + while (n1 && n2) { + if ( UTF8SKIP(q1) != UTF8SKIP(q2) || + (UTF8SKIP(q1) == 1 && *q1 != *q2) || + memNE((char*)q1, (char*)q2, UTF8SKIP(q1)) ) + return 1; /* mismatch */ + n1 -= UTF8SKIP(q1); + q1 += UTF8SKIP(q1); + n2 -= UTF8SKIP(q2); + q2 += UTF8SKIP(q2); } - p1 += l1; - p2 += l2; + if (n1 == 0) + p1 += u1 ? UTF8SKIP(p1) : 1; + if (n2 == 0) + p2 += u2 ? UTF8SKIP(p2) : 1; + } - return p1 == e1 && p2 == e2 ? 0 : 1; /* 0 match, 1 mismatch */ + + /* A match is defined by all the scans that specified + * an explicit length reaching their final goals. */ + match = (f1 == 0 || p1 == f1) && (f2 == 0 || p2 == f2); + + if (match) { + if (pe1) + *pe1 = (char*)p1; + if (pe2) + *pe2 = (char*)p2; + } + + return match ? 0 : 1; /* 0 match, 1 mismatch */ }