*/
/*
- * 'What a fix!' said Sam. 'That's the one place in all the lands we've ever
- * heard of that we don't want to see any closer; and that's the one place
- * we're trying to get to! And that's just where we can't get, nohow.'
+ * 'What a fix!' said Sam. 'That's the one place in all the lands we've ever
+ * heard of that we don't want to see any closer; and that's the one place
+ * we're trying to get to! And that's just where we can't get, nohow.'
+ *
+ * [p.603 of _The Lord of the Rings_, IV/I: "The Taming of Sméagol"]
*
* 'Well do I understand your speech,' he answered in the same language;
* 'yet few strangers do so. Why then do you not speak in the Common Tongue,
- * as is the custom in the West, if you wish to be answered?'
+ * as is the custom in the West, if you wish to be answered?'
+ * --Gandalf, addressing Théoden's door wardens
+ *
+ * [p.508 of _The Lord of the Rings_, III/vi: "The King of the Golden Hall"]
*
* ...the travellers perceived that the floor was paved with stones of many
* hues; branching runes and strange devices intertwined beneath their feet.
+ *
+ * [p.512 of _The Lord of the Rings_, III/vi: "The King of the Golden Hall"]
*/
#include "EXTERN.h"
characters in the ASCII range are unmodified, and a zero byte never appears
within non-zero characters.
-=for apidoc A|U8 *|uvuni_to_utf8_flags|U8 *d|UV uv|UV flags
+=cut
+*/
+
+/*
+=for apidoc is_ascii_string
+
+Returns true if first C<len> bytes of the given string are ASCII (i.e. none
+of them even raise the question of UTF-8-ness).
+
+See also is_utf8_string(), is_utf8_string_loclen(), and is_utf8_string_loc().
+
+=cut
+*/
+
+bool
+Perl_is_ascii_string(const U8 *s, STRLEN len)
+{
+ const U8* const send = s + (len ? len : strlen((const char *)s));
+ const U8* x = s;
+
+ PERL_ARGS_ASSERT_IS_ASCII_STRING;
+
+ for (; x < send; ++x) {
+ if (!UTF8_IS_INVARIANT(*x))
+ break;
+ }
+
+ return x == send;
+}
+
+/*
+=for apidoc uvuni_to_utf8_flags
Adds the UTF-8 representation of the Unicode codepoint C<uv> to the end
of the string C<d>; C<d> should be have at least C<UTF8_MAXBYTES+1> free
!(flags & UNICODE_ALLOW_SUPER))
)
Perl_warner(aTHX_ packWARN(WARN_UTF8),
- "Unicode character 0x%04"UVxf" is illegal", uv);
+ "Unicode non-character 0x%04"UVxf" is illegal for interchange", uv);
}
if (UNI_IS_INVARIANT(uv)) {
*d++ = (U8)UTF_TO_NATIVE(uv);
}
/*
-=for apidoc A|STRLEN|is_utf8_char|const U8 *s
+=for apidoc is_utf8_char
Tests if some arbitrary number of bytes begins in a valid UTF-8
-character. Note that an INVARIANT (i.e. ASCII) character is a valid
-UTF-8 character. The actual number of bytes in the UTF-8 character
-will be returned if it is valid, otherwise 0.
+character. Note that an INVARIANT (i.e. ASCII on non-EBCDIC machines)
+character is a valid UTF-8 character. The actual number of bytes in the UTF-8
+character will be returned if it is valid, otherwise 0.
=cut */
STRLEN
-Perl_is_utf8_char(pTHX_ const U8 *s)
+Perl_is_utf8_char(const U8 *s)
{
const STRLEN len = UTF8SKIP(s);
PERL_ARGS_ASSERT_IS_UTF8_CHAR;
- PERL_UNUSED_CONTEXT;
#ifdef IS_UTF8_CHAR
if (IS_UTF8_CHAR_FAST(len))
return IS_UTF8_CHAR(s, len) ? len : 0;
return is_utf8_char_slow(s, len);
}
+
/*
-=for apidoc A|bool|is_utf8_string|const U8 *s|STRLEN len
+=for apidoc is_utf8_string
Returns true if first C<len> bytes of the given string form a valid
UTF-8 string, false otherwise. Note that 'a valid UTF-8 string' does
not mean 'a string that contains code points above 0x7F encoded in UTF-8'
because a valid ASCII string is a valid UTF-8 string.
-See also is_utf8_string_loclen() and is_utf8_string_loc().
+See also is_ascii_string(), is_utf8_string_loclen(), and is_utf8_string_loc().
=cut
*/
bool
-Perl_is_utf8_string(pTHX_ const U8 *s, STRLEN len)
+Perl_is_utf8_string(const U8 *s, STRLEN len)
{
const U8* const send = s + (len ? len : strlen((const char *)s));
const U8* x = s;
PERL_ARGS_ASSERT_IS_UTF8_STRING;
- PERL_UNUSED_CONTEXT;
while (x < send) {
STRLEN c;
/*
Implemented as a macro in utf8.h
-=for apidoc A|bool|is_utf8_string_loc|const U8 *s|STRLEN len|const U8 **ep
+=for apidoc is_utf8_string_loc
Like is_utf8_string() but stores the location of the failure (in the
case of "utf8ness failure") or the location s+len (in the case of
See also is_utf8_string_loclen() and is_utf8_string().
-=for apidoc A|bool|is_utf8_string_loclen|const U8 *s|STRLEN len|const U8 **ep|const STRLEN *el
+=for apidoc is_utf8_string_loclen
Like is_utf8_string() but stores the location of the failure (in the
case of "utf8ness failure") or the location s+len (in the case of
*/
bool
-Perl_is_utf8_string_loclen(pTHX_ const U8 *s, STRLEN len, const U8 **ep, STRLEN *el)
+Perl_is_utf8_string_loclen(const U8 *s, STRLEN len, const U8 **ep, STRLEN *el)
{
const U8* const send = s + (len ? len : strlen((const char *)s));
const U8* x = s;
STRLEN outlen = 0;
PERL_ARGS_ASSERT_IS_UTF8_STRING_LOCLEN;
- PERL_UNUSED_CONTEXT;
while (x < send) {
/* Inline the easy bits of is_utf8_char() here for speed... */
/*
-=for apidoc A|UV|utf8n_to_uvuni|const U8 *s|STRLEN curlen|STRLEN *retlen|U32 flags
+=for apidoc utf8n_to_uvuni
Bottom level UTF-8 decode routine.
Returns the Unicode code point value of the first character in the string C<s>
const UV startbyte = *s;
STRLEN expectlen = 0;
U32 warning = 0;
+ SV* sv;
PERL_ARGS_ASSERT_UTF8N_TO_UVUNI;
-/* This list is a superset of the UTF8_ALLOW_XXX. */
+/* This list is a superset of the UTF8_ALLOW_XXX. BUT it isn't, eg SUPER missing XXX */
#define UTF8_WARN_EMPTY 1
#define UTF8_WARN_CONTINUATION 2
}
if (dowarn) {
- SV* const sv = newSVpvs_flags("Malformed UTF-8 character ", SVs_TEMP);
+ if (warning == UTF8_WARN_FFFF) {
+ sv = newSVpvs_flags("Unicode non-character ", SVs_TEMP);
+ Perl_sv_catpvf(aTHX_ sv, "0x%04"UVxf" is illegal for interchange", uv);
+ }
+ else {
+ sv = newSVpvs_flags("Malformed UTF-8 character ", SVs_TEMP);
+
+ switch (warning) {
+ case 0: /* Intentionally empty. */ break;
+ case UTF8_WARN_EMPTY:
+ sv_catpvs(sv, "(empty string)");
+ break;
+ case UTF8_WARN_CONTINUATION:
+ Perl_sv_catpvf(aTHX_ sv, "(unexpected continuation byte 0x%02"UVxf", with no preceding start byte)", uv);
+ break;
+ case UTF8_WARN_NON_CONTINUATION:
+ if (s == s0)
+ Perl_sv_catpvf(aTHX_ sv, "(unexpected non-continuation byte 0x%02"UVxf", immediately after start byte 0x%02"UVxf")",
+ (UV)s[1], startbyte);
+ else {
+ const int len = (int)(s-s0);
+ Perl_sv_catpvf(aTHX_ sv, "(unexpected non-continuation byte 0x%02"UVxf", %d byte%s after start byte 0x%02"UVxf", expected %d bytes)",
+ (UV)s[1], len, len > 1 ? "s" : "", startbyte, (int)expectlen);
+ }
- switch (warning) {
- case 0: /* Intentionally empty. */ break;
- case UTF8_WARN_EMPTY:
- sv_catpvs(sv, "(empty string)");
- break;
- case UTF8_WARN_CONTINUATION:
- Perl_sv_catpvf(aTHX_ sv, "(unexpected continuation byte 0x%02"UVxf", with no preceding start byte)", uv);
- break;
- case UTF8_WARN_NON_CONTINUATION:
- if (s == s0)
- Perl_sv_catpvf(aTHX_ sv, "(unexpected non-continuation byte 0x%02"UVxf", immediately after start byte 0x%02"UVxf")",
- (UV)s[1], startbyte);
- else {
- const int len = (int)(s-s0);
- Perl_sv_catpvf(aTHX_ sv, "(unexpected non-continuation byte 0x%02"UVxf", %d byte%s after start byte 0x%02"UVxf", expected %d bytes)",
- (UV)s[1], len, len > 1 ? "s" : "", startbyte, (int)expectlen);
+ break;
+ case UTF8_WARN_FE_FF:
+ Perl_sv_catpvf(aTHX_ sv, "(byte 0x%02"UVxf")", uv);
+ break;
+ case UTF8_WARN_SHORT:
+ Perl_sv_catpvf(aTHX_ sv, "(%d byte%s, need %d, after start byte 0x%02"UVxf")",
+ (int)curlen, curlen == 1 ? "" : "s", (int)expectlen, startbyte);
+ expectlen = curlen; /* distance for caller to skip */
+ break;
+ case UTF8_WARN_OVERFLOW:
+ Perl_sv_catpvf(aTHX_ sv, "(overflow at 0x%"UVxf", byte 0x%02x, after start byte 0x%02"UVxf")",
+ ouv, *s, startbyte);
+ break;
+ case UTF8_WARN_SURROGATE:
+ Perl_sv_catpvf(aTHX_ sv, "(UTF-16 surrogate 0x%04"UVxf")", uv);
+ break;
+ case UTF8_WARN_LONG:
+ Perl_sv_catpvf(aTHX_ sv, "(%d byte%s, need %d, after start byte 0x%02"UVxf")",
+ (int)expectlen, expectlen == 1 ? "": "s", UNISKIP(uv), startbyte);
+ break;
+ default:
+ sv_catpvs(sv, "(unknown reason)");
+ break;
}
-
- break;
- case UTF8_WARN_FE_FF:
- Perl_sv_catpvf(aTHX_ sv, "(byte 0x%02"UVxf")", uv);
- break;
- case UTF8_WARN_SHORT:
- Perl_sv_catpvf(aTHX_ sv, "(%d byte%s, need %d, after start byte 0x%02"UVxf")",
- (int)curlen, curlen == 1 ? "" : "s", (int)expectlen, startbyte);
- expectlen = curlen; /* distance for caller to skip */
- break;
- case UTF8_WARN_OVERFLOW:
- Perl_sv_catpvf(aTHX_ sv, "(overflow at 0x%"UVxf", byte 0x%02x, after start byte 0x%02"UVxf")",
- ouv, *s, startbyte);
- break;
- case UTF8_WARN_SURROGATE:
- Perl_sv_catpvf(aTHX_ sv, "(UTF-16 surrogate 0x%04"UVxf")", uv);
- break;
- case UTF8_WARN_LONG:
- Perl_sv_catpvf(aTHX_ sv, "(%d byte%s, need %d, after start byte 0x%02"UVxf")",
- (int)expectlen, expectlen == 1 ? "": "s", UNISKIP(uv), startbyte);
- break;
- case UTF8_WARN_FFFF:
- Perl_sv_catpvf(aTHX_ sv, "(character 0x%04"UVxf")", uv);
- break;
- default:
- sv_catpvs(sv, "(unknown reason)");
- break;
}
if (warning) {
}
/*
-=for apidoc A|UV|utf8_to_uvchr|const U8 *s|STRLEN *retlen
+=for apidoc utf8_to_uvchr
Returns the native character value of the first character in the string C<s>
which is assumed to be in UTF-8 encoding; C<retlen> will be set to the
}
/*
-=for apidoc A|UV|utf8_to_uvuni|const U8 *s|STRLEN *retlen
+=for apidoc utf8_to_uvuni
Returns the Unicode code point of the first character in the string C<s>
which is assumed to be in UTF-8 encoding; C<retlen> will be set to the
length, in bytes, of that character.
-This function should only be used when returned UV is considered
+This function should only be used when the returned UV is considered
an index into the Unicode semantic tables (e.g. swashes).
If C<s> does not point to a well-formed UTF-8 character, zero is
}
/*
-=for apidoc A|STRLEN|utf8_length|const U8 *s|const U8 *e
+=for apidoc utf8_length
Return the length of the UTF-8 char encoded string C<s> in characters.
Stops at C<e> (inclusive). If C<e E<lt> s> or if the scan would end
{
dVAR;
STRLEN len = 0;
- U8 t = 0;
PERL_ARGS_ASSERT_UTF8_LENGTH;
if (e < s)
goto warn_and_return;
while (s < e) {
- t = UTF8SKIP(s);
- if (e - s < t) {
- warn_and_return:
- if (ckWARN_d(WARN_UTF8)) {
- if (PL_op)
- Perl_warner(aTHX_ packWARN(WARN_UTF8),
- "%s in %s", unees, OP_DESC(PL_op));
- else
- Perl_warner(aTHX_ packWARN(WARN_UTF8), unees);
- }
- return len;
- }
- s += t;
+ if (!UTF8_IS_INVARIANT(*s))
+ s += UTF8SKIP(s);
+ else
+ s++;
len++;
}
+ if (e != s) {
+ len--;
+ warn_and_return:
+ if (PL_op)
+ Perl_ck_warner_d(aTHX_ packWARN(WARN_UTF8),
+ "%s in %s", unees, OP_DESC(PL_op));
+ else
+ Perl_ck_warner_d(aTHX_ packWARN(WARN_UTF8), unees);
+ }
+
return len;
}
/*
-=for apidoc A|IV|utf8_distance|const U8 *a|const U8 *b
+=for apidoc utf8_distance
Returns the number of UTF-8 characters between the UTF-8 pointers C<a>
and C<b>.
}
/*
-=for apidoc A|U8 *|utf8_hop|U8 *s|I32 off
+=for apidoc utf8_hop
Return the UTF-8 pointer C<s> displaced by C<off> characters, either
forward or backward.
}
/*
-=for apidoc A|U8 *|utf8_to_bytes|U8 *s|STRLEN *len
+=for apidoc utf8_to_bytes
-Converts a string C<s> of length C<len> from UTF-8 into byte encoding.
+Converts a string C<s> of length C<len> from UTF-8 into native byte encoding.
Unlike C<bytes_to_utf8>, this over-writes the original string, and
updates len to contain the new length.
Returns zero on failure, setting C<len> to -1.
}
/*
-=for apidoc A|U8 *|bytes_from_utf8|const U8 *s|STRLEN *len|bool *is_utf8
+=for apidoc bytes_from_utf8
-Converts a string C<s> of length C<len> from UTF-8 into byte encoding.
+Converts a string C<s> of length C<len> from UTF-8 into native byte encoding.
Unlike C<utf8_to_bytes> but like C<bytes_to_utf8>, returns a pointer to
the newly-created string, and updates C<len> to contain the new
length. Returns the original string if no conversion occurs, C<len>
is unchanged. Do nothing if C<is_utf8> points to 0. Sets C<is_utf8> to
-0 if C<s> is converted or contains all 7bit characters.
+0 if C<s> is converted or consisted entirely of characters that are invariant
+in utf8 (i.e., US-ASCII on non-EBCDIC machines).
=cut
*/
}
/*
-=for apidoc A|U8 *|bytes_to_utf8|const U8 *s|STRLEN *len
+=for apidoc bytes_to_utf8
-Converts a string C<s> of length C<len> from ASCII into UTF-8 encoding.
+Converts a string C<s> of length C<len> from the native encoding into UTF-8.
Returns a pointer to the newly-created string, and sets C<len> to
reflect the new length.
-If you want to convert to UTF-8 from other encodings than ASCII,
+A 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),
see sv_recode_to_utf8().
=cut
PERL_ARGS_ASSERT_UTF16_TO_UTF8;
- if (bytelen == 1 && p[0] == 0) { /* Be understanding. */
- d[0] = 0;
- *newlen = 1;
- return d;
- }
-
if (bytelen & 1)
Perl_croak(aTHX_ "panic: utf16_to_utf8: odd bytelen %"UVuf, (UV)bytelen);
*d++ = (U8)(( uv & 0x3f) | 0x80);
continue;
}
- if (uv >= 0xd800 && uv < 0xdbff) { /* surrogates */
- UV low = (p[0] << 8) + p[1];
- p += 2;
- if (low < 0xdc00 || low >= 0xdfff)
+ if (uv >= 0xd800 && uv <= 0xdbff) { /* surrogates */
+ if (p >= pend) {
Perl_croak(aTHX_ "Malformed UTF-16 surrogate");
- uv = ((uv - 0xd800) << 10) + (low - 0xdc00) + 0x10000;
+ } else {
+ UV low = (p[0] << 8) + p[1];
+ p += 2;
+ if (low < 0xdc00 || low > 0xdfff)
+ Perl_croak(aTHX_ "Malformed UTF-16 surrogate");
+ uv = ((uv - 0xd800) << 10) + (low - 0xdc00) + 0x10000;
+ }
+ } else if (uv >= 0xdc00 && uv <= 0xdfff) {
+ Perl_croak(aTHX_ "Malformed UTF-16 surrogate");
}
if (uv < 0x10000) {
*d++ = (U8)(( uv >> 12) | 0xe0);
PERL_ARGS_ASSERT_UTF16_TO_UTF8_REVERSED;
+ if (bytelen & 1)
+ Perl_croak(aTHX_ "panic: utf16_to_utf8_reversed: odd bytelen %"UVuf,
+ (UV)bytelen);
+
while (s < send) {
const U8 tmp = s[0];
s[0] = s[1];
}
bool
-Perl_is_uni_alnumc(pTHX_ UV c)
-{
- U8 tmpbuf[UTF8_MAXBYTES+1];
- uvchr_to_utf8(tmpbuf, c);
- return is_utf8_alnumc(tmpbuf);
-}
-
-bool
Perl_is_uni_idfirst(pTHX_ UV c)
{
U8 tmpbuf[UTF8_MAXBYTES+1];
}
bool
-Perl_is_uni_alnumc_lc(pTHX_ UV c)
-{
- return is_uni_alnumc(c); /* XXX no locale support yet */
-}
-
-bool
Perl_is_uni_idfirst_lc(pTHX_ UV c)
{
return is_uni_idfirst(c); /* XXX no locale support yet */
}
bool
-Perl_is_utf8_alnumc(pTHX_ const U8 *p)
-{
- dVAR;
-
- PERL_ARGS_ASSERT_IS_UTF8_ALNUMC;
-
- return is_utf8_common(p, &PL_utf8_alnumc, "IsAlnumC");
-}
-
-bool
Perl_is_utf8_idfirst(pTHX_ const U8 *p) /* The naming is historical. */
{
dVAR;
}
bool
+Perl_is_utf8_perl_space(pTHX_ const U8 *p)
+{
+ dVAR;
+
+ PERL_ARGS_ASSERT_IS_UTF8_PERL_SPACE;
+
+ return is_utf8_common(p, &PL_utf8_perl_space, "IsPerlSpace");
+}
+
+bool
+Perl_is_utf8_perl_word(pTHX_ const U8 *p)
+{
+ dVAR;
+
+ PERL_ARGS_ASSERT_IS_UTF8_PERL_WORD;
+
+ return is_utf8_common(p, &PL_utf8_perl_word, "IsPerlWord");
+}
+
+bool
Perl_is_utf8_digit(pTHX_ const U8 *p)
{
dVAR;
}
bool
+Perl_is_utf8_posix_digit(pTHX_ const U8 *p)
+{
+ dVAR;
+
+ PERL_ARGS_ASSERT_IS_UTF8_POSIX_DIGIT;
+
+ return is_utf8_common(p, &PL_utf8_posix_digit, "IsPosixDigit");
+}
+
+bool
Perl_is_utf8_upper(pTHX_ const U8 *p)
{
dVAR;
PERL_ARGS_ASSERT_IS_UTF8_XDIGIT;
- return is_utf8_common(p, &PL_utf8_xdigit, "Isxdigit");
+ return is_utf8_common(p, &PL_utf8_xdigit, "IsXDigit");
}
bool
return is_utf8_common(p, &PL_utf8_mark, "IsM");
}
+bool
+Perl_is_utf8_X_begin(pTHX_ const U8 *p)
+{
+ dVAR;
+
+ PERL_ARGS_ASSERT_IS_UTF8_X_BEGIN;
+
+ return is_utf8_common(p, &PL_utf8_X_begin, "_X_Begin");
+}
+
+bool
+Perl_is_utf8_X_extend(pTHX_ const U8 *p)
+{
+ dVAR;
+
+ PERL_ARGS_ASSERT_IS_UTF8_X_EXTEND;
+
+ return is_utf8_common(p, &PL_utf8_X_extend, "_X_Extend");
+}
+
+bool
+Perl_is_utf8_X_prepend(pTHX_ const U8 *p)
+{
+ dVAR;
+
+ PERL_ARGS_ASSERT_IS_UTF8_X_PREPEND;
+
+ return is_utf8_common(p, &PL_utf8_X_prepend, "GCB=Prepend");
+}
+
+bool
+Perl_is_utf8_X_non_hangul(pTHX_ const U8 *p)
+{
+ dVAR;
+
+ PERL_ARGS_ASSERT_IS_UTF8_X_NON_HANGUL;
+
+ return is_utf8_common(p, &PL_utf8_X_non_hangul, "HST=Not_Applicable");
+}
+
+bool
+Perl_is_utf8_X_L(pTHX_ const U8 *p)
+{
+ dVAR;
+
+ PERL_ARGS_ASSERT_IS_UTF8_X_L;
+
+ return is_utf8_common(p, &PL_utf8_X_L, "GCB=L");
+}
+
+bool
+Perl_is_utf8_X_LV(pTHX_ const U8 *p)
+{
+ dVAR;
+
+ PERL_ARGS_ASSERT_IS_UTF8_X_LV;
+
+ return is_utf8_common(p, &PL_utf8_X_LV, "GCB=LV");
+}
+
+bool
+Perl_is_utf8_X_LVT(pTHX_ const U8 *p)
+{
+ dVAR;
+
+ PERL_ARGS_ASSERT_IS_UTF8_X_LVT;
+
+ return is_utf8_common(p, &PL_utf8_X_LVT, "GCB=LVT");
+}
+
+bool
+Perl_is_utf8_X_T(pTHX_ const U8 *p)
+{
+ dVAR;
+
+ PERL_ARGS_ASSERT_IS_UTF8_X_T;
+
+ return is_utf8_common(p, &PL_utf8_X_T, "GCB=T");
+}
+
+bool
+Perl_is_utf8_X_V(pTHX_ const U8 *p)
+{
+ dVAR;
+
+ PERL_ARGS_ASSERT_IS_UTF8_X_V;
+
+ return is_utf8_common(p, &PL_utf8_X_V, "GCB=V");
+}
+
+bool
+Perl_is_utf8_X_LV_LVT_V(pTHX_ const U8 *p)
+{
+ dVAR;
+
+ PERL_ARGS_ASSERT_IS_UTF8_X_LV_LVT_V;
+
+ return is_utf8_common(p, &PL_utf8_X_LV_LVT_V, "_X_LV_LVT_V");
+}
+
/*
-=for apidoc A|UV|to_utf8_case|U8 *p|U8* ustrp|STRLEN *lenp|SV **swash|char *normal|char *special
+=for apidoc to_utf8_case
The "p" contains the pointer to the UTF-8 string encoding
the character that is being converted.
if (!*swashp) /* load on-demand */
*swashp = swash_init("utf8", normal, &PL_sv_undef, 4, 0);
+ /* This is the beginnings of a skeleton of code to read the info section
+ * that is in all the swashes in case we ever want to do that, so one can
+ * read things whose maps aren't code points, and whose default if missing
+ * is not to the code point itself. This was just to see if it actually
+ * worked. Details on what the possibilities are are in perluniprops.pod
+ HV * const hv = get_hv("utf8::SwashInfo", 0);
+ if (hv) {
+ SV **svp;
+ svp = hv_fetch(hv, (const char*)normal, strlen(normal), FALSE);
+ const char *s;
+
+ HV * const this_hash = SvRV(*svp);
+ svp = hv_fetch(this_hash, "type", strlen("type"), FALSE);
+ s = SvPV_const(*svp, len);
+ }
+ }*/
/* The 0xDF is the only special casing Unicode code point below 0x100. */
if (special && (uv1 == 0xDF || uv1 > 0xFF)) {
/* It might be "special" (sometimes, but not always,
* a multicharacter mapping) */
- HV * const hv = get_hv(special, FALSE);
+ HV * const hv = get_hv(special, 0);
SV **svp;
if (hv &&
}
}
- if (!len) /* Neither: just copy. */
+ 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 (lenp)
}
/*
-=for apidoc A|UV|to_utf8_upper|const U8 *p|U8 *ustrp|STRLEN *lenp
+=for apidoc to_utf8_upper
Convert the UTF-8 encoded character at p to its uppercase version and
store that in UTF-8 in ustrp and its length in bytes in lenp. Note
}
/*
-=for apidoc A|UV|to_utf8_title|const U8 *p|U8 *ustrp|STRLEN *lenp
+=for apidoc to_utf8_title
Convert the UTF-8 encoded character at p to its titlecase version and
store that in UTF-8 in ustrp and its length in bytes in lenp. Note
}
/*
-=for apidoc A|UV|to_utf8_lower|const U8 *p|U8 *ustrp|STRLEN *lenp
+=for apidoc to_utf8_lower
Convert the UTF-8 encoded character at p to its lowercase version and
store that in UTF-8 in ustrp and its length in bytes in lenp. Note
}
/*
-=for apidoc A|UV|to_utf8_fold|const U8 *p|U8 *ustrp|STRLEN *lenp
+=for apidoc to_utf8_fold
Convert the UTF-8 encoded character at p to its foldcase version and
store that in UTF-8 in ustrp and its length in bytes in lenp. Note
PUSHSTACKi(PERLSI_MAGIC);
ENTER;
- SAVEI32(PL_hints);
- PL_hints = 0;
+ SAVEHINTS();
save_re_context();
if (!gv_fetchmeth(stash, "SWASHNEW", 8, -1)) { /* demand load utf8 */
ENTER;
ptr = tmputf8;
}
/* Given a UTF-X encoded char 0xAA..0xYY,0xZZ
- * then the "swatch" is a vec() for al the chars which start
+ * then the "swatch" is a vec() for all the chars which start
* with 0xAA..0xYY
* So the key in the hash (klen) is length of encoded char -1
*/
off = ptr[klen];
if (klen == 0) {
- /* If char in invariant then swatch is for all the invariant chars
+ /* If char is invariant then swatch is for all the invariant chars
* In both UTF-8 and UTF-8-MOD that happens to be UTF_CONTINUATION_MARK
*/
needents = UTF_CONTINUATION_MARK;
}
/*
-=for apidoc A|U8 *|uvchr_to_utf8|U8 *d|UV uv
+=for apidoc uvchr_to_utf8
Adds the UTF-8 representation of the Native codepoint C<uv> to the end
of the string C<d>; C<d> should be have at least C<UTF8_MAXBYTES+1> free
}
/*
-=for apidoc A|UV|utf8n_to_uvchr|U8 *s|STRLEN curlen|STRLEN *retlen|U32
+=for apidoc utf8n_to_uvchr
flags
Returns the native character value of the first character in the string
}
/*
-=for apidoc A|char *|pv_uni_display|SV *dsv|U8 *spv|STRLEN len|STRLEN pvlim|UV flags
+=for apidoc pv_uni_display
Build to the scalar dsv a displayable version of the string spv,
length len, the displayable version being at most pvlim bytes long
PERL_ARGS_ASSERT_PV_UNI_DISPLAY;
- sv_setpvn(dsv, "", 0);
+ sv_setpvs(dsv, "");
SvUTF8_off(dsv);
for (s = (const char *)spv, e = s + len; s < e; s += UTF8SKIP(s)) {
UV u;
}
if (ok) {
const char string = ok;
- sv_catpvn(dsv, "\\", 1);
+ sv_catpvs(dsv, "\\");
sv_catpvn(dsv, &string, 1);
}
}
}
/*
-=for apidoc A|char *|sv_uni_display|SV *dsv|SV *ssv|STRLEN pvlim|UV flags
+=for apidoc sv_uni_display
Build to the scalar dsv a displayable version of the scalar sv,
the displayable version being at most pvlim bytes long
}
/*
-=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
+=for apidoc ibcmp_utf8
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
/* 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);
+ match = (n1 == 0 && n2 == 0 /* Must not match partial char; Bug #72998 */
+ && (f1 == 0 || p1 == f1) && (f2 == 0 || p2 == f2));
if (match) {
if (pe1)
https://perl5.git.perl.org / perl5.git / blobdiff