is, if they are invariant. On ASCII-ish machines, only ASCII characters
fit this definition, hence the function's name.
-If C<len> is 0, it will be calculated using C<strlen(s)>.
+If C<len> is 0, it will be calculated using C<strlen(s)>, (which means if you
+use this option, that C<s> can't have embedded C<NUL> characters and has to
+have a terminating C<NUL> byte).
See also L</is_utf8_string>(), L</is_utf8_string_loclen>(), and L</is_utf8_string_loc>().
=for apidoc uvchr_to_utf8
Adds the UTF-8 representation of the native code point C<uv> to the end
-of the string C<d>; C<d> should have at least C<UTF8_MAXBYTES+1> free
-bytes available. The return value is the pointer to the byte after the
-end of the new character. In other words,
+of the string C<d>; C<d> should have at least C<UNISKIP(uv)+1> (up to
+C<UTF8_MAXBYTES+1>) free bytes available. The return value is the pointer to
+the byte after the end of the new character. In other words,
d = uvchr_to_utf8(d, uv);
=for apidoc uvchr_to_utf8_flags
Adds the UTF-8 representation of the native code point C<uv> to the end
-of the string C<d>; C<d> should have at least C<UTF8_MAXBYTES+1> free
-bytes available. The return value is the pointer to the byte after the
-end of the new character. In other words,
+of the string C<d>; C<d> should have at least C<UNISKIP(uv)+1> (up to
+C<UTF8_MAXBYTES+1>) free bytes available. The return value is the pointer to
+the byte after the end of the new character. In other words,
d = uvchr_to_utf8_flags(d, uv, flags);
}
/*
-
-Tests if the first C<len> bytes of string C<s> form a valid UTF-8
-character. Note that an INVARIANT (i.e. ASCII on non-EBCDIC) character is a
-valid UTF-8 character. The number of bytes in the UTF-8 character
-will be returned if it is valid, otherwise 0.
-
-This is the "slow" version as opposed to the "fast" version which is
-the "unrolled" IS_UTF8_CHAR(). E.g. for t/uni/class.t the speed
-difference is a factor of 2 to 3. For lengths (UTF8SKIP(s)) of four
-or less you should use the IS_UTF8_CHAR(), for lengths of five or more
-you should use the _slow(). In practice this means that the _slow()
-will be used very rarely, since the maximum Unicode code point (as of
-Unicode 4.1) is U+10FFFF, which encodes in UTF-8 to four bytes. Only
-the "Perl extended UTF-8" (e.g, the infamous 'v-strings') will encode into
-five bytes or more.
-
-=cut */
-PERL_STATIC_INLINE STRLEN
-S_is_utf8_char_slow(const U8 *s, const STRLEN len)
-{
- dTHX; /* The function called below requires thread context */
-
- STRLEN actual_len;
-
- PERL_ARGS_ASSERT_IS_UTF8_CHAR_SLOW;
-
- utf8n_to_uvchr(s, len, &actual_len, UTF8_CHECK_ONLY);
-
- return (actual_len == (STRLEN) -1) ? 0 : actual_len;
-}
-
-/*
=for apidoc is_utf8_char_buf
-Returns the number of bytes that comprise the first UTF-8 encoded character in
-buffer C<buf>. C<buf_end> should point to one position beyond the end of the
-buffer. 0 is returned if C<buf> does not point to a complete, valid UTF-8
-encoded character.
-
-Note that an INVARIANT character (i.e. ASCII on non-EBCDIC
-machines) is a valid UTF-8 character.
+This is identical to the macro L</isUTF8_CHAR>.
=cut */
Perl_is_utf8_char_buf(const U8 *buf, const U8* buf_end)
{
- STRLEN len;
-
PERL_ARGS_ASSERT_IS_UTF8_CHAR_BUF;
- if (buf_end <= buf) {
- return 0;
- }
-
- len = buf_end - buf;
- if (len > UTF8SKIP(buf)) {
- len = UTF8SKIP(buf);
- }
-
- if (IS_UTF8_CHAR_FAST(len))
- return IS_UTF8_CHAR(buf, len) ? len : 0;
- return is_utf8_char_slow(buf, len);
+ return isUTF8_CHAR(buf, buf_end);
}
/*
PERL_ARGS_ASSERT_IS_UTF8_CHAR;
/* Assumes we have enough space, which is why this is deprecated */
- return is_utf8_char_buf(s, s + UTF8SKIP(s));
+ return isUTF8_CHAR(s, s + UTF8SKIP(s));
}
Returns true if the first C<len> bytes of string C<s> form a valid
UTF-8 string, false otherwise. If C<len> is 0, it will be calculated
-using C<strlen(s)> (which means if you use this option, that C<s> has to have a
-terminating NUL byte). Note that all characters being ASCII constitute 'a
-valid UTF-8 string'.
+using C<strlen(s)> (which means if you use this option, that C<s> can't have
+embedded C<NUL> characters and has to have a terminating C<NUL> byte). Note
+that all characters being ASCII constitute 'a valid UTF-8 string'.
See also L</is_ascii_string>(), L</is_utf8_string_loclen>(), and L</is_utf8_string_loc>().
PERL_ARGS_ASSERT_IS_UTF8_STRING;
while (x < send) {
- /* Inline the easy bits of is_utf8_char() here for speed... */
- if (UTF8_IS_INVARIANT(*x)) {
- x++;
- }
- else {
- /* ... and call is_utf8_char() only if really needed. */
- const STRLEN c = UTF8SKIP(x);
- const U8* const next_char_ptr = x + c;
-
- if (next_char_ptr > send) {
- return FALSE;
- }
-
- if (IS_UTF8_CHAR_FAST(c)) {
- if (!IS_UTF8_CHAR(x, c))
- return FALSE;
- }
- else if (! is_utf8_char_slow(x, c)) {
- return FALSE;
- }
- x = next_char_ptr;
- }
+ STRLEN len = isUTF8_CHAR(x, send);
+ if (UNLIKELY(! len)) {
+ return FALSE;
+ }
+ x += len;
}
return TRUE;
{
const U8* const send = s + (len ? len : strlen((const char *)s));
const U8* x = s;
- STRLEN c;
STRLEN outlen = 0;
PERL_ARGS_ASSERT_IS_UTF8_STRING_LOCLEN;
while (x < send) {
- const U8* next_char_ptr;
-
- /* Inline the easy bits of is_utf8_char() here for speed... */
- if (UTF8_IS_INVARIANT(*x))
- next_char_ptr = x + 1;
- else {
- /* ... and call is_utf8_char() only if really needed. */
- c = UTF8SKIP(x);
- next_char_ptr = c + x;
- if (next_char_ptr > send) {
- goto out;
- }
- if (IS_UTF8_CHAR_FAST(c)) {
- if (!IS_UTF8_CHAR(x, c))
- c = 0;
- } else
- c = is_utf8_char_slow(x, c);
- if (!c)
- goto out;
- }
- x = next_char_ptr;
- outlen++;
+ STRLEN len = isUTF8_CHAR(x, send);
+ if (UNLIKELY(! len)) {
+ goto out;
+ }
+ x += len;
+ outlen++;
}
out:
the caller will raise a warning, and this function will silently just set
C<retlen> to C<-1> (cast to C<STRLEN>) and return zero.
-Note that this API requires disambiguation between successful decoding a NUL
+Note that this API requires disambiguation between successful decoding a C<NUL>
character, and an error return (unless the UTF8_CHECK_ONLY flag is set), as
in both cases, 0 is returned. To disambiguate, upon a zero return, see if the
-first byte of C<s> is 0 as well. If so, the input was a NUL; if not, the input
-had an error.
+first byte of C<s> is 0 as well. If so, the input was a C<NUL>; if not, the
+input had an error.
Certain code points are considered problematic. These are Unicode surrogates,
Unicode non-characters, and code points above the Unicode maximum of 0x10FFFF.
Returns a pointer to the newly-created string, and sets C<len> to
reflect the new length in bytes.
-A NUL character will be written after the end of the string.
+A C<NUL> character will be written after the end of the string.
If you want to convert to UTF-8 from encodings other than
the native (Latin1 or EBCDIC),
}
UV
-Perl__to_uni_fold_flags(pTHX_ UV c, U8* p, STRLEN *lenp, const U8 flags)
+Perl__to_uni_fold_flags(pTHX_ UV c, U8* p, STRLEN *lenp, U8 flags)
{
/* 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_LOCALE is set iff the rules from the current underlying
+ * locale are to be used.
* FOLD_FLAGS_NOMIX_ASCII iff non-ASCII to ASCII folds are prohibited
*/
PERL_ARGS_ASSERT__TO_UNI_FOLD_FLAGS;
+ /* Tread a UTF-8 locale as not being in locale at all */
+ if (IN_UTF8_CTYPE_LOCALE) {
+ flags &= ~FOLD_FLAGS_LOCALE;
+ }
+
if (c < 256) {
UV result = _to_fold_latin1((U8) c, p, lenp,
- flags & (FOLD_FLAGS_FULL | FOLD_FLAGS_NOMIX_ASCII));
+ flags & (FOLD_FLAGS_FULL | 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)
* as far as there being enough bytes available in it to accommodate the
* character without reading beyond the end, and pass that number on to the
* validating routine */
- if (! is_utf8_char_buf(p, p + UTF8SKIP(p))) {
+ if (! isUTF8_CHAR(p, p + UTF8SKIP(p))) {
if (ckWARN_d(WARN_UTF8)) {
Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED,WARN_UTF8),
"Passing malformed UTF-8 to \"%s\" is deprecated", swashname);
S_check_locale_boundary_crossing(pTHX_ const U8* const p, const UV result, U8* const ustrp, STRLEN *lenp)
{
/* This is called when changing the case of a utf8-encoded character above
- * the Latin1 range, and the operation is in locale. If the result
- * contains a character that crosses the 255/256 boundary, disallow the
- * change, and return the original code point. See L<perlfunc/lc> for why;
+ * the Latin1 range, and the operation is in a non-UTF-8 locale. If the
+ * result contains a character that crosses the 255/256 boundary, disallow
+ * the change, and return the original code point. See L<perlfunc/lc> for
+ * why;
*
* p points to the original string whose case was changed; assumed
* by this routine to be well-formed
=cut */
/* Not currently externally documented, and subject to change:
- * <flags> is set iff locale semantics are to be used for code points < 256 */
+ * <flags> is set iff iff the rules from the current underlying locale are to
+ * be used. */
UV
-Perl__to_utf8_upper_flags(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, const bool flags)
+Perl__to_utf8_upper_flags(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, bool flags)
{
dVAR;
PERL_ARGS_ASSERT__TO_UTF8_UPPER_FLAGS;
+ if (flags && IN_UTF8_CTYPE_LOCALE) {
+ flags = FALSE;
+ }
+
if (UTF8_IS_INVARIANT(*p)) {
if (flags) {
result = toUPPER_LC(*p);
*(ustrp + 1) = UTF8_EIGHT_BIT_LO((U8) result);
*lenp = 2;
}
+
return result;
}
=cut */
/* Not currently externally documented, and subject to change:
- * <flags> is set iff locale semantics are to be used for code points < 256
- * Since titlecase is not defined in POSIX, uppercase is used instead
- * for these/
+ * <flags> is set iff the rules from the current underlying locale are to be
+ * used. Since titlecase is not defined in POSIX, for other than a
+ * UTF-8 locale, uppercase is used instead for code points < 256.
*/
UV
-Perl__to_utf8_title_flags(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, const bool flags)
+Perl__to_utf8_title_flags(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, bool flags)
{
dVAR;
PERL_ARGS_ASSERT__TO_UTF8_TITLE_FLAGS;
+ if (flags && IN_UTF8_CTYPE_LOCALE) {
+ flags = FALSE;
+ }
+
if (UTF8_IS_INVARIANT(*p)) {
if (flags) {
result = toUPPER_LC(*p);
=cut */
/* Not currently externally documented, and subject to change:
- * <flags> is set iff locale semantics are to be used for code points < 256 */
+ * <flags> is set iff iff the rules from the current underlying locale are to
+ * be used.
+ */
UV
-Perl__to_utf8_lower_flags(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, const bool flags)
+Perl__to_utf8_lower_flags(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, bool flags)
{
UV result;
PERL_ARGS_ASSERT__TO_UTF8_LOWER_FLAGS;
+ if (flags && IN_UTF8_CTYPE_LOCALE) {
+ flags = FALSE;
+ }
+
if (UTF8_IS_INVARIANT(*p)) {
if (flags) {
result = toLOWER_LC(*p);
/* Not currently externally documented, and subject to change,
* in <flags>
- * bit FOLD_FLAGS_LOCALE is set iff locale semantics are to be used for code
- * points < 256. Since foldcase is not defined in
- * POSIX, lowercase is used instead
+ * bit FOLD_FLAGS_LOCALE is set iff the rules from the current underlying
+ * locale are to be used.
* 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
assert(p != ustrp); /* Otherwise overwrites */
+ if (flags & FOLD_FLAGS_LOCALE && IN_UTF8_CTYPE_LOCALE) {
+ flags &= ~FOLD_FLAGS_LOCALE;
+ }
+
if (UTF8_IS_INVARIANT(*p)) {
if (flags & FOLD_FLAGS_LOCALE) {
result = toFOLD_LC(*p);
HV *const hv = MUTABLE_HV(SvRV(swash));
U32 klen;
U32 off;
- STRLEN slen;
+ STRLEN slen = 0;
STRLEN needents;
const U8 *tmps = NULL;
- U32 bit;
SV *swatch;
const U8 c = *ptr;
switch ((int)((slen << 3) / needents)) {
case 1:
- bit = 1 << (off & 7);
- off >>= 3;
- return (tmps[off] & bit) != 0;
+ return ((UV) tmps[off >> 3] & (1 << (off & 7))) != 0;
case 8:
- return tmps[off];
+ return ((UV) tmps[off]);
case 16:
off <<= 1;
- return (tmps[off] << 8) + tmps[off + 1] ;
+ return
+ ((UV) tmps[off ] << 8) +
+ ((UV) tmps[off + 1]);
case 32:
off <<= 2;
- return (tmps[off] << 24) + (tmps[off+1] << 16) + (tmps[off+2] << 8) + tmps[off + 3] ;
+ return
+ ((UV) tmps[off ] << 24) +
+ ((UV) tmps[off + 1] << 16) +
+ ((UV) tmps[off + 2] << 8) +
+ ((UV) tmps[off + 3]);
}
Perl_croak(aTHX_ "panic: swash_fetch got swatch of unexpected bit width, "
"slen=%"UVuf", needents=%"UVuf, (UV)slen, (UV)needents);
/* nl points to the next \n in the scan */
U8* const nl = (U8*)memchr(l, '\n', lend - l);
+ PERL_ARGS_ASSERT_SWASH_SCAN_LIST_LINE;
+
/* Get the first number on the line: the range minimum */
numlen = lend - l;
*min = grok_hex((char *)l, &numlen, &flags, NULL);
+ *max = *min; /* So can never return without setting max */
if (numlen) /* If found a hex number, position past it */
l += numlen;
else if (nl) { /* Else, go handle next line, if any */
}
else { /* Nothing following range min, should be single element with no
mapping expected */
- *max = *min;
if (wants_value) {
*val = 0;
if (typeto) {
lend = l + lcur;
while (l < lend) {
UV min, max, val, upper;
- l = S_swash_scan_list_line(aTHX_ l, lend, &min, &max, &val,
- cBOOL(octets), typestr);
+ l = swash_scan_list_line(l, lend, &min, &max, &val,
+ cBOOL(octets), typestr);
if (l > lend) {
break;
}
while ((from_list = (AV *) hv_iternextsv(specials_inverse,
&char_to, &to_len)))
{
- if (av_len(from_list) > 0) {
+ if (av_tindex(from_list) > 0) {
SSize_t i;
/* We iterate over all combinations of i,j to place each code
* point on each list */
- for (i = 0; i <= av_len(from_list); i++) {
+ for (i = 0; i <= av_tindex(from_list); i++) {
SSize_t j;
AV* i_list = newAV();
SV** entryp = av_fetch(from_list, i, FALSE);
}
/* For DEBUG_U: UV u = valid_utf8_to_uvchr((U8*) SvPVX(*entryp), 0);*/
- for (j = 0; j <= av_len(from_list); j++) {
+ for (j = 0; j <= av_tindex(from_list); j++) {
entryp = av_fetch(from_list, j, FALSE);
if (entryp == NULL) {
Perl_croak(aTHX_ "panic: av_fetch() unexpectedly failed");
while (l < lend) {
UV min, max, val;
UV inverse;
- l = S_swash_scan_list_line(aTHX_ l, lend, &min, &max, &val,
- cBOOL(octets), typestr);
+ l = swash_scan_list_line(l, lend, &min, &max, &val,
+ cBOOL(octets), typestr);
if (l > lend) {
break;
}
/* Look through list to see if this inverse mapping already is
* listed, or if there is a mapping to itself already */
- for (i = 0; i <= av_len(list); i++) {
+ for (i = 0; i <= av_tindex(list); i++) {
SV** entryp = av_fetch(list, i, FALSE);
SV* entry;
if (entryp == NULL) {
/* The first number is a count of the rest */
l++;
elements = Strtoul((char *)l, &after_strtol, 10);
- l = (U8 *) after_strtol;
+ if (elements == 0) {
+ invlist = _new_invlist(0);
+ }
+ else {
+ l = (U8 *) after_strtol;
- /* Get the 0th element, which is needed to setup the inversion list */
- element0 = (UV) Strtoul((char *)l, &after_strtol, 10);
- l = (U8 *) after_strtol;
- invlist = _setup_canned_invlist(elements, element0, &other_elements_ptr);
- elements--;
+ /* Get the 0th element, which is needed to setup the inversion list */
+ element0 = (UV) Strtoul((char *)l, &after_strtol, 10);
+ l = (U8 *) after_strtol;
+ invlist = _setup_canned_invlist(elements, element0, &other_elements_ptr);
+ elements--;
- /* Then just populate the rest of the input */
- while (elements-- > 0) {
- if (l > lend) {
- Perl_croak(aTHX_ "panic: Expecting %"UVuf" more elements than available", elements);
+ /* Then just populate the rest of the input */
+ while (elements-- > 0) {
+ if (l > lend) {
+ Perl_croak(aTHX_ "panic: Expecting %"UVuf" more elements than available", elements);
+ }
+ *other_elements_ptr++ = (UV) Strtoul((char *)l, &after_strtol, 10);
+ l = (U8 *) after_strtol;
}
- *other_elements_ptr++ = (UV) Strtoul((char *)l, &after_strtol, 10);
- l = (U8 *) after_strtol;
}
}
else {
UV start, end;
UV val; /* Not used by this function */
- l = S_swash_scan_list_line(aTHX_ l, lend, &start, &end, &val,
- cBOOL(octets), typestr);
+ l = swash_scan_list_line(l, lend, &start, &end, &val,
+ cBOOL(octets), typestr);
if (l > lend) {
break;
* 0 for as-documented above
* FOLDEQ_UTF8_NOMIX_ASCII meaning that if a non-ASCII character folds to an
ASCII one, to not match
- * FOLDEQ_UTF8_LOCALE meaning that locale rules are to be used for code
- * points below 256; unicode rules for above 255; and
- * folds that cross those boundaries are disallowed,
- * like the NOMIX_ASCII option
- * FOLDEQ_S1_ALREADY_FOLDED s1 has already been folded before calling this
- * routine. This allows that step to be skipped.
- * FOLDEQ_S2_ALREADY_FOLDED Similarly.
+ * FOLDEQ_LOCALE is set iff the rules from the current underlying
+ * locale are to be used.
+ * FOLDEQ_S1_ALREADY_FOLDED s1 has already been folded before calling this
+ * routine. This allows that step to be skipped.
+ * FOLDEQ_S2_ALREADY_FOLDED Similarly.
*/
I32
Perl_foldEQ_utf8_flags(pTHX_ const char *s1, char **pe1, UV l1, bool u1, const char *s2, char **pe2, UV l2, bool u2, U32 flags)
PERL_ARGS_ASSERT_FOLDEQ_UTF8_FLAGS;
- assert( ! ((flags & (FOLDEQ_UTF8_NOMIX_ASCII | FOLDEQ_UTF8_LOCALE))
+ assert( ! ((flags & (FOLDEQ_UTF8_NOMIX_ASCII | FOLDEQ_LOCALE))
&& (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
* 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 (IN_UTF8_CTYPE_LOCALE) {
+ flags &= ~FOLDEQ_LOCALE;
+ }
+
if (pe1) {
e1 = *(U8**)pe1;
}
/* If in locale matching, we use two sets of rules, depending
* on if the code point is above or below 255. Here, we test
* for and handle locale rules */
- if ((flags & FOLDEQ_UTF8_LOCALE)
+ if ((flags & FOLDEQ_LOCALE)
&& (! u1 || ! UTF8_IS_ABOVE_LATIN1(*p1)))
{
/* There is no mixing of code points above and below 255. */
n2 = UTF8SKIP(f2);
}
else {
- if ((flags & FOLDEQ_UTF8_LOCALE)
+ if ((flags & FOLDEQ_LOCALE)
&& (! u2 || ! UTF8_IS_ABOVE_LATIN1(*p2)))
{
/* Here, the next char in s2 is < 256. We've already
return Perl_uvoffuni_to_utf8_flags(aTHX_ d, uv, 0);
}
+/*
+=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
+*/
+
UV
Perl_utf8n_to_uvuni(pTHX_ const U8 *s, STRLEN curlen, STRLEN *retlen, U32 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
* c-basic-offset: 4
https://perl5.git.perl.org / perl5.git / blobdiff