*d++ = (U8)(( uv & 0x3f) | 0x80);
return d;
}
-#ifdef HAS_QUAD
+#ifdef UTF8_QUAD_MAX
if (uv < UTF8_QUAD_MAX)
#endif
{
*d++ = (U8)(( uv & 0x3f) | 0x80);
return d;
}
-#ifdef HAS_QUAD
+#ifdef UTF8_QUAD_MAX
{
*d++ = 0xff; /* Can't match U+FFFE! */
*d++ = 0x80; /* 6 Reserved bits */
len = UTF8SKIP(buf);
}
-#ifdef IS_UTF8_CHAR
if (IS_UTF8_CHAR_FAST(len))
return IS_UTF8_CHAR(buf, len) ? len : 0;
-#endif /* #ifdef IS_UTF8_CHAR */
return is_utf8_char_slow(buf, len);
}
* We also should not consume too few bytes, otherwise someone could inject
* things. For example, an input could be deliberately designed to
* overflow, and if this code bailed out immediately upon discovering that,
- * returning to the caller *retlen pointing to the very next byte (one
+ * returning to the caller C<*retlen> pointing to the very next byte (one
* which is actually part of of the overflowing sequence), that could look
* legitimate to the caller, which could discard the initial partial
* sequence and process the rest, inappropriately */
/* Like L</utf8_to_uvchr_buf>(), but should only be called when it is known that
* there are no malformations in the input UTF-8 string C<s>. surrogates,
- * non-character code points, and non-Unicode code points are allowed. A macro
- * in utf8.h is used to normally avoid this function wrapper */
+ * non-character code points, and non-Unicode code points are allowed. */
UV
Perl_valid_utf8_to_uvchr(pTHX_ const U8 *s, STRLEN *retlen)
assert(S_or_s == 'S' || S_or_s == 's');
- if (NATIVE_IS_INVARIANT(converted)) { /* No difference between the two for
+ if (UVCHR_IS_INVARIANT(converted)) { /* No difference between the two for
characters in this range */
*p = (U8) converted;
*lenp = 1;
U8 converted = toLOWER_LATIN1(c);
if (p != NULL) {
- if (NATIVE_IS_INVARIANT(converted)) {
+ if (NATIVE_BYTE_IS_INVARIANT(converted)) {
*p = converted;
*lenp = 1;
}
converted = toLOWER_LATIN1(c);
}
- if (NATIVE_IS_INVARIANT(converted)) {
+ if (UVCHR_IS_INVARIANT(converted)) {
*p = (U8) converted;
*lenp = 1;
}
*lenp = 1;
}
else {
- *ustrp = UTF8_EIGHT_BIT_HI(result);
- *(ustrp + 1) = UTF8_EIGHT_BIT_LO(result);
+ *ustrp = UTF8_EIGHT_BIT_HI((U8) result);
+ *(ustrp + 1) = UTF8_EIGHT_BIT_LO((U8) result);
*lenp = 2;
}
*lenp = 1;
}
else {
- *ustrp = UTF8_EIGHT_BIT_HI(result);
- *(ustrp + 1) = UTF8_EIGHT_BIT_LO(result);
+ *ustrp = UTF8_EIGHT_BIT_HI((U8) result);
+ *(ustrp + 1) = UTF8_EIGHT_BIT_LO((U8) result);
*lenp = 2;
}
*lenp = 1;
}
else {
- *ustrp = UTF8_EIGHT_BIT_HI(result);
- *(ustrp + 1) = UTF8_EIGHT_BIT_LO(result);
+ *ustrp = UTF8_EIGHT_BIT_HI((U8) result);
+ *(ustrp + 1) = UTF8_EIGHT_BIT_LO((U8) result);
*lenp = 2;
}
if (flags & FOLD_FLAGS_LOCALE) {
- /* Special case this character, as what normally gets returned
+ /* Special case these characters, as what normally gets returned
* under locale doesn't work */
if (UTF8SKIP(p) == sizeof(LATIN_CAPITAL_LETTER_SHARP_S_UTF8) - 1
&& memEQ((char *) p, LATIN_CAPITAL_LETTER_SHARP_S_UTF8,
{
goto return_long_s;
}
+ else if (UTF8SKIP(p) == sizeof(LATIN_SMALL_LIGATURE_LONG_S_T) - 1
+ && memEQ((char *) p, LATIN_SMALL_LIGATURE_LONG_S_T_UTF8,
+ sizeof(LATIN_SMALL_LIGATURE_LONG_S_T_UTF8) - 1))
+ {
+ goto return_ligature_st;
+ }
return check_locale_boundary_crossing(p, result, ustrp, lenp);
}
else if (! (flags & FOLD_FLAGS_NOMIX_ASCII)) {
}
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. */
+ * character above the ASCII range, and the result should not
+ * contain an ASCII character. */
UV original; /* To store the first code point of <p> */
/* Crossed, have to return the original */
original = valid_utf8_to_uvchr(p, lenp);
- /* But in this one instance, there is an alternative we can
+ /* But in these instances, there is an alternative we can
* return that is valid */
- if (original == LATIN_CAPITAL_LETTER_SHARP_S) {
+ if (original == LATIN_CAPITAL_LETTER_SHARP_S
+ || original == LATIN_SMALL_LETTER_SHARP_S)
+ {
goto return_long_s;
}
+ else if (original == LATIN_SMALL_LIGATURE_LONG_S_T) {
+ goto return_ligature_st;
+ }
Copy(p, ustrp, *lenp, char);
return original;
}
*lenp = 1;
}
else {
- *ustrp = UTF8_EIGHT_BIT_HI(result);
- *(ustrp + 1) = UTF8_EIGHT_BIT_LO(result);
+ *ustrp = UTF8_EIGHT_BIT_HI((U8) result);
+ *(ustrp + 1) = UTF8_EIGHT_BIT_LO((U8) result);
*lenp = 2;
}
Copy(LATIN_SMALL_LETTER_LONG_S_UTF8 LATIN_SMALL_LETTER_LONG_S_UTF8,
ustrp, *lenp, U8);
return LATIN_SMALL_LETTER_LONG_S;
+
+ return_ligature_st:
+ /* Two folds to 'st' are prohibited by the options; instead we pick one and
+ * have the other one fold to it */
+
+ *lenp = sizeof(LATIN_SMALL_LIGATURE_ST_UTF8) - 1;
+ Copy(LATIN_SMALL_LIGATURE_ST_UTF8, ustrp, *lenp, U8);
+ return LATIN_SMALL_LIGATURE_ST;
}
/* Note:
*max = *min;
/* Non-binary tables have a third entry: what the first element of the
- * range maps to */
+ * range maps to. The map for those currently read here is in hex */
if (wants_value) {
if (isBLANK(*l)) {
++l;
-
- /* The ToLc, etc table mappings are not in hex, and must be
- * corrected by adding the code point to them */
- if (typeto) {
- char *after_strtol = (char *) lend;
- *val = Strtol((char *)l, &after_strtol, 10);
- l = (U8 *) after_strtol;
- }
- else { /* Other tables are in hex, and are the correct result
- without tweaking */
- flags = PERL_SCAN_SILENT_ILLDIGIT
- | PERL_SCAN_DISALLOW_PREFIX
- | PERL_SCAN_SILENT_NON_PORTABLE;
- numlen = lend - l;
- *val = grok_hex((char *)l, &numlen, &flags, NULL);
- if (numlen)
- l += numlen;
- else
- *val = 0;
- }
+ flags = PERL_SCAN_SILENT_ILLDIGIT
+ | PERL_SCAN_DISALLOW_PREFIX
+ | PERL_SCAN_SILENT_NON_PORTABLE;
+ numlen = lend - l;
+ *val = grok_hex((char *)l, &numlen, &flags, NULL);
+ if (numlen)
+ l += numlen;
+ else
+ *val = 0;
}
else {
*val = 0;
PERL_ARGS_ASSERT_FOLDEQ_UTF8_FLAGS;
- /* The algorithm requires that input with the flags on the first line of
- * the assert not be pre-folded. */
assert( ! ((flags & (FOLDEQ_UTF8_NOMIX_ASCII | FOLDEQ_UTF8_LOCALE))
- && (flags & (FOLDEQ_S1_ALREADY_FOLDED | FOLDEQ_S2_ALREADY_FOLDED))));
+ && (flags & (FOLDEQ_S1_ALREADY_FOLDED | FOLDEQ_S2_ALREADY_FOLDED))));
+ /* The algorithm is to trial the folds without regard to the flags on
+ * the first line of the above assert(), and then see if the result
+ * violates them. This means that the inputs can't be pre-folded to a
+ * violating result, hence the assert. This could be changed, with the
+ * addition of extra tests here for the already-folded case, which would
+ * slow it down. That cost is more than any possible gain for when these
+ * flags are specified, as the flags indicate /il or /iaa matching which
+ * is less common than /iu, and I (khw) also believe that real-world /il
+ * and /iaa matches are most likely to involve code points 0-255, and this
+ * function only under rare conditions gets called for 0-255. */
if (pe1) {
e1 = *(U8**)pe1;
return 1;
}
+/* XXX The next four functions should likely be moved to mathoms.c once all
+ * occurrences of them are removed from the core; some cpan-upstream modules
+ * still use them */
+
+U8 *
+Perl_uvuni_to_utf8(pTHX_ U8 *d, UV uv)
+{
+ PERL_ARGS_ASSERT_UVUNI_TO_UTF8;
+
+ return Perl_uvoffuni_to_utf8_flags(aTHX_ d, uv, 0);
+}
+
+UV
+Perl_utf8n_to_uvuni(pTHX_ const U8 *s, STRLEN curlen, STRLEN *retlen, U32 flags)
+{
+ PERL_ARGS_ASSERT_UTF8N_TO_UVUNI;
+
+ return NATIVE_TO_UNI(utf8n_to_uvchr(s, curlen, retlen, flags));
+}
+
+/*
+=for apidoc uvuni_to_utf8_flags
+
+Instead you almost certainly want to use L</uvchr_to_utf8> or
+L</uvchr_to_utf8_flags>>.
+
+This function is a deprecated synonym for L</uvoffuni_to_utf8_flags>,
+which itself, while not deprecated, should be used only in isolated
+circumstances. These functions were useful for code that wanted to handle
+both EBCDIC and ASCII platforms with Unicode properties, but starting in Perl
+v5.20, the distinctions between the platforms have mostly been made invisible
+to most code, so this function is quite unlikely to be what you want.
+
+=cut
+*/
+
+U8 *
+Perl_uvuni_to_utf8_flags(pTHX_ U8 *d, UV uv, UV flags)
+{
+ PERL_ARGS_ASSERT_UVUNI_TO_UTF8_FLAGS;
+
+ return uvoffuni_to_utf8_flags(d, uv, flags);
+}
+
+/*
+=for apidoc utf8n_to_uvuni
+
+Instead use L</utf8_to_uvchr_buf>, or rarely, L</utf8n_to_uvchr>.
+
+This function was useful for code that wanted to handle both EBCDIC and
+ASCII platforms with Unicode properties, but starting in Perl v5.20, the
+distinctions between the platforms have mostly been made invisible to most
+code, so this function is quite unlikely to be what you want. If you do need
+this precise functionality, use instead
+C<L<NATIVE_TO_UNI(utf8_to_uvchr_buf(...))|/utf8_to_uvchr_buf>>
+or C<L<NATIVE_TO_UNI(utf8n_to_uvchr(...))|/utf8n_to_uvchr>>.
+
+=cut
+*/
+
/*
* Local variables:
* c-indentation-style: bsd
https://perl5.git.perl.org / perl5.git / blobdiff