* sequence and process the rest, inappropriately */
/* Zero length strings, if allowed, of necessity are zero */
- if (curlen == 0) {
+ if (UNLIKELY(curlen == 0)) {
if (retlen) {
*retlen = 0;
}
}
/* A continuation character can't start a valid sequence */
- if (UTF8_IS_CONTINUATION(uv)) {
+ if (UNLIKELY(UTF8_IS_CONTINUATION(uv))) {
if (flags & UTF8_ALLOW_CONTINUATION) {
if (retlen) {
*retlen = 1;
send = (U8*) s0 + ((expectlen <= curlen) ? expectlen : curlen);
for (s = s0 + 1; s < send; s++) {
- if (UTF8_IS_CONTINUATION(*s)) {
+ if (LIKELY(UTF8_IS_CONTINUATION(*s))) {
#ifndef EBCDIC /* Can't overflow in EBCDIC */
if (uv & UTF_ACCUMULATION_OVERFLOW_MASK) {
* ones are present. I don't know of any real reason to prefer one over
* the other, except that it seems to me that multiple-byte errors trumps
* errors from a single byte */
- if (unexpected_non_continuation) {
+ if (UNLIKELY(unexpected_non_continuation)) {
if (!(flags & UTF8_ALLOW_NON_CONTINUATION)) {
if (! (flags & UTF8_CHECK_ONLY)) {
if (curlen == 1) {
*retlen = curlen;
}
}
- else if (curlen < expectlen) {
+ else if (UNLIKELY(curlen < expectlen)) {
if (! (flags & UTF8_ALLOW_SHORT)) {
if (! (flags & UTF8_CHECK_ONLY)) {
sv = sv_2mortal(Perl_newSVpvf(aTHX_ "%s (%d byte%s, need %d, after start byte 0x%02x)", malformed_text, (int)curlen, curlen == 1 ? "" : "s", (int)expectlen, *s0));
if ((flags & (UTF8_WARN_FE_FF|UTF8_CHECK_ONLY)) == UTF8_WARN_FE_FF
&& ckWARN_d(WARN_UTF8))
{
+ /* This message is deliberately not of the same syntax as the other
+ * messages for malformations, for backwards compatibility in the
+ * unlikely event that code is relying on its precise earlier text
+ */
sv = sv_2mortal(Perl_newSVpvf(aTHX_ "%s Code point beginning with byte 0x%02X is not Unicode, and not portable", malformed_text, *s0));
pack_warn = packWARN(WARN_UTF8);
}
goto malformed;
}
}
- if (overflowed) {
+ if (UNLIKELY(overflowed)) {
/* If the first byte is FF, it will overflow a 32-bit word. If the
* first byte is FE, it will overflow a signed 32-bit word. The
goto disallowed;
}
}
- else if (UNICODE_IS_NONCHAR(uv)) {
- if ((flags & (UTF8_WARN_NONCHAR|UTF8_CHECK_ONLY)) == UTF8_WARN_NONCHAR
- && ckWARN2_d(WARN_UTF8, WARN_NONCHAR))
- {
- sv = sv_2mortal(Perl_newSVpvf(aTHX_ "Unicode non-character U+%04"UVXf" is illegal for open interchange", uv));
- pack_warn = packWARN2(WARN_UTF8, WARN_NONCHAR);
- }
- if (flags & UTF8_DISALLOW_NONCHAR) {
- goto disallowed;
- }
- }
else if ((uv > PERL_UNICODE_MAX)) {
if ((flags & (UTF8_WARN_SUPER|UTF8_CHECK_ONLY)) == UTF8_WARN_SUPER
&& ckWARN2_d(WARN_UTF8, WARN_NON_UNICODE))
goto disallowed;
}
}
+ else if (UNICODE_IS_NONCHAR(uv)) {
+ if ((flags & (UTF8_WARN_NONCHAR|UTF8_CHECK_ONLY)) == UTF8_WARN_NONCHAR
+ && ckWARN2_d(WARN_UTF8, WARN_NONCHAR))
+ {
+ sv = sv_2mortal(Perl_newSVpvf(aTHX_ "Unicode non-character U+%04"UVXf" is illegal for open interchange", uv));
+ pack_warn = packWARN2(WARN_UTF8, WARN_NONCHAR);
+ }
+ if (flags & UTF8_DISALLOW_NONCHAR) {
+ goto disallowed;
+ }
+ }
if (sv) {
outlier_ret = uv;
{
PERL_ARGS_ASSERT_UTF8_TO_UVCHR;
- return valid_utf8_to_uvchr(s, retlen);
+ return utf8_to_uvchr_buf(s, s + UTF8_MAXBYTES, retlen);
}
/*
}
/* Like L</utf8_to_uvuni_buf>(), but should only be called when it is known that
- * there are no malformations in the input UTF-8 string C<s>. surrogates,
+ * there are no malformations in the input UTF-8 string C<s>. Surrogates,
* non-character code points, and non-Unicode code points are allowed */
UV
}
UV
-Perl__to_uni_fold_flags(pTHX_ UV c, U8* p, STRLEN *lenp, const bool flags)
+Perl__to_uni_fold_flags(pTHX_ UV c, U8* p, STRLEN *lenp, const U8 flags)
{
- /* Not currently externally documented, and subject to change, <flags> is
- * TRUE iff full folding is to be used */
+ /* Not currently externally documented, and subject to change
+ * <flags> bits meanings:
+ * FOLD_FLAGS_FULL iff full folding is to be used;
+ * FOLD_FLAGS_LOCALE iff in locale
+ * FOLD_FLAGS_NOMIX_ASCII iff non-ASCII to ASCII folds are prohibited
+ */
PERL_ARGS_ASSERT__TO_UNI_FOLD_FLAGS;
if (c < 256) {
- return _to_fold_latin1((U8) c, p, lenp, flags);
+ UV result = _to_fold_latin1((U8) c, p, lenp,
+ cBOOL(((flags & FOLD_FLAGS_FULL)
+ /* If ASCII-safe, don't allow full folding,
+ * as that could include SHARP S => ss;
+ * otherwise there is no crossing of
+ * ascii/non-ascii in the latin1 range */
+ && ! (flags & FOLD_FLAGS_NOMIX_ASCII))));
+ /* It is illegal for the fold to cross the 255/256 boundary under
+ * locale; in this case return the original */
+ return (result > 256 && flags & FOLD_FLAGS_LOCALE)
+ ? c
+ : result;
+ }
+
+ /* If no special needs, just use the macro */
+ if ( ! (flags & (FOLD_FLAGS_LOCALE|FOLD_FLAGS_NOMIX_ASCII))) {
+ uvchr_to_utf8(p, c);
+ return CALL_FOLD_CASE(p, p, lenp, flags & FOLD_FLAGS_FULL);
+ }
+ else { /* Otherwise, _to_utf8_fold_flags has the intelligence to deal with
+ the special flags. */
+ U8 utf8_c[UTF8_MAXBYTES + 1];
+ uvchr_to_utf8(utf8_c, c);
+ return _to_utf8_fold_flags(utf8_c, p, lenp, flags, NULL);
}
-
- uvchr_to_utf8(p, c);
- return CALL_FOLD_CASE(p, p, lenp, flags);
}
/* for now these all assume no locale info available for Unicode > 255; and
PERL_ARGS_ASSERT_IS_UTF8_X_PREPEND;
- return is_utf8_common(p, &PL_utf8_X_prepend, "GCB=Prepend");
+ return is_utf8_common(p, &PL_utf8_X_prepend, "_X_GCB_Prepend");
}
bool
PERL_ARGS_ASSERT_IS_UTF8_X_NON_HANGUL;
- return is_utf8_common(p, &PL_utf8_X_non_hangul, "HST=Not_Applicable");
+ return is_utf8_common(p, &PL_utf8_X_non_hangul, "_X_HST_Not_Applicable");
}
bool
PERL_ARGS_ASSERT_IS_UTF8_X_L;
- return is_utf8_common(p, &PL_utf8_X_L, "GCB=L");
+ return is_utf8_common(p, &PL_utf8_X_L, "_X_GCB_L");
}
bool
PERL_ARGS_ASSERT_IS_UTF8_X_LV;
- return is_utf8_common(p, &PL_utf8_X_LV, "GCB=LV");
+ return is_utf8_common(p, &PL_utf8_X_LV, "_X_GCB_LV");
}
bool
PERL_ARGS_ASSERT_IS_UTF8_X_LVT;
- return is_utf8_common(p, &PL_utf8_X_LVT, "GCB=LVT");
+ return is_utf8_common(p, &PL_utf8_X_LVT, "_X_GCB_LVT");
}
bool
PERL_ARGS_ASSERT_IS_UTF8_X_T;
- return is_utf8_common(p, &PL_utf8_X_T, "GCB=T");
+ return is_utf8_common(p, &PL_utf8_X_T, "_X_GCB_T");
}
bool
PERL_ARGS_ASSERT_IS_UTF8_X_V;
- return is_utf8_common(p, &PL_utf8_X_V, "GCB=V");
+ return is_utf8_common(p, &PL_utf8_X_V, "_X_GCB_V");
}
bool
}
if (!len && *swashp) {
- const UV uv2 = swash_fetch(*swashp, tmpbuf, TRUE);
+ const UV uv2 = swash_fetch(*swashp, tmpbuf, TRUE /* => is utf8 */);
if (uv2) {
/* It was "normal" (a single character mapping). */
}
}
- if (!len) /* Neither: just copy. In other words, there was no mapping
- defined, which means that the code point maps to itself */
- len = uvchr_to_utf8(ustrp, uv0) - ustrp;
+ if (len) {
+ if (lenp) {
+ *lenp = len;
+ }
+ return valid_utf8_to_uvchr(ustrp, 0);
+ }
+
+ /* 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);
if (lenp)
*lenp = len;
- return len ? valid_utf8_to_uvchr(ustrp, 0) : 0;
+ return uv0;
+
}
STATIC UV
* POSIX, lowercase is used instead
* bit FOLD_FLAGS_FULL is set iff full case folds are to be used;
* otherwise simple folds
+ * bit FOLD_FLAGS_NOMIX_ASCII is set iff folds of non-ASCII to ASCII are
+ * prohibited
* <tainted_ptr> if non-null, *tainted_ptr will be set TRUE iff locale rules
* were used in the calculation; otherwise unchanged. */
PERL_ARGS_ASSERT__TO_UTF8_FOLD_FLAGS;
+ /* These are mutually exclusive */
+ assert (! ((flags & FOLD_FLAGS_LOCALE) && (flags & FOLD_FLAGS_NOMIX_ASCII)));
+
+ assert(p != ustrp); /* Otherwise overwrites */
+
if (UTF8_IS_INVARIANT(*p)) {
if (flags & FOLD_FLAGS_LOCALE) {
result = toLOWER_LC(*p);
}
else {
return _to_fold_latin1(TWO_BYTE_UTF8_TO_UNI(*p, *(p+1)),
- ustrp, lenp, cBOOL(flags & FOLD_FLAGS_FULL));
+ ustrp, lenp,
+ cBOOL((flags & FOLD_FLAGS_FULL
+ /* If ASCII safe, don't allow full
+ * folding, as that could include SHARP
+ * S => ss; otherwise there is no
+ * crossing of ascii/non-ascii in the
+ * latin1 range */
+ && ! (flags & FOLD_FLAGS_NOMIX_ASCII))));
}
}
else { /* utf8, ord above 255 */
- result = CALL_FOLD_CASE(p, ustrp, lenp, flags);
+ result = CALL_FOLD_CASE(p, ustrp, lenp, flags & FOLD_FLAGS_FULL);
if ((flags & FOLD_FLAGS_LOCALE)) {
- result = check_locale_boundary_crossing(p, result, ustrp, lenp);
+ return check_locale_boundary_crossing(p, result, ustrp, lenp);
+ }
+ else if (! (flags & FOLD_FLAGS_NOMIX_ASCII)) {
+ return result;
}
+ else {
+ /* This is called when changing the case of a utf8-encoded
+ * character above the Latin1 range, and the result should not
+ * contain an ASCII character. */
+
+ UV original; /* To store the first code point of <p> */
+
+ /* Look at every character in the result; if any cross the
+ * boundary, the whole thing is disallowed */
+ U8* s = ustrp;
+ U8* e = ustrp + *lenp;
+ while (s < e) {
+ if (isASCII(*s)) {
+ /* Crossed, have to return the original */
+ original = valid_utf8_to_uvchr(p, lenp);
+ Copy(p, ustrp, *lenp, char);
+ return original;
+ }
+ s += UTF8SKIP(s);
+ }
- return result;
+ /* Here, no characters crossed, result is ok as-is */
+ return result;
+ }
}
/* Here, used locale rules. Convert back to utf8 */
* Local variables:
* c-indentation-style: bsd
* c-basic-offset: 4
- * indent-tabs-mode: t
+ * indent-tabs-mode: nil
* End:
*
- * ex: set ts=8 sts=4 sw=4 noet:
+ * ex: set ts=8 sts=4 sw=4 et:
*/
https://perl5.git.perl.org / perl5.git / blobdiff