=cut
*/
+/* helper for Perl__force_out_malformed_utf8_message(). Like
+ * SAVECOMPILEWARNINGS(), but works with PL_curcop rather than
+ * PL_compiling */
+
+static void
+S_restore_cop_warnings(pTHX_ void *p)
+{
+ if (!specialWARN(PL_curcop->cop_warnings))
+ PerlMemShared_free(PL_curcop->cop_warnings);
+ PL_curcop->cop_warnings = (STRLEN*)p;
+}
+
+
void
Perl__force_out_malformed_utf8_message(pTHX_
const U8 *const p, /* First byte in UTF-8 sequence */
PL_dowarn = G_WARN_ALL_ON|G_WARN_ON;
if (PL_curcop) {
+ /* this is like SAVECOMPILEWARNINGS() except with PL_curcop rather
+ * than PL_compiling */
+ SAVEDESTRUCTOR_X(S_restore_cop_warnings,
+ (void*)PL_curcop->cop_warnings);
PL_curcop->cop_warnings = pWARN_ALL;
}
=for apidoc uvoffuni_to_utf8_flags
THIS FUNCTION SHOULD BE USED IN ONLY VERY SPECIALIZED CIRCUMSTANCES.
-Instead, B<Almost all code should use L</uvchr_to_utf8> or
-L</uvchr_to_utf8_flags>>.
+Instead, B<Almost all code should use L<perlapi/uvchr_to_utf8> or
+L<perlapi/uvchr_to_utf8_flags>>.
This function is like them, but the input is a strict Unicode
(as opposed to native) code point. Only in very rare circumstances should code
not be using the native code point.
-For details, see the description for L</uvchr_to_utf8_flags>.
+For details, see the description for L<perlapi/uvchr_to_utf8_flags>.
=cut
*/
#undef FF_OVERLONG_PREFIX
STRLEN
-Perl__is_utf8_char_helper(const U8 * const s, const U8 * e, const U32 flags)
+Perl_is_utf8_char_helper(const U8 * const s, const U8 * e, const U32 flags)
{
STRLEN len;
const U8 *x;
*
*/
- PERL_ARGS_ASSERT__IS_UTF8_CHAR_HELPER;
+ PERL_ARGS_ASSERT_IS_UTF8_CHAR_HELPER;
assert(0 == (flags & ~(UTF8_DISALLOW_ILLEGAL_INTERCHANGE
|UTF8_DISALLOW_PERL_EXTENDED)));
=for apidoc utf8n_to_uvchr
THIS FUNCTION SHOULD BE USED IN ONLY VERY SPECIALIZED CIRCUMSTANCES.
-Most code should use L</utf8_to_uvchr_buf>() rather than call this directly.
+Most code should use L</utf8_to_uvchr_buf>() rather than call this
+directly.
Bottom level UTF-8 decode routine.
Returns the native code point value of the first character in the string C<s>,
=for apidoc utf8n_to_uvchr_error
THIS FUNCTION SHOULD BE USED IN ONLY VERY SPECIALIZED CIRCUMSTANCES.
-Most code should use L</utf8_to_uvchr_buf>() rather than call this directly.
+Most code should use L</utf8_to_uvchr_buf>() rather than call this
+directly.
This function is for code that needs to know what the precise malformation(s)
are when an error is found. If you also need to know the generated warning
=for apidoc utf8n_to_uvchr_msgs
THIS FUNCTION SHOULD BE USED IN ONLY VERY SPECIALIZED CIRCUMSTANCES.
-Most code should use L</utf8_to_uvchr_buf>() rather than call this directly.
+Most code should use L</utf8_to_uvchr_buf>() rather than call this
+directly.
This function is for code that needs to know what the precise malformation(s)
are when an error is found, and wants the corresponding warning and/or error
{
PERL_ARGS_ASSERT_UTF8_TO_UVCHR_BUF;
- assert(s < send);
-
- return utf8n_to_uvchr(s, send - s, retlen,
- ckWARN_d(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY);
+ return utf8_to_uvchr_buf_helper(s, send, retlen);
}
/* This is marked as deprecated
Only in very rare circumstances should code need to be dealing in Unicode
(as opposed to native) code points. In those few cases, use
-C<L<NATIVE_TO_UNI(utf8_to_uvchr_buf(...))|/utf8_to_uvchr_buf>> instead. If you
-are not absolutely sure this is one of those cases, then assume it isn't and
-use plain C<utf8_to_uvchr_buf> instead.
+C<L<NATIVE_TO_UNI(utf8_to_uvchr_buf(...))|perlapi/utf8_to_uvchr_buf>> instead.
+If you are not absolutely sure this is one of those cases, then assume it isn't
+and use plain C<utf8_to_uvchr_buf> instead.
Returns the Unicode (not-native) code point of the first character in the
string C<s> which
the Unicode REPLACEMENT CHARACTER, if not) is silently returned, and C<*retlen>
is set (if C<retlen> isn't NULL) so that (S<C<s> + C<*retlen>>) is the
next possible position in C<s> that could begin a non-malformed character.
-See L</utf8n_to_uvchr> for details on when the REPLACEMENT CHARACTER is returned.
+See L<perlapi/utf8n_to_uvchr> for details on when the REPLACEMENT CHARACTER is
+returned.
=cut
*/
* the bitops (especially ~) can create illegal UTF-8.
* In other words: in Perl UTF-8 is not just for Unicode. */
- if (e < s)
+ if (UNLIKELY(e < s))
goto warn_and_return;
while (s < e) {
s += UTF8SKIP(s);
len++;
}
- if (e != s) {
+ if (UNLIKELY(e != s)) {
len--;
warn_and_return:
if (PL_op)
bool
Perl__is_uni_FOO(pTHX_ const U8 classnum, const UV c)
{
+ dVAR;
return _invlist_contains_cp(PL_XPosix_ptrs[classnum], c);
}
bool
Perl__is_utf8_idstart(pTHX_ const U8 *p)
{
+ dVAR;
+
PERL_ARGS_ASSERT__IS_UTF8_IDSTART;
if (*p == '_')
bool
Perl__is_uni_perl_idcont(pTHX_ UV c)
{
+ dVAR;
return _invlist_contains_cp(PL_utf8_perl_idcont, c);
}
bool
Perl__is_uni_perl_idstart(pTHX_ UV c)
{
+ dVAR;
return _invlist_contains_cp(PL_utf8_perl_idstart, c);
}
* The ordinal of the first character of the changed version is returned
* (but note, as explained above, that there may be more.) */
+ dVAR;
PERL_ARGS_ASSERT_TO_UNI_UPPER;
if (c < 256) {
UV
Perl_to_uni_title(pTHX_ UV c, U8* p, STRLEN *lenp)
{
+ dVAR;
PERL_ARGS_ASSERT_TO_UNI_TITLE;
if (c < 256) {
UV
Perl_to_uni_lower(pTHX_ UV c, U8* p, STRLEN *lenp)
{
+ dVAR;
PERL_ARGS_ASSERT_TO_UNI_LOWER;
if (c < 256) {
* FOLD_FLAGS_NOMIX_ASCII iff non-ASCII to ASCII folds are prohibited
*/
+ dVAR;
PERL_ARGS_ASSERT__TO_UNI_FOLD_FLAGS;
if (flags & FOLD_FLAGS_LOCALE) {
const char * const file,
const unsigned line)
{
+ dVAR;
PERL_ARGS_ASSERT__IS_UTF8_FOO;
warn_on_first_deprecated_use(name, alternative, use_locale, file, line);
Perl__is_utf8_FOO_with_len(pTHX_ const U8 classnum, const U8 *p,
const U8 * const e)
{
+ dVAR;
PERL_ARGS_ASSERT__IS_UTF8_FOO_WITH_LEN;
return is_utf8_common_with_len(p, e, PL_XPosix_ptrs[classnum]);
bool
Perl__is_utf8_perl_idstart_with_len(pTHX_ const U8 *p, const U8 * const e)
{
+ dVAR;
PERL_ARGS_ASSERT__IS_UTF8_PERL_IDSTART_WITH_LEN;
return is_utf8_common_with_len(p, e, PL_utf8_perl_idstart);
bool
Perl__is_utf8_xidstart(pTHX_ const U8 *p)
{
+ dVAR;
PERL_ARGS_ASSERT__IS_UTF8_XIDSTART;
if (*p == '_')
bool
Perl__is_utf8_perl_idcont_with_len(pTHX_ const U8 *p, const U8 * const e)
{
+ dVAR;
PERL_ARGS_ASSERT__IS_UTF8_PERL_IDCONT_WITH_LEN;
return is_utf8_common_with_len(p, e, PL_utf8_perl_idcont);
bool
Perl__is_utf8_idcont(pTHX_ const U8 *p)
{
+ dVAR;
PERL_ARGS_ASSERT__IS_UTF8_IDCONT;
return is_utf8_common(p, PL_utf8_idcont);
bool
Perl__is_utf8_xidcont(pTHX_ const U8 *p)
{
+ dVAR;
PERL_ARGS_ASSERT__IS_UTF8_XIDCONT;
return is_utf8_common(p, PL_utf8_xidcont);
bool
Perl__is_utf8_mark(pTHX_ const U8 *p)
{
+ dVAR;
PERL_ARGS_ASSERT__IS_UTF8_MARK;
return is_utf8_common(p, PL_utf8_mark);
* the return can point to them, but single code points aren't, so would
* need to be constructed if we didn't employ something like this API */
+ dVAR;
/* 'index' is guaranteed to be non-negative, as this is an inversion map
* that covers all possible inputs. See [perl #133365] */
SSize_t index = _invlist_search(PL_utf8_foldclosures, cp);
* sequence, and the entire sequence will be stored in *ustrp. ustrp will
* contain *lenp bytes */
+ dVAR;
PERL_ARGS_ASSERT_TURKIC_LC;
assert(e > p0);
const char * const file,
const int line)
{
+ dVAR;
UV result;
const U32 utf8n_flags = check_and_deprecate(p, &e, DEPRECATE_TO_UPPER,
cBOOL(flags), file, line);
const char * const file,
const int line)
{
+ dVAR;
UV result;
const U32 utf8n_flags = check_and_deprecate(p, &e, DEPRECATE_TO_TITLE,
cBOOL(flags), file, line);
const char * const file,
const int line)
{
+ dVAR;
UV result;
const U32 utf8n_flags = check_and_deprecate(p, &e, DEPRECATE_TO_LOWER,
cBOOL(flags), file, line);
const char * const file,
const int line)
{
+ dVAR;
UV result;
const U32 utf8n_flags = check_and_deprecate(p, &e, DEPRECATE_TO_FOLD,
cBOOL(flags), file, line);
SAVEBOOL(TAINT_get);
TAINT_NOT;
#endif
- Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT, newSVpvn(pkg,pkg_len),
- NULL);
+ require_pv("utf8_heavy.pl");
{
/* Not ERRSV, as there is no need to vivify a scalar we are
about to discard. */
/*
=for apidoc utf8n_to_uvuni
-Instead use L</utf8_to_uvchr_buf>, or rarely, L</utf8n_to_uvchr>.
+Instead use L<perlapi/utf8_to_uvchr_buf>, or rarely, L<perlapi/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>>.
+C<L<NATIVE_TO_UNI(utf8_to_uvchr_buf(...))|perlapi/utf8_to_uvchr_buf>>
+or C<L<NATIVE_TO_UNI(utf8n_to_uvchr(...))|perlapi/utf8n_to_uvchr>>.
=cut
*/
/*
=for apidoc uvuni_to_utf8_flags
-Instead you almost certainly want to use L</uvchr_to_utf8> or
-L</uvchr_to_utf8_flags>.
+Instead you almost certainly want to use L<perlapi/uvchr_to_utf8> or
+L<perlapi/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
* handled the same way, speeding up this common case */
if (UTF8_IS_INVARIANT(*s)) { /* Assumes 's' contains at least 1 byte */
+ if (retlen) {
+ *retlen = 1;
+ }
return (UV) *s;
}
https://perl5.git.perl.org / perl5.git / blobdiff