In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/8d19ebbca9eecf219cc453cffe88722722860dd9?hp=0baa827e0fd16abde2450ecee673f26319010e2d>
- Log ----------------------------------------------------------------- commit 8d19ebbca9eecf219cc453cffe88722722860dd9 Merge: 0baa827 2b6852c Author: Karl Williamson <[email protected]> Date: Wed Aug 31 20:33:21 2016 -0600 Merge branch for improving API UTF-8 handling into blead This set of commits came about to allow XS code to more easily and quickly check for valid UTF-8 without rolling their own, which could be lacking in security considerations. Most of the small UTF-8 handling functions have now been inlined, and the validity-only checking function has been rewritten to never need to actually calculate the code point the UTF-8 represents. The original impetus for this was because of changes in Encode that made it vulnerable to malformed UTF-8. These changes were to speed up its UTF-8 processing. By changing Encode to use this new stuff, it is sped up on valid input by over a factor of 5 from the original implementation, at the expense of slowing down entirely invalid input by a factor of 4. Since we are expecting mostly valid input, this is an overall big win. The original handrolled Encode changes sped up valid input handling by about 1.5, without slowing handling of invalid down appreciably. commit 2b6852c008f43c765471849e5576c5425c5d9e23 Author: Karl Williamson <[email protected]> Date: Sun Aug 28 22:04:16 2016 -0600 Use new is_utf8_valid_partial_char() This new function can be used in the implementation of the file test operators, -B and -T, to see if the whole fixed length buffer is valid UTF-8. Previously if all bytes were UTF-8 except the bytes at the end that could have been a partial character, it assumed the whole thing was UTF-8. This improves the prediction slightly M pp_sys.c commit 4dab108fb5e7e21a547733bb00ddb5d8bffd936d Author: Karl Williamson <[email protected]> Date: Sun Aug 28 10:54:13 2016 -0600 Add is_utf8_valid_partial_char() This new function can test some purported UTF-8 to see if it is well-formed as far as it goes. That is there aren't enough bytes for the character they start, but what is there is legal so far. This can be useful in a fixed width buffer, where the final character is split in the middle, and we want to test without waiting for the next read that the entire buffer is valid. M embed.fnc M embed.h M inline.h M proto.h M utf8.c commit 89d986df51f55257b8cc3f6e4f54eba60f607e48 Author: Karl Williamson <[email protected]> Date: Sat Aug 27 20:08:52 2016 -0600 Make 3 UTF-8 macros API These may be useful to various module writers. They certainly are useful for Encode. This makes public API macros to determine if the input UTF-8 represents (one macro for each category) a) a surrogate code point b) a non-character code point c) a code point that is above Unicode's legal maximum. The macros are machine generated. In making them public, I am now using the string end location parameter to guard against running off the end of the input. Previously this parameter was ignored, as their use in the core could be tightly controlled so that we already knew that the string was long enough when calling these macros. But this can't be guaranteed in the public API. An optimizing compiler should be able to remove redundant length checks. M regcharclass.h M regen/regcharclass.pl M utf8.h commit 52be253637900db8bbf44d387a06af529972b855 Author: Karl Williamson <[email protected]> Date: Fri Aug 26 16:47:32 2016 -0600 utf8.c: Add comments M utf8.c commit 35936d2282751a8303128483385f038a5ac6eaa1 Author: Karl Williamson <[email protected]> Date: Fri Aug 26 16:53:00 2016 -0600 is_utf8_string() is now a pure function as of the previous commit M embed.fnc M inline.h M proto.h commit 35f8c9bd0ff4f298f8bc09ae9848a14a9667a95a Author: Karl Williamson <[email protected]> Date: Fri Aug 26 16:29:54 2016 -0600 Move isUTF8_CHAR helper function, and reimplement it The macro isUTF8_CHAR calls a helper function for code points higher than it can handle. That function had been an inlined wrapper around utf8n_to_uvchr(). The function has been rewritten to not call utf8n_to_uvchr(), so it is now too big to be effectively inlined. Instead, it implements a faster method of checking the validity of the UTF-8 without having to decode it. It just checks for valid syntax and now knows where the few discontinuities are in UTF-8 where overlongs can occur, and uses a string compare to verify that overflow won't occur. As a result this is now a pure function. This also causes a previously generated deprecation warning to not be, because in printing UTF-8, no longer does it have to be converted to internal form. I could add a check for that, but I think it's best not to. If you manipulated what is getting printed in any way, the deprecation message will already have been raised. This commit also fleshes out the documentation of isUTF8_CHAR. M embed.fnc M embed.h M inline.h M proto.h M t/lib/warnings/utf8 M utf8.c M utf8.h commit eda91ad75c71796ed6c5d3da7850b2fd7566c2a2 Author: Karl Williamson <[email protected]> Date: Fri Aug 26 16:23:24 2016 -0600 Add #defines for UTF-8 of highest representable code point This will allow the next commit to not have to actually try to decode the UTF-8 string in order to see if it overflows the platform. M utf8.h M utfebcdic.h commit c24e28a36bb30e64307477dfa160309665221d61 Author: Karl Williamson <[email protected]> Date: Fri Aug 26 16:21:25 2016 -0600 utf8.h: Add some LIKELY() to help branch prediction This macro gives the legal UTF-8 byte sequences. Almost always, the input will be legal, so help compiler branch prediction for that. M utf8.h commit a14e0a36c312aa5bbf90f3971ff3d9ab65c4cda9 Author: Karl Williamson <[email protected]> Date: Fri Aug 26 16:07:22 2016 -0600 utf8.h, utfebcdic.h: Add comments, align white space M utf8.h M utfebcdic.h commit 5ff889fb14e2876aef87fbed6e39779692ad2aa4 Author: Karl Williamson <[email protected]> Date: Fri Aug 26 15:53:36 2016 -0600 Inline is_utf8_string() and is_utf8_stringloclen() M embed.fnc M inline.h M proto.h M utf8.c commit 7c93d8f091c4849e8de126f1da68d0465b916766 Author: Karl Williamson <[email protected]> Date: Fri Aug 26 15:03:52 2016 -0600 Inline utf8_distance(), utf8_hop() M embed.fnc M inline.h M proto.h M utf8.c commit 5962d97e94001652b6627a579918c2a74637ccd0 Author: Karl Williamson <[email protected]> Date: Fri Aug 26 14:47:17 2016 -0600 Slightly simplify utf8_to_uvuni_buf() Use a function that does the same thing. This also clarifies a related comment M utf8.c commit 1e5993548e8278d215e2c051e00b31158e2f2638 Author: Karl Williamson <[email protected]> Date: Fri Aug 26 14:07:50 2016 -0600 Inline is_utf8_invariant_string() M embed.fnc M embed.h M inline.h M proto.h M utf8.c commit a4c56e8a5d60847e5e2753da6f3e6a291d9f55c7 Author: Karl Williamson <[email protected]> Date: Fri Aug 26 13:54:51 2016 -0600 is_utf8_invariant_string is pure As are its synonyms. This also declares the formal parameters 'const' M embed.fnc M proto.h commit c205683cc2dbf8013c5d6e69a3a694369535e2a8 Author: Karl Williamson <[email protected]> Date: Fri Aug 26 13:52:52 2016 -0600 Simplify slightly is_utf8_invariant_string This eliminates an unnecessary branch test in unoptimized code. M utf8.c commit c5f058dfd0db4297255d7df7a085fdf36232d5b9 Author: Karl Williamson <[email protected]> Date: Fri Aug 26 13:42:53 2016 -0600 Use new name 'is_utf8_invariant_string' in core This changes the places in the core to use the clearer synonym added by the previous commit. It also changes one place that hand-rolled its own code to use this function instead. M ext/POSIX/POSIX.xs M ext/POSIX/lib/POSIX.pm M locale.c M mg.c M pp_sys.c M sv.c M toke.c commit 8871a094916837597c6a703c2e1b2306314df4fa Author: Karl Williamson <[email protected]> Date: Fri Aug 26 13:35:28 2016 -0600 Add new synonym 'is_utf8_invariant_string' This is clearer as to its meaning than the existing 'is_ascii_string' and 'is_invariant_string', which are retained for back compat. The thread context variable is removed as it is not used. M embed.fnc M embed.h M proto.h M utf8.c M utf8.h commit e950ecba8e797ce46fe4f568b0f08811002f3d95 Author: Karl Williamson <[email protected]> Date: Tue Aug 23 13:37:10 2016 -0600 embed.fnc: Replace blanks by tabs In this file, tabs are the more accepted field delimiter, and having them makes it easier to search for particular patterns in it. M embed.fnc commit 9f590ad4e8392b4e53b60a6ee1d93e0573c63722 Author: Karl Williamson <[email protected]> Date: Mon Aug 22 12:28:21 2016 -0600 utf8.c: Use 'break' instead of 'goto' The goto is a relic of a previous implementation; 'break' is preferred if there isn't a reason to use goto. M utf8.c commit 55c5b58bc5035d0aff68aee7ed884342913fd9b8 Author: Karl Williamson <[email protected]> Date: Mon Aug 22 12:25:00 2016 -0600 is_utf8_string_loc() param should not be NULL It makes no sense to call this function with a NULL parameter, as the whole point of using this function is to set what that param points to. If you don't want this, you should be using the similar function that doesn't have this parameter. M embed.fnc M proto.h commit 2fe720e22e785c4e6125ac67a259c4385eb89a64 Author: Karl Williamson <[email protected]> Date: Mon Aug 22 12:21:06 2016 -0600 Document valid_utf8_to_uvchr() and inline it This function has been in several releases without problem, and is short enough that some compilers can inline it. This commit also notes that the result should not be ignored, and removes the unused pTHX. The function has explicitly been marked as being changeable, and has not been part of the API until now. M embed.fnc M embed.h M inline.h M proto.h M utf8.c commit 8c879e491ff4ff91b4a4b96054663a5fb4e5a513 Author: Karl Williamson <[email protected]> Date: Mon Aug 22 10:48:55 2016 -0600 utf8.c: Clarify comments for valid_utf8_to_uvchr() M utf8.c commit bbdfb8c4be989b984e00ef95f0afdba7d43daeac Author: Karl Williamson <[email protected]> Date: Mon Aug 22 10:59:48 2016 -0600 utf8.c: Join EBCDIC/non-EBCDIC code This was missed in 534752c1d25d7c52c702337927c37e40c4df103d M utf8.c commit 4d2e4fbc2785955cbfa81b2e3d57ef5da2f6f856 Author: Karl Williamson <[email protected]> Date: Fri Aug 26 15:25:20 2016 -0600 regen/embed.pl: Allow inline funcs to be named Perl_foo When inlining an existing public function whose name begins with Perl_, it's best to keep that name, in case someone is calling it that way. Prior to this commit, the name had to be changed to S_foo. M embed.fnc M regen/embed.pl ----------------------------------------------------------------------- Summary of changes: embed.fnc | 88 +++++++-------- embed.h | 7 +- ext/POSIX/POSIX.xs | 23 ++-- ext/POSIX/lib/POSIX.pm | 2 +- inline.h | 273 ++++++++++++++++++++++++++++++++++++++++++---- locale.c | 10 +- mg.c | 2 +- pp_sys.c | 10 +- proto.h | 46 +++++--- regcharclass.h | 90 ++++++++-------- regen/embed.pl | 10 +- regen/regcharclass.pl | 4 +- sv.c | 10 +- t/lib/warnings/utf8 | 1 - toke.c | 8 +- utf8.c | 288 ++++++++++++++++--------------------------------- utf8.h | 179 +++++++++++++++++++++--------- utfebcdic.h | 38 ++++++- 18 files changed, 675 insertions(+), 414 deletions(-) diff --git a/embed.fnc b/embed.fnc index 38e8cf9..6601c54 100644 --- a/embed.fnc +++ b/embed.fnc @@ -84,9 +84,10 @@ : : i Static inline: function in source code has a S_ prefix: : -: proto.h: function is declared as S_foo rather than foo, +: proto.h: function is declared as S_foo rather than foo unless the 'p' +: flag is also given in which case 'Perl_foo' is used, : PERL_STATIC_INLINE is added to declaration; -: embed.h: "#define foo S_foo" entries added +: embed.h: "#define foo S_foo" or Perl_foo entries added : : M May change: : @@ -309,7 +310,7 @@ norx |void |win32_croak_not_implemented|NN const char * fname #endif #if defined(PERL_IMPLICIT_CONTEXT) Afnrp |void |croak_nocontext|NULLOK const char* pat|... -Afnrp |OP* |die_nocontext |NULLOK const char* pat|... +Afnrp |OP* |die_nocontext |NULLOK const char* pat|... Afnp |void |deb_nocontext |NN const char* pat|... Afnp |char* |form_nocontext |NN const char* pat|... Anp |void |load_module_nocontext|U32 flags|NN SV* name|NULLOK SV* ver|... @@ -367,8 +368,8 @@ Anp |char* |delimcpy |NN char* to|NN const char* toend|NN const char* from \ |NN const char* fromend|int delim|NN I32* retlen : Used in op.c, perl.c pM |void |delete_eval_scope -Aprd |OP* |die_sv |NN SV *baseex -Afrpd |OP* |die |NULLOK const char* pat|... +Aprd |OP* |die_sv |NN SV *baseex +Afrpd |OP* |die |NULLOK const char* pat|... : Used in util.c pr |void |die_unwind |NN SV* msv Ap |void |dounwind |I32 cxix @@ -677,7 +678,7 @@ ApR |I32 |is_lvalue_sub : Used in cop.h XopR |I32 |was_lvalue_sub #ifndef PERL_NO_INLINE_FUNCTIONS -AiMRn |STRLEN |_is_utf8_char_slow|NN const U8 *s|NN const U8 *e +ApMRnP |STRLEN |_is_utf8_char_slow|NN const U8 * const s|const STRLEN len #endif ADMpPR |U32 |to_uni_upper_lc|U32 c ADMpPR |U32 |to_uni_title_lc|U32 c @@ -705,7 +706,7 @@ ADMpPR |bool |isALNUM_lazy |NN const char* p snR |U8 |to_lower_latin1|const U8 c|NULLOK U8 *p|NULLOK STRLEN *lenp #endif #if defined(PERL_IN_UTF8_C) || defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_REGEXEC_C) -EXp |UV |_to_fold_latin1|const U8 c|NN U8 *p|NN STRLEN *lenp|const unsigned int flags +EXp |UV |_to_fold_latin1|const U8 c|NN U8 *p|NN STRLEN *lenp|const unsigned int flags #endif #if defined(PERL_IN_UTF8_C) || defined(PERL_IN_PP_C) p |UV |_to_upper_title_latin1|const U8 c|NN U8 *p|NN STRLEN *lenp|const char S_or_s @@ -730,13 +731,15 @@ ADMpPR |bool |is_uni_lower_lc|UV c ADMpPR |bool |is_uni_print_lc|UV c ADMpPR |bool |is_uni_punct_lc|UV c ADMpPR |bool |is_uni_xdigit_lc|UV c -AnpdR |bool |is_invariant_string|NN const U8 *s|STRLEN len -AmpdR |bool |is_ascii_string|NN const U8 *s|STRLEN len +AnidRP |bool |is_utf8_invariant_string|NN const U8* const s|STRLEN const len +AmnpdRP |bool |is_ascii_string|NN const U8* const s|const STRLEN len +AmnpdRP |bool |is_invariant_string|NN const U8* const s|const STRLEN len AnpdD |STRLEN |is_utf8_char |NN const U8 *s Abmnpd |STRLEN |is_utf8_char_buf|NN const U8 *buf|NN const U8 *buf_end -Anpd |bool |is_utf8_string |NN const U8 *s|STRLEN len -Anpdmb |bool |is_utf8_string_loc|NN const U8 *s|STRLEN len|NULLOK const U8 **ep -Anpd |bool |is_utf8_string_loclen|NN const U8 *s|STRLEN len|NULLOK const U8 **ep|NULLOK STRLEN *el +AnipdP |bool |is_utf8_string |NN const U8 *s|STRLEN len +Anpdmb |bool |is_utf8_string_loc|NN const U8 *s|STRLEN len|NN const U8 **ep +Anipd |bool |is_utf8_string_loclen|NN const U8 *s|STRLEN len|NULLOK const U8 **ep|NULLOK STRLEN *el +AnidP |bool |is_utf8_valid_partial_char|NN const U8 * const s|NN const U8 * const e AMpR |bool |_is_uni_FOO|const U8 classnum|const UV c AMpR |bool |_is_utf8_FOO|const U8 classnum|NN const U8 *p ADMpR |bool |is_utf8_alnum |NN const U8 *p @@ -1237,16 +1240,16 @@ Ap |I32 |regexec_flags |NN REGEXP *const rx|NN char *stringarg \ |SSize_t minend|NN SV *sv \ |NULLOK void *data|U32 flags ApR |regnode*|regnext |NULLOK regnode* p -EXp |SV*|reg_named_buff |NN REGEXP * const rx|NULLOK SV * const key \ +EXp |SV*|reg_named_buff |NN REGEXP * const rx|NULLOK SV * const key \ |NULLOK SV * const value|const U32 flags -EXp |SV*|reg_named_buff_iter |NN REGEXP * const rx|NULLOK const SV * const lastkey \ +EXp |SV*|reg_named_buff_iter |NN REGEXP * const rx|NULLOK const SV * const lastkey \ |const U32 flags -Ap |SV*|reg_named_buff_fetch |NN REGEXP * const rx|NN SV * const namesv|const U32 flags -Ap |bool|reg_named_buff_exists |NN REGEXP * const rx|NN SV * const key|const U32 flags -Ap |SV*|reg_named_buff_firstkey |NN REGEXP * const rx|const U32 flags -Ap |SV*|reg_named_buff_nextkey |NN REGEXP * const rx|const U32 flags -Ap |SV*|reg_named_buff_scalar |NN REGEXP * const rx|const U32 flags -Ap |SV*|reg_named_buff_all |NN REGEXP * const rx|const U32 flags +Ap |SV*|reg_named_buff_fetch |NN REGEXP * const rx|NN SV * const namesv|const U32 flags +Ap |bool|reg_named_buff_exists |NN REGEXP * const rx|NN SV * const key|const U32 flags +Ap |SV*|reg_named_buff_firstkey |NN REGEXP * const rx|const U32 flags +Ap |SV*|reg_named_buff_nextkey |NN REGEXP * const rx|const U32 flags +Ap |SV*|reg_named_buff_scalar |NN REGEXP * const rx|const U32 flags +Ap |SV*|reg_named_buff_all |NN REGEXP * const rx|const U32 flags : FIXME - is anything in re using this now? EXp |void|reg_numbered_buff_fetch|NN REGEXP * const rx|const I32 paren|NULLOK SV * const sv @@ -1673,8 +1676,8 @@ p |void |utilize |int aver|I32 floor|NULLOK OP* version|NN OP* idop|NULLOK OP* a Ap |U8* |utf16_to_utf8 |NN U8* p|NN U8 *d|I32 bytelen|NN I32 *newlen Ap |U8* |utf16_to_utf8_reversed|NN U8* p|NN U8 *d|I32 bytelen|NN I32 *newlen AdpPR |STRLEN |utf8_length |NN const U8* s|NN const U8 *e -ApdPR |IV |utf8_distance |NN const U8 *a|NN const U8 *b -ApdPRn |U8* |utf8_hop |NN const U8 *s|SSize_t off +AipdPR |IV |utf8_distance |NN const U8 *a|NN const U8 *b +AipdPRn |U8* |utf8_hop |NN const U8 *s|SSize_t off ApMd |U8* |utf8_to_bytes |NN U8 *s|NN STRLEN *len Apd |int |bytes_cmp_utf8 |NN const U8 *b|STRLEN blen|NN const U8 *u \ |STRLEN ulen @@ -1688,8 +1691,7 @@ ApdD |UV |utf8_to_uvuni_buf |NN const U8 *s|NN const U8 *send|NULLOK STRLEN *ret pM |bool |check_utf8_print |NN const U8 *s|const STRLEN len Adp |UV |utf8n_to_uvchr |NN const U8 *s|STRLEN curlen|NULLOK STRLEN *retlen|U32 flags -ApM |UV |valid_utf8_to_uvchr |NN const U8 *s|NULLOK STRLEN *retlen - +AipnR |UV |valid_utf8_to_uvchr |NN const U8 *s|NULLOK STRLEN *retlen Ap |UV |utf8n_to_uvuni|NN const U8 *s|STRLEN curlen|NULLOK STRLEN *retlen|U32 flags Adm |U8* |uvchr_to_utf8 |NN U8 *d|UV uv @@ -1711,7 +1713,7 @@ Ap |U32 |seed Xpno |double |drand48_r |NN perl_drand48_t *random_state Xpno |void |drand48_init_r |NN perl_drand48_t *random_state|U32 seed : Only used in perl.c -p |void |get_hash_seed |NN unsigned char * const seed_buffer +p |void |get_hash_seed |NN unsigned char * const seed_buffer : Used in doio.c, pp_hot.c, pp_sys.c p |void |report_evil_fh |NULLOK const GV *gv : Used in doio.c, pp_hot.c, pp_sys.c @@ -1739,9 +1741,9 @@ Apd |bool |dump_c_backtrace|NN PerlIO* fp|int max_depth|int skip : FIXME p |void |watch |NN char** addr Am |I32 |whichsig |NN const char* sig -Ap |I32 |whichsig_sv |NN SV* sigsv -Ap |I32 |whichsig_pv |NN const char* sig -Ap |I32 |whichsig_pvn |NN const char* sig|STRLEN len +Ap |I32 |whichsig_sv |NN SV* sigsv +Ap |I32 |whichsig_pv |NN const char* sig +Ap |I32 |whichsig_pvn |NN const char* sig|STRLEN len #ifndef PERL_NO_INLINE_FUNCTIONS : used to check for NULs in pathnames and other names AiR |bool |is_safe_syscall|NN const char *pv|STRLEN len|NN const char *what|NN const char *op_name @@ -1809,7 +1811,7 @@ Apd |char* |pv_escape |NULLOK SV *dsv|NN char const * const str\ |const STRLEN count|const STRLEN max\ |NULLOK STRLEN * const escaped\ |const U32 flags -Apd |char* |pv_pretty |NN SV *dsv|NN char const * const str\ +Apd |char* |pv_pretty |NN SV *dsv|NN char const * const str\ |const STRLEN count|const STRLEN max\ |NULLOK char const * const start_color\ |NULLOK char const * const end_color\ @@ -1925,18 +1927,18 @@ sR |I32 |do_trans_complex_utf8 |NN SV * const sv #if defined(PERL_IN_GV_C) s |void |gv_init_svtype |NN GV *gv|const svtype sv_type s |void |gv_magicalize_isa |NN GV *gv -s |bool|parse_gv_stash_name|NN HV **stash|NN GV **gv \ +s |bool|parse_gv_stash_name|NN HV **stash|NN GV **gv \ |NN const char **name|NN STRLEN *len \ |NN const char *nambeg|STRLEN full_len \ |const U32 is_utf8|const I32 add -s |bool|find_default_stash|NN HV **stash|NN const char *name \ +s |bool|find_default_stash|NN HV **stash|NN const char *name \ |STRLEN len|const U32 is_utf8|const I32 add \ |const svtype sv_type -s |bool|gv_magicalize|NN GV *gv|NN HV *stash|NN const char *name \ +s |bool|gv_magicalize|NN GV *gv|NN HV *stash|NN const char *name \ |STRLEN len \ |const svtype sv_type -s |void|maybe_multimagic_gv|NN GV *gv|NN const char *name|const svtype sv_type -s |bool|gv_is_in_main|NN const char *name|STRLEN len \ +s |void|maybe_multimagic_gv|NN GV *gv|NN const char *name|const svtype sv_type +s |bool|gv_is_in_main|NN const char *name|STRLEN len \ |const U32 is_utf8 s |void |require_tie_mod|NN GV *gv|NN const char varname \ |NN const char * name|STRLEN len \ @@ -2294,7 +2296,7 @@ EnPs |int |edit_distance |NN const UV *src \ |const SSize_t maxDistance # ifdef DEBUGGING Ep |int |re_indentf |NN const char *fmt|U32 depth|... -Es |void |regdump_intflags|NULLOK const char *lead| const U32 flags +Es |void |regdump_intflags|NULLOK const char *lead| const U32 flags Es |void |regdump_extflags|NULLOK const char *lead| const U32 flags Es |const regnode*|dumpuntil|NN const regexp *r|NN const regnode *start \ |NN const regnode *node \ @@ -2552,7 +2554,7 @@ so |SV* |new_constant |NULLOK const char *s|STRLEN len \ |STRLEN typelen s |int |deprecate_commaless_var_list s |int |ao |int toketype -s |void|parse_ident|NN char **s|NN char **d \ +s |void|parse_ident|NN char **s|NN char **d \ |NN char * const e|int allow_package \ |bool is_utf8|bool check_dollar # if defined(PERL_CR_FILTER) @@ -2746,7 +2748,7 @@ sd |void |pad_reset #endif AMpd |void |pad_tidy |padtidy_type type pd |void |pad_free |PADOFFSET po -pd |void |do_dump_pad |I32 level|NN PerlIO *file|NULLOK PADLIST *padlist|int full +pd |void |do_dump_pad |I32 level|NN PerlIO *file|NULLOK PADLIST *padlist|int full #if defined(PERL_IN_PAD_C) # if defined(DEBUGGING) sd |void |cv_dump |NN const CV *cv|NN const char *title @@ -2792,7 +2794,7 @@ ApoR |I32* |hv_riter_p |NN HV *hv ApoR |HE** |hv_eiter_p |NN HV *hv Apo |void |hv_riter_set |NN HV *hv|I32 riter Apo |void |hv_eiter_set |NN HV *hv|NULLOK HE *eiter -Ap |void |hv_rand_set |NN HV *hv|U32 new_xhv_rand +Ap |void |hv_rand_set |NN HV *hv|U32 new_xhv_rand Ap |void |hv_name_set |NN HV *hv|NULLOK const char *name|U32 len|U32 flags p |void |hv_ename_add |NN HV *hv|NN const char *name|U32 len \ |U32 flags @@ -2875,7 +2877,7 @@ Apnod |Size_t |my_strlcat |NULLOK char *dst|NULLOK const char *src|Size_t size #endif #ifndef HAS_STRLCPY -Apnod |Size_t |my_strlcpy |NULLOK char *dst|NULLOK const char *src|Size_t size +Apnod |Size_t |my_strlcpy |NULLOK char *dst|NULLOK const char *src|Size_t size #endif Apdn |bool |isinfnan |NV nv @@ -2990,10 +2992,10 @@ AiM |void |cx_popgiven |NN PERL_CONTEXT *cx #endif #ifdef USE_DTRACE -XEop |void |dtrace_probe_call |NN CV *cv|bool is_call -XEop |void |dtrace_probe_load |NN const char *name|bool is_loading -XEop |void |dtrace_probe_op |NN const OP *op -XEop |void |dtrace_probe_phase|enum perl_phase phase +XEop |void |dtrace_probe_call |NN CV *cv|bool is_call +XEop |void |dtrace_probe_load |NN const char *name|bool is_loading +XEop |void |dtrace_probe_op |NN const OP *op +XEop |void |dtrace_probe_phase|enum perl_phase phase #endif : ex: set ts=8 sts=4 sw=4 noet: diff --git a/embed.h b/embed.h index f3a855e..8220ab5 100644 --- a/embed.h +++ b/embed.h @@ -242,7 +242,6 @@ #define intro_my() Perl_intro_my(aTHX) #define isALNUM_lazy(a) Perl_isALNUM_lazy(aTHX_ a) #define isIDFIRST_lazy(a) Perl_isIDFIRST_lazy(aTHX_ a) -#define is_invariant_string Perl_is_invariant_string #define is_lvalue_sub() Perl_is_lvalue_sub(aTHX) #define is_uni_alnum(a) Perl_is_uni_alnum(aTHX_ a) #define is_uni_alnum_lc(a) Perl_is_uni_alnum_lc(aTHX_ a) @@ -285,6 +284,7 @@ #define is_utf8_graph(a) Perl_is_utf8_graph(aTHX_ a) #define is_utf8_idcont(a) Perl_is_utf8_idcont(aTHX_ a) #define is_utf8_idfirst(a) Perl_is_utf8_idfirst(aTHX_ a) +#define is_utf8_invariant_string S_is_utf8_invariant_string #define is_utf8_lower(a) Perl_is_utf8_lower(aTHX_ a) #define is_utf8_mark(a) Perl_is_utf8_mark(aTHX_ a) #define is_utf8_perl_space(a) Perl_is_utf8_perl_space(aTHX_ a) @@ -296,6 +296,7 @@ #define is_utf8_string Perl_is_utf8_string #define is_utf8_string_loclen Perl_is_utf8_string_loclen #define is_utf8_upper(a) Perl_is_utf8_upper(aTHX_ a) +#define is_utf8_valid_partial_char S_is_utf8_valid_partial_char #define is_utf8_xdigit(a) Perl_is_utf8_xdigit(aTHX_ a) #define is_utf8_xidcont(a) Perl_is_utf8_xidcont(aTHX_ a) #define is_utf8_xidfirst(a) Perl_is_utf8_xidfirst(aTHX_ a) @@ -734,7 +735,7 @@ #define uvoffuni_to_utf8_flags(a,b,c) Perl_uvoffuni_to_utf8_flags(aTHX_ a,b,c) #define uvuni_to_utf8(a,b) Perl_uvuni_to_utf8(aTHX_ a,b) #define uvuni_to_utf8_flags(a,b,c) Perl_uvuni_to_utf8_flags(aTHX_ a,b,c) -#define valid_utf8_to_uvchr(a,b) Perl_valid_utf8_to_uvchr(aTHX_ a,b) +#define valid_utf8_to_uvchr Perl_valid_utf8_to_uvchr #define valid_utf8_to_uvuni(a,b) Perl_valid_utf8_to_uvuni(aTHX_ a,b) #define vcmp(a,b) Perl_vcmp(aTHX_ a,b) #define vcroak(a,b) Perl_vcroak(aTHX_ a,b) @@ -786,7 +787,7 @@ #define my_popen(a,b) Perl_my_popen(aTHX_ a,b) #endif #if !defined(PERL_NO_INLINE_FUNCTIONS) -#define _is_utf8_char_slow S__is_utf8_char_slow +#define _is_utf8_char_slow Perl__is_utf8_char_slow #define append_utf8_from_native_byte S_append_utf8_from_native_byte #define av_top_index(a) S_av_top_index(aTHX_ a) #define cx_popblock(a) S_cx_popblock(aTHX_ a) diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs index bb121c3..2af848b 100644 --- a/ext/POSIX/POSIX.xs +++ b/ext/POSIX/POSIX.xs @@ -2121,16 +2121,17 @@ localeconv() (void) hv_store(RETVAL, strings->name, strlen(strings->name), - newSVpvn_utf8(value, - strlen(value), - - /* We mark it as UTF-8 if a utf8 locale - * and is valid and variant under UTF-8 */ - is_utf8_locale - && ! is_invariant_string((U8 *) value, 0) - && is_utf8_string((U8 *) value, 0)), - 0); - } + newSVpvn_utf8( + value, + strlen(value), + + /* We mark it as UTF-8 if a utf8 locale and is + * valid and variant under UTF-8 */ + is_utf8_locale + && ! is_utf8_invariant_string((U8 *) value, 0) + && is_utf8_string((U8 *) value, 0)), + 0); + } strings++; } @@ -3567,7 +3568,7 @@ strftime(fmt, sec, min, hour, mday, mon, year, wday = -1, yday = -1, isdst = -1) STRLEN len = strlen(buf); sv_usepvn_flags(sv, buf, len, SV_HAS_TRAILING_NUL); if (SvUTF8(fmt) - || (! is_invariant_string((U8*) buf, len) + || (! is_utf8_invariant_string((U8*) buf, len) && is_utf8_string((U8*) buf, len) #ifdef USE_LOCALE_TIME && _is_cur_LC_category_utf8(LC_TIME) diff --git a/ext/POSIX/lib/POSIX.pm b/ext/POSIX/lib/POSIX.pm index 9960b2c..f11595e 100644 --- a/ext/POSIX/lib/POSIX.pm +++ b/ext/POSIX/lib/POSIX.pm @@ -4,7 +4,7 @@ use warnings; our ($AUTOLOAD, %SIGRT); -our $VERSION = '1.71'; +our $VERSION = '1.72'; require XSLoader; diff --git a/inline.h b/inline.h index 4cc6a74..5cb9347 100644 --- a/inline.h +++ b/inline.h @@ -256,6 +256,10 @@ GCC_DIAG_RESTORE /* Intentionally left semicolonless. */ /* ------------------------------- utf8.h ------------------------------- */ +/* +=head1 Unicode Support +*/ + PERL_STATIC_INLINE void S_append_utf8_from_native_byte(const U8 byte, U8** dest) { @@ -273,33 +277,263 @@ S_append_utf8_from_native_byte(const U8 byte, U8** dest) } /* +=for apidoc valid_utf8_to_uvchr +Like L</utf8_to_uvchr_buf>(), but should only be called when it is known that +the next character in the input UTF-8 string C<s> is well-formed (I<e.g.>, +it passes C<L</isUTF8_CHAR>>. Surrogates, non-character code points, and +non-Unicode code points are allowed. -A helper function for the macro isUTF8_CHAR(), which should be used instead of -this function. The macro will handle smaller code points directly saving time, -using this function as a fall-back for higher code points. +=cut -Tests if the first bytes of string C<s> form a valid UTF-8 character. 0 is -returned if the bytes starting at C<s> up to but not including C<e> do not form a -complete well-formed UTF-8 character; otherwise the number of bytes in the -character is returned. + */ -Note that an INVARIANT (i.e. ASCII on non-EBCDIC) character is a valid UTF-8 -character. +PERL_STATIC_INLINE UV +Perl_valid_utf8_to_uvchr(const U8 *s, STRLEN *retlen) +{ + UV expectlen = UTF8SKIP(s); + const U8* send = s + expectlen; + UV uv = *s; -=cut */ -PERL_STATIC_INLINE STRLEN -S__is_utf8_char_slow(const U8 *s, const U8 *e) + PERL_ARGS_ASSERT_VALID_UTF8_TO_UVCHR; + + if (retlen) { + *retlen = expectlen; + } + + /* An invariant is trivially returned */ + if (expectlen == 1) { + return uv; + } + + /* Remove the leading bits that indicate the number of bytes, leaving just + * the bits that are part of the value */ + uv = NATIVE_UTF8_TO_I8(uv) & UTF_START_MASK(expectlen); + + /* Now, loop through the remaining bytes, accumulating each into the + * working total as we go. (I khw tried unrolling the loop for up to 4 + * bytes, but there was no performance improvement) */ + for (++s; s < send; s++) { + uv = UTF8_ACCUMULATE(uv, *s); + } + + return UNI_TO_NATIVE(uv); + +} + +/* +=for apidoc is_utf8_invariant_string + +Returns true iff the first C<len> bytes of the string C<s> are the same +regardless of the UTF-8 encoding of the string (or UTF-EBCDIC encoding on +EBCDIC machines). That is, if they are UTF-8 invariant. On ASCII-ish +machines, all the ASCII characters and only the ASCII characters fit this +definition. On EBCDIC machines, the ASCII-range characters are invariant, but +so also are the C1 controls and C<\c?> (which isn't in the ASCII range on +EBCDIC). + +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>(). + +=cut +*/ + +PERL_STATIC_INLINE bool +S_is_utf8_invariant_string(const U8* const s, const STRLEN len) +{ + const U8* const send = s + (len ? len : strlen((const char *)s)); + const U8* x = s; + + PERL_ARGS_ASSERT_IS_UTF8_INVARIANT_STRING; + + for (; x < send; ++x) { + if (!UTF8_IS_INVARIANT(*x)) + return FALSE; + } + + return TRUE; +} + +/* +=for apidoc is_utf8_string + +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> 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_utf8_invariant_string>(), L</is_utf8_string_loclen>(), and +L</is_utf8_string_loc>(). + +=cut +*/ + +bool +Perl_is_utf8_string(const U8 *s, STRLEN len) +{ + /* This is now marked pure in embed.fnc, because isUTF8_CHAR now is pure. + * Be aware of possible changes to that */ + + const U8* const send = s + (len ? len : strlen((const char *)s)); + const U8* x = s; + + PERL_ARGS_ASSERT_IS_UTF8_STRING; + + while (x < send) { + STRLEN len = isUTF8_CHAR(x, send); + if (UNLIKELY(! len)) { + return FALSE; + } + x += len; + } + + return TRUE; +} + +/* +Implemented as a macro in utf8.h + +=for apidoc is_utf8_string_loc + +Like L</is_utf8_string> but stores the location of the failure (in the +case of "utf8ness failure") or the location C<s>+C<len> (in the case of +"utf8ness success") in the C<ep>. + +See also L</is_utf8_string_loclen>() and L</is_utf8_string>(). + +=for apidoc is_utf8_string_loclen + +Like L</is_utf8_string>() but stores the location of the failure (in the +case of "utf8ness failure") or the location C<s>+C<len> (in the case of +"utf8ness success") in the C<ep>, and the number of UTF-8 +encoded characters in the C<el>. + +See also L</is_utf8_string_loc>() and L</is_utf8_string>(). + +=cut +*/ + +bool +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; + + while (x < send) { + STRLEN len = isUTF8_CHAR(x, send); + if (UNLIKELY(! len)) { + break; + } + x += len; + outlen++; + } + + if (el) + *el = outlen; + + if (ep) { + *ep = x; + } + + return (x == send); +} + +/* +=for apidoc utf8_distance + +Returns the number of UTF-8 characters between the UTF-8 pointers C<a> +and C<b>. + +WARNING: use only if you *know* that the pointers point inside the +same UTF-8 buffer. + +=cut +*/ + +PERL_STATIC_INLINE IV +Perl_utf8_distance(pTHX_ const U8 *a, const U8 *b) +{ + PERL_ARGS_ASSERT_UTF8_DISTANCE; + + return (a < b) ? -1 * (IV) utf8_length(a, b) : (IV) utf8_length(b, a); +} + +/* +=for apidoc utf8_hop + +Return the UTF-8 pointer C<s> displaced by C<off> characters, either +forward or backward. + +WARNING: do not use the following unless you *know* C<off> is within +the UTF-8 data pointed to by C<s> *and* that on entry C<s> is aligned +on the first byte of character or just after the last byte of a character. + +=cut +*/ + +PERL_STATIC_INLINE U8 * +Perl_utf8_hop(const U8 *s, SSize_t off) { - dTHX; /* The function called below requires thread context */ + PERL_ARGS_ASSERT_UTF8_HOP; + + /* Note: cannot use UTF8_IS_...() too eagerly here since e.g + * the bitops (especially ~) can create illegal UTF-8. + * In other words: in Perl UTF-8 is not just for Unicode. */ + + if (off >= 0) { + while (off--) + s += UTF8SKIP(s); + } + else { + while (off++) { + s--; + while (UTF8_IS_CONTINUATION(*s)) + s--; + } + } + return (U8 *)s; +} + +/* + +=for apidoc is_utf8_valid_partial_char + +Returns 1 if the first few bytes of the string starting at C<s> and +looking no further than S<C<e - 1>> are legal initial bytes of +well-formed UTF-8; otherwise it returns 0. + +This is useful when some fixed-length buffer is being tested for being +well-formed UTF-8, but the final few bytes in it are fewer than necessary to +fully determine what code point they might mean. (Presumably when the buffer +is refreshed with the next chunk of data, the new first bytes will complete the +partial code point.) This function is used to verify that the final bytes in +the current buffer are in fact the legal beginning of some code point, so that +if they aren't, the failure can be signalled without having to wait for the +next read. + +If the bytes terminated at S<C<e - 1>> are a full character (or more), 0 is +returned. - STRLEN actual_len; +=cut +*/ +bool +S_is_utf8_valid_partial_char(const U8 * const s, const U8 * const e) +{ - PERL_ARGS_ASSERT__IS_UTF8_CHAR_SLOW; + PERL_ARGS_ASSERT_IS_UTF8_VALID_PARTIAL_CHAR; - assert(e >= s); - utf8n_to_uvchr(s, e - s, &actual_len, UTF8_CHECK_ONLY); + if (s >= e || s + UTF8SKIP(s) >= e) { + return FALSE; + } - return (actual_len == (STRLEN) -1) ? 0 : actual_len; + return cBOOL(_is_utf8_char_slow(s, e - s)); } /* ------------------------------- perl.h ----------------------------- */ @@ -769,9 +1003,6 @@ S_cx_popgiven(pTHX_ PERL_CONTEXT *cx) SvREFCNT_dec(sv); } - - - /* * ex: set ts=8 sts=4 sw=4 et: */ diff --git a/locale.c b/locale.c index 779324e..92b9e33 100644 --- a/locale.c +++ b/locale.c @@ -122,7 +122,7 @@ Perl_set_numeric_radix(pTHX) sv_setpv(PL_numeric_radix_sv, lc->decimal_point); else PL_numeric_radix_sv = newSVpv(lc->decimal_point, 0); - if (! is_invariant_string((U8 *) lc->decimal_point, 0) + if (! is_utf8_invariant_string((U8 *) lc->decimal_point, 0) && is_utf8_string((U8 *) lc->decimal_point, 0) && _is_cur_LC_category_utf8(LC_NUMERIC)) { @@ -2190,7 +2190,7 @@ Perl__is_cur_LC_category_utf8(pTHX_ int category) lc = localeconv(); if (! lc || ! lc->currency_symbol - || is_invariant_string((U8 *) lc->currency_symbol, 0)) + || is_utf8_invariant_string((U8 *) lc->currency_symbol, 0)) { DEBUG_L(PerlIO_printf(Perl_debug_log, "Couldn't get currency symbol for %s, or contains only ASCII; can't use for determining if UTF-8 locale\n", save_input_locale)); only_ascii = TRUE; @@ -2270,7 +2270,9 @@ Perl__is_cur_LC_category_utf8(pTHX_ int category) for (i = 0; i < 7 + 12; i++) { /* 7 days; 12 months */ formatted_time = my_strftime("%A %B %Z %p", 0, 0, hour, dom, month, 112, 0, 0, is_dst); - if (! formatted_time || is_invariant_string((U8 *) formatted_time, 0)) { + if ( ! formatted_time + || is_utf8_invariant_string((U8 *) formatted_time, 0)) + { /* Here, we didn't find a non-ASCII. Try the next time through * with the complemented dst and am/pm, and try with the next @@ -2371,7 +2373,7 @@ Perl__is_cur_LC_category_utf8(pTHX_ int category) break; } errmsg = savepv(errmsg); - if (! is_invariant_string((U8 *) errmsg, 0)) { + if (! is_utf8_invariant_string((U8 *) errmsg, 0)) { non_ascii = TRUE; is_utf8 = is_utf8_string((U8 *) errmsg, 0); break; diff --git a/mg.c b/mg.c index 0a93cb8..874933f 100644 --- a/mg.c +++ b/mg.c @@ -758,7 +758,7 @@ S_fixup_errno_string(pTHX_ SV* sv) * error message text. (If it turns out to be necessary, we could also * keep track if the current LC_MESSAGES locale is UTF-8) */ if (! IN_BYTES /* respect 'use bytes' */ - && ! is_invariant_string((U8*) SvPVX_const(sv), SvCUR(sv)) + && ! is_utf8_invariant_string((U8*) SvPVX_const(sv), SvCUR(sv)) && is_utf8_string((U8*) SvPVX_const(sv), SvCUR(sv))) { SvUTF8_on(sv); diff --git a/pp_sys.c b/pp_sys.c index d16a0e5..a198d4e 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -3555,14 +3555,14 @@ PP(pp_fttext) #endif assert(len); - if (! is_invariant_string((U8 *) s, len)) { + if (! is_utf8_invariant_string((U8 *) s, len)) { const U8 *ep; /* Here contains a variant under UTF-8 . See if the entire string is - * UTF-8. But the buffer may end in a partial character, so consider - * it UTF-8 if the first non-UTF8 char is an ending partial */ - if (is_utf8_string_loc((U8 *) s, len, &ep) - || ep + UTF8SKIP(ep) > (U8 *) (s + len)) + * UTF-8. But the buffer may end in a partial character, so if it + * failed, see if the failure was due just to that */ + if ( is_utf8_string_loc((U8 *) s, len, &ep) + || is_utf8_valid_partial_char(ep, (U8 *) s + len)) { if (PL_op->op_type == OP_FTTEXT) { FT_RETURNYES; diff --git a/proto.h b/proto.h index 9047bc6..9a4fa58 100644 --- a/proto.h +++ b/proto.h @@ -1321,13 +1321,13 @@ PERL_CALLCONV bool Perl_isIDFIRST_lazy(pTHX_ const char* p) #define PERL_ARGS_ASSERT_ISIDFIRST_LAZY \ assert(p) -/* PERL_CALLCONV bool Perl_is_ascii_string(pTHX_ const U8 *s, STRLEN len) - __attribute__warn_unused_result__; */ +/* PERL_CALLCONV bool Perl_is_ascii_string(const U8* const s, const STRLEN len) + __attribute__warn_unused_result__ + __attribute__pure__; */ -PERL_CALLCONV bool Perl_is_invariant_string(const U8 *s, STRLEN len) - __attribute__warn_unused_result__; -#define PERL_ARGS_ASSERT_IS_INVARIANT_STRING \ - assert(s) +/* PERL_CALLCONV bool Perl_is_invariant_string(const U8* const s, const STRLEN len) + __attribute__warn_unused_result__ + __attribute__pure__; */ PERL_CALLCONV I32 Perl_is_lvalue_sub(pTHX) __attribute__warn_unused_result__; @@ -1552,6 +1552,12 @@ PERL_CALLCONV bool Perl_is_utf8_idfirst(pTHX_ const U8 *p) #define PERL_ARGS_ASSERT_IS_UTF8_IDFIRST \ assert(p) +PERL_STATIC_INLINE bool S_is_utf8_invariant_string(const U8* const s, STRLEN const len) + __attribute__warn_unused_result__ + __attribute__pure__; +#define PERL_ARGS_ASSERT_IS_UTF8_INVARIANT_STRING \ + assert(s) + PERL_CALLCONV bool Perl_is_utf8_lower(pTHX_ const U8 *p) __attribute__deprecated__ __attribute__warn_unused_result__; @@ -1600,15 +1606,17 @@ PERL_CALLCONV bool Perl_is_utf8_space(pTHX_ const U8 *p) #define PERL_ARGS_ASSERT_IS_UTF8_SPACE \ assert(p) -PERL_CALLCONV bool Perl_is_utf8_string(const U8 *s, STRLEN len); +PERL_STATIC_INLINE bool Perl_is_utf8_string(const U8 *s, STRLEN len) + __attribute__pure__; #define PERL_ARGS_ASSERT_IS_UTF8_STRING \ assert(s) + #ifndef NO_MATHOMS PERL_CALLCONV bool Perl_is_utf8_string_loc(const U8 *s, STRLEN len, const U8 **ep); #define PERL_ARGS_ASSERT_IS_UTF8_STRING_LOC \ - assert(s) + assert(s); assert(ep) #endif -PERL_CALLCONV bool Perl_is_utf8_string_loclen(const U8 *s, STRLEN len, const U8 **ep, STRLEN *el); +PERL_STATIC_INLINE bool Perl_is_utf8_string_loclen(const U8 *s, STRLEN len, const U8 **ep, STRLEN *el); #define PERL_ARGS_ASSERT_IS_UTF8_STRING_LOCLEN \ assert(s) PERL_CALLCONV bool Perl_is_utf8_upper(pTHX_ const U8 *p) @@ -1617,6 +1625,11 @@ PERL_CALLCONV bool Perl_is_utf8_upper(pTHX_ const U8 *p) #define PERL_ARGS_ASSERT_IS_UTF8_UPPER \ assert(p) +PERL_STATIC_INLINE bool S_is_utf8_valid_partial_char(const U8 * const s, const U8 * const e) + __attribute__pure__; +#define PERL_ARGS_ASSERT_IS_UTF8_VALID_PARTIAL_CHAR \ + assert(s); assert(e) + PERL_CALLCONV bool Perl_is_utf8_xdigit(pTHX_ const U8 *p) __attribute__deprecated__ __attribute__warn_unused_result__; @@ -3446,13 +3459,13 @@ PERL_CALLCONV U8* Perl_utf16_to_utf8(pTHX_ U8* p, U8 *d, I32 bytelen, I32 *newle PERL_CALLCONV U8* Perl_utf16_to_utf8_reversed(pTHX_ U8* p, U8 *d, I32 bytelen, I32 *newlen); #define PERL_ARGS_ASSERT_UTF16_TO_UTF8_REVERSED \ assert(p); assert(d); assert(newlen) -PERL_CALLCONV IV Perl_utf8_distance(pTHX_ const U8 *a, const U8 *b) +PERL_STATIC_INLINE IV Perl_utf8_distance(pTHX_ const U8 *a, const U8 *b) __attribute__warn_unused_result__ __attribute__pure__; #define PERL_ARGS_ASSERT_UTF8_DISTANCE \ assert(a); assert(b) -PERL_CALLCONV U8* Perl_utf8_hop(const U8 *s, SSize_t off) +PERL_STATIC_INLINE U8* Perl_utf8_hop(const U8 *s, SSize_t off) __attribute__warn_unused_result__ __attribute__pure__; #define PERL_ARGS_ASSERT_UTF8_HOP \ @@ -3503,9 +3516,11 @@ PERL_CALLCONV U8* Perl_uvuni_to_utf8(pTHX_ U8 *d, UV uv); PERL_CALLCONV U8* Perl_uvuni_to_utf8_flags(pTHX_ U8 *d, UV uv, UV flags); #define PERL_ARGS_ASSERT_UVUNI_TO_UTF8_FLAGS \ assert(d) -PERL_CALLCONV UV Perl_valid_utf8_to_uvchr(pTHX_ const U8 *s, STRLEN *retlen); +PERL_STATIC_INLINE UV Perl_valid_utf8_to_uvchr(const U8 *s, STRLEN *retlen) + __attribute__warn_unused_result__; #define PERL_ARGS_ASSERT_VALID_UTF8_TO_UVCHR \ assert(s) + PERL_CALLCONV UV Perl_valid_utf8_to_uvuni(pTHX_ const U8 *s, STRLEN *retlen) __attribute__deprecated__; #define PERL_ARGS_ASSERT_VALID_UTF8_TO_UVUNI \ @@ -3792,10 +3807,11 @@ STATIC SV * S_incpush_if_exists(pTHX_ AV *const av, SV *dir, SV *const stem); # endif #endif #if !defined(PERL_NO_INLINE_FUNCTIONS) -PERL_STATIC_INLINE STRLEN S__is_utf8_char_slow(const U8 *s, const U8 *e) - __attribute__warn_unused_result__; +PERL_CALLCONV STRLEN Perl__is_utf8_char_slow(const U8 * const s, const STRLEN len) + __attribute__warn_unused_result__ + __attribute__pure__; #define PERL_ARGS_ASSERT__IS_UTF8_CHAR_SLOW \ - assert(s); assert(e) + assert(s) PERL_STATIC_INLINE void S_append_utf8_from_native_byte(const U8 byte, U8** dest); #define PERL_ARGS_ASSERT_APPEND_UTF8_FROM_NATIVE_BYTE \ diff --git a/regcharclass.h b/regcharclass.h index 845df79..761f081 100644 --- a/regcharclass.h +++ b/regcharclass.h @@ -171,16 +171,16 @@ \p{_Perl_Nchar} */ /*** GENERATED CODE ***/ -#define is_NONCHAR_utf8(s) \ -( ( 0xEF == ((U8*)s)[0] ) ? \ - ( ( 0xB7 == ((U8*)s)[1] ) ? \ - ( ( 0x90 <= ((U8*)s)[2] && ((U8*)s)[2] <= 0xAF ) ? 3 : 0 ) \ - : ( ( 0xBF == ((U8*)s)[1] ) && ( ((U8*)s)[2] >= 0xBE ) ) ? 3 : 0 ) \ -: ( 0xF0 == ((U8*)s)[0] ) ? \ - ( ( ( ( ((U8*)s)[1] == 0x9F || ( ( ((U8*)s)[1] & 0xEF ) == 0xAF ) ) && ( 0xBF == ((U8*)s)[2] ) ) && ( ((U8*)s)[3] >= 0xBE ) ) ? 4 : 0 )\ -: ( 0xF1 <= ((U8*)s)[0] && ((U8*)s)[0] <= 0xF3 ) ? \ - ( ( ( ( ( ((U8*)s)[1] & 0xCF ) == 0x8F ) && ( 0xBF == ((U8*)s)[2] ) ) && ( ((U8*)s)[3] >= 0xBE ) ) ? 4 : 0 )\ -: ( ( ( ( 0xF4 == ((U8*)s)[0] ) && ( 0x8F == ((U8*)s)[1] ) ) && ( 0xBF == ((U8*)s)[2] ) ) && ( ((U8*)s)[3] >= 0xBE ) ) ? 4 : 0 ) +#define is_NONCHAR_utf8_safe(s,e) \ +( ( ( LIKELY((e) > (s)) ) && ( LIKELY(((e) - (s)) >= UTF8SKIP(s)) ) ) ? ( ( 0xEF == ((U8*)s)[0] ) ?\ + ( ( 0xB7 == ((U8*)s)[1] ) ? \ + ( ( 0x90 <= ((U8*)s)[2] && ((U8*)s)[2] <= 0xAF ) ? 3 : 0 ) \ + : ( ( 0xBF == ((U8*)s)[1] ) && ( ( ((U8*)s)[2] & 0xFE ) == 0xBE ) ) ? 3 : 0 )\ + : ( 0xF0 == ((U8*)s)[0] ) ? \ + ( ( ( ( ((U8*)s)[1] == 0x9F || ( ( ((U8*)s)[1] & 0xEF ) == 0xAF ) ) && ( 0xBF == ((U8*)s)[2] ) ) && ( ( ((U8*)s)[3] & 0xFE ) == 0xBE ) ) ? 4 : 0 )\ + : ( 0xF1 <= ((U8*)s)[0] && ((U8*)s)[0] <= 0xF3 ) ? \ + ( ( ( ( ( ((U8*)s)[1] & 0xCF ) == 0x8F ) && ( 0xBF == ((U8*)s)[2] ) ) && ( ( ((U8*)s)[3] & 0xFE ) == 0xBE ) ) ? 4 : 0 )\ + : ( ( ( ( 0xF4 == ((U8*)s)[0] ) && ( 0x8F == ((U8*)s)[1] ) ) && ( 0xBF == ((U8*)s)[2] ) ) && ( ( ((U8*)s)[3] & 0xFE ) == 0xBE ) ) ? 4 : 0 ) : 0 ) /* SURROGATE: Surrogate characters @@ -188,8 +188,8 @@ \p{_Perl_Surrogate} */ /*** GENERATED CODE ***/ -#define is_SURROGATE_utf8(s) \ -( ( ( 0xED == ((U8*)s)[0] ) && ( ((U8*)s)[1] >= 0xA0 ) ) ? 3 : 0 ) +#define is_SURROGATE_utf8_safe(s,e) \ +( ( ( ( ( ((e) - (s)) >= 3 ) && ( 0xED == ((U8*)s)[0] ) ) && ( ( ((U8*)s)[1] & 0xE0 ) == 0xA0 ) ) && ( ( ((U8*)s)[2] & 0xC0 ) == 0x80 ) ) ? 3 : 0 ) /* QUOTEMETA: Meta-characters that \Q should quote @@ -764,20 +764,20 @@ \p{_Perl_Nchar} */ /*** GENERATED CODE ***/ -#define is_NONCHAR_utf8(s) \ -( ( 0xDD == ((U8*)s)[0] ) ? \ - ( ( 0x73 == ((U8*)s)[1] ) ? \ - ( ( 0x55 == ((U8*)s)[2] ) ? \ - ( ( ( 0x57 <= ((U8*)s)[3] && ((U8*)s)[3] <= 0x59 ) || ( 0x62 <= ((U8*)s)[3] && ((U8*)s)[3] <= 0x6A ) || ( ((U8*)s)[3] & 0xFC ) == 0x70 ) ? 4 : 0 )\ - : ( 0x56 == ((U8*)s)[2] ) ? \ - ( ( ( 0x41 <= ((U8*)s)[3] && ((U8*)s)[3] <= 0x4A ) || ( 0x51 <= ((U8*)s)[3] && ((U8*)s)[3] <= 0x56 ) ) ? 4 : 0 )\ - : ( ( 0x73 == ((U8*)s)[2] ) && ( ( ((U8*)s)[3] & 0xFE ) == 0x72 ) ) ? 4 : 0 )\ - : 0 ) \ -: ( 0xDF == ((U8*)s)[0] || 0xEA == ((U8*)s)[0] || 0xEC == ((U8*)s)[0] ) ? \ - ( ( ( ( 0x73 == ((U8*)s)[1] ) && ( 0x73 == ((U8*)s)[2] ) ) && ( ( ((U8*)s)[3] & 0xFE ) == 0x72 ) ) ? 4 : 0 )\ -: ( 0xED == ((U8*)s)[0] ) ? \ - ( ( ( ( ( ((U8*)s)[1] == 0x4A || ((U8*)s)[1] == 0x52 || ( ( ((U8*)s)[1] & 0xFD ) == 0x54 ) || ((U8*)s)[1] == 0x58 || ((U8*)s)[1] == 0x62 || ( ( ((U8*)s)[1] & 0xFD ) == 0x64 ) || ( ( ((U8*)s)[1] & ... [166 chars truncated] -: ( ( ( ( ( 0xEE == ((U8*)s)[0] ) && ( 0x42 == ((U8*)s)[1] ) ) && ( 0x73 == ((U8*)s)[2] ) ) && ( 0x73 == ((U8*)s)[3] ) ) && ( ( ((U8*)s)[4] & 0xFE ) == 0x72 ) ) ? 5 : 0 ) +#define is_NONCHAR_utf8_safe(s,e) \ +( ( ( LIKELY((e) > (s)) ) && ( LIKELY(((e) - (s)) >= UTF8SKIP(s)) ) ) ? ( ( 0xDD == ((U8*)s)[0] ) ?\ + ( ( 0x73 == ((U8*)s)[1] ) ? \ + ( ( 0x55 == ((U8*)s)[2] ) ? \ + ( ( ( 0x57 <= ((U8*)s)[3] && ((U8*)s)[3] <= 0x59 ) || ( 0x62 <= ((U8*)s)[3] && ((U8*)s)[3] <= 0x6A ) || ( ((U8*)s)[3] & 0xFC ) == 0x70 ) ? 4 : 0 )\ + : ( 0x56 == ((U8*)s)[2] ) ? \ + ( ( ( 0x41 <= ((U8*)s)[3] && ((U8*)s)[3] <= 0x4A ) || ( 0x51 <= ((U8*)s)[3] && ((U8*)s)[3] <= 0x56 ) ) ? 4 : 0 )\ + : ( ( 0x73 == ((U8*)s)[2] ) && ( ( ((U8*)s)[3] & 0xFE ) == 0x72 ) ) ? 4 : 0 )\ + : 0 ) \ + : ( 0xDF == ((U8*)s)[0] || 0xEA == ((U8*)s)[0] || 0xEC == ((U8*)s)[0] ) ?\ + ( ( ( ( 0x73 == ((U8*)s)[1] ) && ( 0x73 == ((U8*)s)[2] ) ) && ( ( ((U8*)s)[3] & 0xFE ) == 0x72 ) ) ? 4 : 0 )\ + : ( 0xED == ((U8*)s)[0] ) ? \ + ( ( ( ( ( ((U8*)s)[1] == 0x4A || ((U8*)s)[1] == 0x52 || ( ( ((U8*)s)[1] & 0xFD ) == 0x54 ) || ((U8*)s)[1] == 0x58 || ((U8*)s)[1] == 0x62 || ( ( ((U8*)s)[1] & 0xFD ) == 0x64 ) || ( ( ((U8*)s)[1] ... [167 chars truncated] + : ( ( ( ( ( 0xEE == ((U8*)s)[0] ) && ( 0x42 == ((U8*)s)[1] ) ) && ( 0x73 == ((U8*)s)[2] ) ) && ( 0x73 == ((U8*)s)[3] ) ) && ( ( ((U8*)s)[4] & 0xFE ) == 0x72 ) ) ? 5 : 0 ) : 0 ) /* SURROGATE: Surrogate characters @@ -785,8 +785,8 @@ \p{_Perl_Surrogate} */ /*** GENERATED CODE ***/ -#define is_SURROGATE_utf8(s) \ -( ( ( ( ( 0xDD == ((U8*)s)[0] ) && ( 0x65 == ((U8*)s)[1] || 0x66 == ((U8*)s)[1] ) ) && ( ( 0x41 <= ((U8*)s)[2] && ((U8*)s)[2] <= 0x4A ) || ( 0x51 <= ((U8*)s)[2] && ((U8*)s)[2] <= 0x59 ) || ( 0x62 <= ... [274 chars truncated] +#define is_SURROGATE_utf8_safe(s,e) \ +( ( ( ( ( ( ((e) - (s)) >= 4 ) && ( 0xDD == ((U8*)s)[0] ) ) && ( 0x65 == ((U8*)s)[1] || 0x66 == ((U8*)s)[1] ) ) && ( ( 0x41 <= ((U8*)s)[2] && ((U8*)s)[2] <= 0x4A ) || ( 0x51 <= ((U8*)s)[2] && ((U8*)s ... [302 chars truncated] /* UTF8_CHAR: Matches legal UTF-EBCDIC encoded characters from 2 through 3 bytes @@ -1376,20 +1376,20 @@ \p{_Perl_Nchar} */ /*** GENERATED CODE ***/ -#define is_NONCHAR_utf8(s) \ -( ( 0xDD == ((U8*)s)[0] ) ? \ - ( ( 0x72 == ((U8*)s)[1] ) ? \ - ( ( 0x55 == ((U8*)s)[2] ) ? \ - ( ( ( 0x57 <= ((U8*)s)[3] && ((U8*)s)[3] <= 0x59 ) || 0x5F == ((U8*)s)[3] || ( 0x62 <= ((U8*)s)[3] && ((U8*)s)[3] <= 0x6A ) || ( 0x70 <= ((U8*)s)[3] && ((U8*)s)[3] <= 0x72 ) ) ? 4 : 0 )\ - : ( 0x56 == ((U8*)s)[2] ) ? \ - ( ( ( 0x41 <= ((U8*)s)[3] && ((U8*)s)[3] <= 0x4A ) || ( 0x51 <= ((U8*)s)[3] && ((U8*)s)[3] <= 0x56 ) ) ? 4 : 0 )\ - : ( ( 0x72 == ((U8*)s)[2] ) && ( 0x71 == ((U8*)s)[3] || 0x72 == ((U8*)s)[3] ) ) ? 4 : 0 )\ - : 0 ) \ -: ( 0xDF == ((U8*)s)[0] || 0xEA == ((U8*)s)[0] || 0xEC == ((U8*)s)[0] ) ? \ - ( ( ( ( 0x72 == ((U8*)s)[1] ) && ( 0x72 == ((U8*)s)[2] ) ) && ( 0x71 == ((U8*)s)[3] || 0x72 == ((U8*)s)[3] ) ) ? 4 : 0 )\ -: ( 0xED == ((U8*)s)[0] ) ? \ - ( ( ( ( ( ((U8*)s)[1] == 0x4A || ((U8*)s)[1] == 0x52 || ( ( ((U8*)s)[1] & 0xFD ) == 0x54 ) || ((U8*)s)[1] == 0x58 || ((U8*)s)[1] == 0x5F || ((U8*)s)[1] == 0x63 || ( ( ((U8*)s)[1] & 0xFD ) == 0x65 ... [186 chars truncated] -: ( ( ( ( ( 0xEE == ((U8*)s)[0] ) && ( 0x42 == ((U8*)s)[1] ) ) && ( 0x72 == ((U8*)s)[2] ) ) && ( 0x72 == ((U8*)s)[3] ) ) && ( 0x71 == ((U8*)s)[4] || 0x72 == ((U8*)s)[4] ) ) ? 5 : 0 ) +#define is_NONCHAR_utf8_safe(s,e) \ +( ( ( LIKELY((e) > (s)) ) && ( LIKELY(((e) - (s)) >= UTF8SKIP(s)) ) ) ? ( ( 0xDD == ((U8*)s)[0] ) ?\ + ( ( 0x72 == ((U8*)s)[1] ) ? \ + ( ( 0x55 == ((U8*)s)[2] ) ? \ + ( ( ( 0x57 <= ((U8*)s)[3] && ((U8*)s)[3] <= 0x59 ) || 0x5F == ((U8*)s)[3] || ( 0x62 <= ((U8*)s)[3] && ((U8*)s)[3] <= 0x6A ) || ( 0x70 <= ((U8*)s)[3] && ((U8*)s)[3] <= 0x72 ) ) ? 4 : 0 )\ + : ( 0x56 == ((U8*)s)[2] ) ? \ + ( ( ( 0x41 <= ((U8*)s)[3] && ((U8*)s)[3] <= 0x4A ) || ( 0x51 <= ((U8*)s)[3] && ((U8*)s)[3] <= 0x56 ) ) ? 4 : 0 )\ + : ( ( 0x72 == ((U8*)s)[2] ) && ( 0x71 == ((U8*)s)[3] || 0x72 == ((U8*)s)[3] ) ) ? 4 : 0 )\ + : 0 ) \ + : ( 0xDF == ((U8*)s)[0] || 0xEA == ((U8*)s)[0] || 0xEC == ((U8*)s)[0] ) ?\ + ( ( ( ( 0x72 == ((U8*)s)[1] ) && ( 0x72 == ((U8*)s)[2] ) ) && ( 0x71 == ((U8*)s)[3] || 0x72 == ((U8*)s)[3] ) ) ? 4 : 0 )\ + : ( 0xED == ((U8*)s)[0] ) ? \ + ( ( ( ( ( ((U8*)s)[1] == 0x4A || ((U8*)s)[1] == 0x52 || ( ( ((U8*)s)[1] & 0xFD ) == 0x54 ) || ((U8*)s)[1] == 0x58 || ((U8*)s)[1] == 0x5F || ((U8*)s)[1] == 0x63 || ( ( ((U8*)s)[1] & 0xFD ) == 0x6 ... [187 chars truncated] + : ( ( ( ( ( 0xEE == ((U8*)s)[0] ) && ( 0x42 == ((U8*)s)[1] ) ) && ( 0x72 == ((U8*)s)[2] ) ) && ( 0x72 == ((U8*)s)[3] ) ) && ( 0x71 == ((U8*)s)[4] || 0x72 == ((U8*)s)[4] ) ) ? 5 : 0 ) : 0 ) /* SURROGATE: Surrogate characters @@ -1397,8 +1397,8 @@ \p{_Perl_Surrogate} */ /*** GENERATED CODE ***/ -#define is_SURROGATE_utf8(s) \ -( ( ( ( ( 0xDD == ((U8*)s)[0] ) && ( ( ((U8*)s)[1] & 0xFE ) == 0x64 ) ) && ( ( 0x41 <= ((U8*)s)[2] && ((U8*)s)[2] <= 0x4A ) || ( 0x51 <= ((U8*)s)[2] && ((U8*)s)[2] <= 0x59 ) || 0x5F == ((U8*)s)[2] || ... [340 chars truncated] +#define is_SURROGATE_utf8_safe(s,e) \ +( ( ( ( ( ( ((e) - (s)) >= 4 ) && ( 0xDD == ((U8*)s)[0] ) ) && ( ( ((U8*)s)[1] & 0xFE ) == 0x64 ) ) && ( ( 0x41 <= ((U8*)s)[2] && ((U8*)s)[2] <= 0x4A ) || ( 0x51 <= ((U8*)s)[2] && ((U8*)s)[2] <= 0x59 ... [368 chars truncated] /* UTF8_CHAR: Matches legal UTF-EBCDIC encoded characters from 2 through 3 bytes @@ -1898,6 +1898,6 @@ * 5c7eb94310e2aaa15702fd6bed24ff0e7ab5448f9a8231d8c49ca96c9e941089 lib/unicore/mktables * cdecb300baad839a6f62791229f551a4fa33f3cbdca08e378dc976466354e778 lib/unicore/version * 913d2f93f3cb6cdf1664db888bf840bc4eb074eef824e082fceda24a9445e60c regen/charset_translations.pl - * d9c04ac46bdd81bb3e26519f2b8eb6242cb12337205add3f7cf092b0c58dccc4 regen/regcharclass.pl + * 863deb27147ca9d19f764755eafddf26d6227b007b1f5b6b87662bcb46cf491c regen/regcharclass.pl * 393f8d882713a3ba227351ad0f00ea4839fda74fcf77dcd1cdf31519925adba5 regen/regcharclass_multi_char_folds.pl * ex: set ro: */ diff --git a/regen/embed.pl b/regen/embed.pl index 6007d92..342e017 100755 --- a/regen/embed.pl +++ b/regen/embed.pl @@ -44,8 +44,8 @@ sub full_name ($$) { # Returns the function name with potentially the # prefixes 'S_' or 'Perl_' my ($func, $flags) = @_; - return "S_$func" if $flags =~ /[si]/; return "Perl_$func" if $flags =~ /p/; + return "S_$func" if $flags =~ /[si]/; return $func; } @@ -92,12 +92,8 @@ my ($embed, $core, $ext, $api) = setup_embed(); warn "It is nonsensical to require the return value of a void function ($plain_func) to be checked"; } - my $scope_type_flag_count = 0; - $scope_type_flag_count++ if $flags =~ /s/; - $scope_type_flag_count++ if $flags =~ /i/; - $scope_type_flag_count++ if $flags =~ /p/; - warn "$plain_func: i, p, and s flags are all mutually exclusive" - if $scope_type_flag_count > 1; + warn "$plain_func: s flag is mutually exclusive from the i and p plags" + if $flags =~ /s/ && $flags =~ /[ip]/; my $splint_flags = ""; if ( $SPLINT && !$commented_out ) { $splint_flags .= '/*@noreturn@*/ ' if $never_returns; diff --git a/regen/regcharclass.pl b/regen/regcharclass.pl index 9115eaf..e22720b 100755 --- a/regen/regcharclass.pl +++ b/regen/regcharclass.pl @@ -1630,11 +1630,11 @@ REPLACEMENT: Unicode REPLACEMENT CHARACTER 0xFFFD NONCHAR: Non character code points -=> UTF8 :fast +=> UTF8 :safe \p{_Perl_Nchar} SURROGATE: Surrogate characters -=> UTF8 :fast +=> UTF8 :safe \p{_Perl_Surrogate} # This program was run with this enabled, and the results copied to utf8.h; diff --git a/sv.c b/sv.c index c4cac80..3e8fb3d 100644 --- a/sv.c +++ b/sv.c @@ -3765,7 +3765,6 @@ Perl_sv_utf8_decode(pTHX_ SV *const sv) if (SvPOKp(sv)) { const U8 *start, *c; - const U8 *e; /* The octets may have got themselves encoded - get them back as * bytes @@ -3779,13 +3778,8 @@ Perl_sv_utf8_decode(pTHX_ SV *const sv) c = start = (const U8 *) SvPVX_const(sv); if (!is_utf8_string(c, SvCUR(sv))) return FALSE; - e = (const U8 *) SvEND(sv); - while (c < e) { - const U8 ch = *c++; - if (!UTF8_IS_INVARIANT(ch)) { - SvUTF8_on(sv); - break; - } + if (! is_utf8_invariant_string(c, SvCUR(sv))) { + SvUTF8_on(sv); } if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) { /* XXX Is this dead code? XS_utf8_decode calls SvSETMAGIC diff --git a/t/lib/warnings/utf8 b/t/lib/warnings/utf8 index 4263c04..947dea4 100644 --- a/t/lib/warnings/utf8 +++ b/t/lib/warnings/utf8 @@ -756,7 +756,6 @@ Operation "uc" returns its argument for non-Unicode code point 0x7F+ at - line \ Use of code point 0x80+ is deprecated; the permissible max is 0x7F+ at - line \d+. Operation "uc" returns its argument for non-Unicode code point 0x80+ at - line \d+. Code point 0x7F+ is not Unicode, may not be portable in print at - line \d+. -Use of code point 0x80+ is deprecated; the permissible max is 0x7F+ in print at - line \d+. ######## # NAME [perl #127262] BEGIN{ diff --git a/toke.c b/toke.c index dbeecd1..2fe8b69 100644 --- a/toke.c +++ b/toke.c @@ -1996,10 +1996,10 @@ STATIC SV * S_newSV_maybe_utf8(pTHX_ const char *const start, STRLEN len) { SV * const sv = newSVpvn_utf8(start, len, - !IN_BYTES - && UTF - && !is_invariant_string((const U8*)start, len) - && is_utf8_string((const U8*)start, len)); + !IN_BYTES + && UTF + && !is_utf8_invariant_string((const U8*)start, len) + && is_utf8_string((const U8*)start, len)); return sv; } diff --git a/utf8.c b/utf8.c index 0b7cbda..0fcb6b6 100644 --- a/utf8.c +++ b/utf8.c @@ -52,42 +52,6 @@ within non-zero characters. */ /* -=for apidoc is_invariant_string - -Returns true iff the first C<len> bytes of the string C<s> are the same -regardless of the UTF-8 encoding of the string (or UTF-EBCDIC encoding on -EBCDIC machines). That is, if they are UTF-8 invariant. On ASCII-ish -machines, all the ASCII characters and only the ASCII characters fit this -definition. On EBCDIC machines, the ASCII-range characters are invariant, but -so also are the C1 controls and C<\c?> (which isn't in the ASCII range on -EBCDIC). - -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>(). - -=cut -*/ - -bool -Perl_is_invariant_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_INVARIANT_STRING; - - for (; x < send; ++x) { - if (!UTF8_IS_INVARIANT(*x)) - break; - } - - return x == send; -} - -/* =for apidoc uvoffuni_to_utf8_flags THIS FUNCTION SHOULD BE USED IN ONLY VERY SPECIALIZED CIRCUMSTANCES. @@ -372,86 +336,119 @@ Perl_uvchr_to_utf8_flags(pTHX_ U8 *d, UV uv, UV flags) } /* -=for apidoc is_utf8_string -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> 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'. +A helper function for the macro isUTF8_CHAR(), which should be used instead of +this function. The macro will handle smaller code points directly saving time, +using this function as a fall-back for higher code points. This function +assumes that it is not called with an invariant character, and that +'s + len - 1' is within bounds of the string 's'. -See also L</is_invariant_string>(), L</is_utf8_string_loclen>(), and L</is_utf8_string_loc>(). +Tests if the string C<s> of at least length 'len' is a valid variant UTF-8 +character. 0 is returned if not, otherwise, 'len' is returned. + +It is written in such a way that if 'len' is set to less than a full +character's length, it will test if the bytes ending there form the legal +beginning of partial character. -=cut */ -bool -Perl_is_utf8_string(const U8 *s, STRLEN len) +STRLEN +Perl__is_utf8_char_slow(const U8 * const s, const STRLEN len) { - const U8* const send = s + (len ? len : strlen((const char *)s)); - const U8* x = s; + const U8 *e; + const U8 *x, *y; - PERL_ARGS_ASSERT_IS_UTF8_STRING; + PERL_ARGS_ASSERT__IS_UTF8_CHAR_SLOW; - while (x < send) { - STRLEN len = isUTF8_CHAR(x, send); - if (UNLIKELY(! len)) { - return FALSE; + if (UNLIKELY(! UTF8_IS_START(*s))) { + return 0; + } + + e = s + len; + + for (x = s + 1; x < e; x++) { + if (UNLIKELY(! UTF8_IS_CONTINUATION(*x))) { + return 0; } - x += len; } - return TRUE; -} +#ifndef EBCDIC -/* -Implemented as a macro in utf8.h + /* Here is syntactically valid. Make sure this isn't the start of an + * overlong. These values were found by manually inspecting the UTF-8 + * patterns. See the tables in utf8.h and utfebcdic.h */ -=for apidoc is_utf8_string_loc + /* This is not needed on modern perls where C0 and C1 are not considered + * start bytes. */ +#if 0 + if (UNLIKELY(*s < 0xC2)) { + return 0; + } +#endif + + if (len > 1) { + if ( (*s == 0xE0 && UNLIKELY(s[1] < 0xA0)) + || (*s == 0xF0 && UNLIKELY(s[1] < 0x90)) + || (*s == 0xF8 && UNLIKELY(s[1] < 0x88)) + || (*s == 0xFC && UNLIKELY(s[1] < 0x84)) + || (*s == 0xFE && UNLIKELY(s[1] < 0x82))) + { + return 0; + } + if ((len > 6 && UNLIKELY(*s == 0xFF) && UNLIKELY(s[6] < 0x81))) { + return 0; + } + } -Like L</is_utf8_string> but stores the location of the failure (in the -case of "utf8ness failure") or the location C<s>+C<len> (in the case of -"utf8ness success") in the C<ep>. +#else /* For EBCDIC, we use I8, which is the same on all code pages */ + { + const U8 s0 = NATIVE_UTF8_TO_I8(*s); -See also L</is_utf8_string_loclen>() and L</is_utf8_string>(). + /* On modern perls C0-C4 aren't considered start bytes */ + if ( /* s0 < 0xC5 || */ s0 == 0xE0) { + return 0; + } -=for apidoc is_utf8_string_loclen + if (len >= 1) { + const U8 s1 = NATIVE_UTF8_TO_I8(s[1]); -Like L</is_utf8_string>() but stores the location of the failure (in the -case of "utf8ness failure") or the location C<s>+C<len> (in the case of -"utf8ness success") in the C<ep>, and the number of UTF-8 -encoded characters in the C<el>. + if ( (s0 == 0xF0 && UNLIKELY(s1 < 0xB0)) + || (s0 == 0xF8 && UNLIKELY(s1 < 0xA8)) + || (s0 == 0xFC && UNLIKELY(s1 < 0xA4)) + || (s0 == 0xFE && UNLIKELY(s1 < 0x82))) + { + return 0; + } + if ((len > 7 && UNLIKELY(s0 == 0xFF) && UNLIKELY(s[7] < 0xA1))) { + return 0; + } + } + } -See also L</is_utf8_string_loc>() and L</is_utf8_string>(). +#endif -=cut -*/ + /* Now see if this would overflow a UV on this platform. See if the UTF8 + * for this code point is larger than that for the highest representable + * code point */ + y = (const U8 *) HIGHEST_REPRESENTABLE_UTF8; -bool -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; + for (x = s; x < e; x++, y++) { - PERL_ARGS_ASSERT_IS_UTF8_STRING_LOCLEN; + /* If the same at this byte, go on to the next */ + if (UNLIKELY(NATIVE_UTF8_TO_I8(*x) == *y)) { + continue; + } - while (x < send) { - STRLEN len = isUTF8_CHAR(x, send); - if (UNLIKELY(! len)) { - goto out; + /* If this is larger, it overflows */ + if (UNLIKELY(NATIVE_UTF8_TO_I8(*x) > *y)) { + return 0; } - x += len; - outlen++; - } - out: - if (el) - *el = outlen; + /* But if smaller, it won't */ + break; + } - if (ep) - *ep = x; - return (x == send); + return len; } /* @@ -947,6 +944,9 @@ Code points above the platform's C<IV_MAX> will raise a deprecation warning, unless those are turned off. =cut + +Also implemented as a macro in utf8.h + */ @@ -959,49 +959,8 @@ Perl_utf8_to_uvchr_buf(pTHX_ const U8 *s, const U8 *send, STRLEN *retlen) ckWARN_d(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY); } -/* 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. */ - -UV -Perl_valid_utf8_to_uvchr(pTHX_ const U8 *s, STRLEN *retlen) -{ - UV expectlen = UTF8SKIP(s); - const U8* send = s + expectlen; - UV uv = *s; - - PERL_ARGS_ASSERT_VALID_UTF8_TO_UVCHR; - PERL_UNUSED_CONTEXT; - - if (retlen) { - *retlen = expectlen; - } - - /* An invariant is trivially returned */ - if (expectlen == 1) { - return uv; - } - -#ifdef EBCDIC - uv = NATIVE_UTF8_TO_I8(uv); -#endif - - /* Remove the leading bits that indicate the number of bytes, leaving just - * the bits that are part of the value */ - uv &= UTF_START_MASK(expectlen); - - /* Now, loop through the remaining bytes, accumulating each into the - * working total as we go. (I khw tried unrolling the loop for up to 4 - * bytes, but there was no performance improvement) */ - for (++s; s < send; s++) { - uv = UTF8_ACCUMULATE(uv, *s); - } - - return UNI_TO_NATIVE(uv); - -} - -/* +/* This is marked as deprecated + * =for apidoc utf8_to_uvuni_buf Only in very rare circumstances should code need to be dealing in Unicode @@ -1034,9 +993,8 @@ Perl_utf8_to_uvuni_buf(pTHX_ const U8 *s, const U8 *send, STRLEN *retlen) assert(send > s); - /* Call the low level routine asking for checks */ - return NATIVE_TO_UNI(Perl_utf8n_to_uvchr(aTHX_ s, send -s, retlen, - ckWARN_d(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY)); + /* Call the low level routine, asking for checks */ + return NATIVE_TO_UNI(utf8_to_uvchr_buf(s, send, retlen)); } /* @@ -1081,62 +1039,6 @@ Perl_utf8_length(pTHX_ const U8 *s, const U8 *e) } /* -=for apidoc utf8_distance - -Returns the number of UTF-8 characters between the UTF-8 pointers C<a> -and C<b>. - -WARNING: use only if you *know* that the pointers point inside the -same UTF-8 buffer. - -=cut -*/ - -IV -Perl_utf8_distance(pTHX_ const U8 *a, const U8 *b) -{ - PERL_ARGS_ASSERT_UTF8_DISTANCE; - - return (a < b) ? -1 * (IV) utf8_length(a, b) : (IV) utf8_length(b, a); -} - -/* -=for apidoc utf8_hop - -Return the UTF-8 pointer C<s> displaced by C<off> characters, either -forward or backward. - -WARNING: do not use the following unless you *know* C<off> is within -the UTF-8 data pointed to by C<s> *and* that on entry C<s> is aligned -on the first byte of character or just after the last byte of a character. - -=cut -*/ - -U8 * -Perl_utf8_hop(const U8 *s, SSize_t off) -{ - PERL_ARGS_ASSERT_UTF8_HOP; - - /* Note: cannot use UTF8_IS_...() too eagerly here since e.g - * the bitops (especially ~) can create illegal UTF-8. - * In other words: in Perl UTF-8 is not just for Unicode. */ - - if (off >= 0) { - while (off--) - s += UTF8SKIP(s); - } - else { - while (off++) { - s--; - while (UTF8_IS_CONTINUATION(*s)) - s--; - } - } - return (U8 *)s; -} - -/* =for apidoc bytes_cmp_utf8 Compares the sequence of characters (stored as octets) in C<b>, C<blen> with the diff --git a/utf8.h b/utf8.h index ee2d97e..30b7193 100644 --- a/utf8.h +++ b/utf8.h @@ -50,14 +50,21 @@ Search for the string "utf8" in this document. =for apidoc is_ascii_string -This is a misleadingly-named synonym for L</is_invariant_string>. +This is a misleadingly-named synonym for L</is_utf8_invariant_string>. On ASCII-ish platforms, the name isn't misleading: the ASCII-range characters are exactly the UTF-8 invariants. But EBCDIC machines have more invariants -than just the ASCII characters, so C<is_invariant_string> is preferred. +than just the ASCII characters, so C<is_utf8_invariant_string> is preferred. + +=for apidoc is_invariant_string + +This is a somewhat misleadingly-named synonym for L</is_utf8_invariant_string>. +C<is_utf8_invariant_string> is preferred, as it indicates under what conditions +the string is invariant. =cut */ -#define is_ascii_string(s, len) is_invariant_string(s, len) +#define is_ascii_string(s, len) is_utf8_invariant_string(s, len) +#define is_invariant_string(s, len) is_utf8_invariant_string(s, len) #define uvchr_to_utf8(a,b) uvchr_to_utf8_flags(a,b,0) #define uvchr_to_utf8_flags(d,uv,flags) \ @@ -169,24 +176,30 @@ END_EXTERN_C /* - The following table is from Unicode 3.2. + The following table is from Unicode 3.2, plus the Perl extensions for above + U+10FFFF - Code Points 1st Byte 2nd Byte 3rd Byte 4th Byte + Code Points 1st Byte 2nd Byte 3rd 4th 5th 6th 7th 8th-13th U+0000..U+007F 00..7F U+0080..U+07FF * C2..DF 80..BF - U+0800..U+0FFF E0 * A0..BF 80..BF - U+1000..U+CFFF E1..EC 80..BF 80..BF - U+D000..U+D7FF ED 80..9F 80..BF - U+D800..U+DFFF ED A0..BF 80..BF (surrogates) - U+E000..U+FFFF EE..EF 80..BF 80..BF - U+10000..U+3FFFF F0 * 90..BF 80..BF 80..BF - U+40000..U+FFFFF F1..F3 80..BF 80..BF 80..BF - U+100000..U+10FFFF F4 80..8F 80..BF 80..BF - Below are non-Unicode code points - U+110000..U+13FFFF F4 90..BF 80..BF 80..BF - U+110000..U+1FFFFF F5..F7 80..BF 80..BF 80..BF - U+200000..: F8.. * 88..BF 80..BF 80..BF 80..BF + U+0800..U+0FFF E0 * A0..BF 80..BF + U+1000..U+CFFF E1..EC 80..BF 80..BF + U+D000..U+D7FF ED 80..9F 80..BF + U+D800..U+DFFF ED A0..BF 80..BF (surrogates) + U+E000..U+FFFF EE..EF 80..BF 80..BF + U+10000..U+3FFFF F0 * 90..BF 80..BF 80..BF + U+40000..U+FFFFF F1..F3 80..BF 80..BF 80..BF + U+100000..U+10FFFF F4 80..8F 80..BF 80..BF + Below are above-Unicode code points + U+110000..U+13FFFF F4 90..BF 80..BF 80..BF + U+110000..U+1FFFFF F5..F7 80..BF 80..BF 80..BF + U+200000..U+FFFFFF F8 * 88..BF 80..BF 80..BF 80..BF +U+1000000..U+3FFFFFF F9..FB 80..BF 80..BF 80..BF 80..BF +U+4000000..U+3FFFFFFF FC * 84..BF 80..BF 80..BF 80..BF 80..BF +U+40000000..U+7FFFFFFF FD 80..BF 80..BF 80..BF 80..BF 80..BF +U+80000000..U+FFFFFFFFF FE * 82..BF 80..BF 80..BF 80..BF 80..BF 80..BF +U+1000000000.. FF 80..BF 80..BF 80..BF 80..BF 80..BF * 81..BF 80..BF Note the gaps before several of the byte entries above marked by '*'. These are caused by legal UTF-8 avoiding non-shortest encodings: it is technically @@ -214,6 +227,13 @@ Perl's extended UTF-8 means we can have start bytes up to FF. */ +/* Anything larger than this will overflow the word if it were converted into a UV */ +#if defined(UV_IS_QUAD) +# define HIGHEST_REPRESENTABLE_UTF8 "\xFF\x80\x8F\xBF\xBF\xBF\xBF\xBF\xBF\xBF\xBF\xBF\xBF" +#else +# define HIGHEST_REPRESENTABLE_UTF8 "\xFE\x83\xBF\xBF\xBF\xBF\xBF" +#endif + /* Is the representation of the Unicode code point 'cp' the same regardless of * being encoded in UTF-8 or not? */ #define OFFUNI_IS_INVARIANT(cp) isASCII(cp) @@ -632,33 +652,81 @@ case any call to string overloading updates the internal UTF-8 encoding flag. #define UTF8_ALLOW_DEFAULT (ckWARN(WARN_UTF8) ? 0 : \ UTF8_ALLOW_ANYUV) -/* Several of the macros below have a second parameter that is currently - * unused; but could be used in the future to make sure that the input is - * well-formed. */ +/* +=for apidoc Am|bool|UTF8_IS_SURROGATE|const U8 *s|const U8 *e + +Evaluates to non-zero if the first few bytes of the string starting at C<s> and +looking no further than S<C<e - 1>> are well-formed UTF-8 that represents one +of the Unicode surrogate code points; otherwise it evaluates to 0. If +non-zero, the value gives how many bytes starting at C<s> comprise the code +point's representation. + +=cut + */ +#define UTF8_IS_SURROGATE(s, e) is_SURROGATE_utf8_safe(s, e) + + +#define UTF8_IS_REPLACEMENT(s, send) is_REPLACEMENT_utf8_safe(s,send) + +/* +=for apidoc Am|bool|UTF8_IS_SUPER|const U8 *s|const U8 *e + +Recall that Perl recognizes an extension to UTF-8 that can encode code +points larger than the ones defined by Unicode, which are 0..0x10FFFF. -#define UTF8_IS_SURROGATE(s, e) cBOOL(is_SURROGATE_utf8(s)) -#define UTF8_IS_REPLACEMENT(s, send) cBOOL(is_REPLACEMENT_utf8_safe(s,send)) +This macro evaluates to non-zero if the first few bytes of the string starting +at C<s> and looking no further than S<C<e - 1>> are from this UTF-8 extension; +otherwise it evaluates to 0. If non-zero, the value gives how many bytes +starting at C<s> comprise the code point's representation. -/* ASCII EBCDIC I8 +0 is returned if the bytes are not well-formed extended UTF-8, or if they +represent a code point that cannot fit in a UV on the current platform. Hence +this macro can give different results when run on a 64-bit word machine than on +one with a 32-bit word size. + +Note that it is deprecated to have code points that are larger than what can +fit in an IV on the current machine. + +=cut + + * ASCII EBCDIC I8 * U+10FFFF: \xF4\x8F\xBF\xBF \xF9\xA1\xBF\xBF\xBF max legal Unicode * U+110000: \xF4\x90\x80\x80 \xF9\xA2\xA0\xA0\xA0 * U+110001: \xF4\x90\x80\x81 \xF9\xA2\xA0\xA0\xA1 - * - * BE AWARE that this test doesn't rule out malformed code points, in - * particular overlongs */ -#ifdef EBCDIC /* Both versions assume well-formed UTF8 */ -# define UTF8_IS_SUPER(s, e) (NATIVE_UTF8_TO_I8(* (U8*) (s)) >= 0xF9 \ - && (NATIVE_UTF8_TO_I8(* (U8*) (s)) > 0xF9 \ - || (NATIVE_UTF8_TO_I8(* ((U8*) (s) + 1)) >= 0xA2))) + */ +#ifdef EBCDIC +# define UTF8_IS_SUPER(s, e) \ + (( LIKELY((e) > (s) + 4) \ + && NATIVE_UTF8_TO_I8(*(s)) >= 0xF9 \ + && ( NATIVE_UTF8_TO_I8(*(s)) > 0xF9 \ + || (NATIVE_UTF8_TO_I8(*(s) + 1) >= 0xA2)) \ + && LIKELY((s) + UTF8SKIP(s) <= (e))) \ + ? _is_utf8_char_slow(s, UTF8SKIP(s)) : 0) #else -# define UTF8_IS_SUPER(s, e) (*(U8*) (s) >= 0xF4 \ - && (*(U8*) (s) > 0xF4 || (*((U8*) (s) + 1) >= 0x90))) +# define UTF8_IS_SUPER(s, e) \ + (( LIKELY((e) > (s) + 3) \ + && (*(U8*) (s)) >= 0xF4 \ + && ((*(U8*) (s)) > 0xF4 || (*((U8*) (s) + 1) >= 0x90))\ + && LIKELY((s) + UTF8SKIP(s) <= (e))) \ + ? _is_utf8_char_slow(s, UTF8SKIP(s)) : 0) #endif /* These are now machine generated, and the 'given' clause is no longer * applicable */ #define UTF8_IS_NONCHAR_GIVEN_THAT_NON_SUPER_AND_GE_PROBLEMATIC(s, e) \ - cBOOL(is_NONCHAR_utf8(s)) + cBOOL(is_NONCHAR_utf8_safe(s,e)) + +/* +=for apidoc Am|bool|UTF8_IS_NONCHAR|const U8 *s|const U8 *e + +Evaluates to non-zero if the first few bytes of the string starting at C<s> and +looking no further than S<C<e - 1>> are well-formed UTF-8 that represents one +of the Unicode non-character code points; otherwise it evaluates to 0. If +non-zero, the value gives how many bytes starting at C<s> comprise the code +point's representation. + +=cut + */ #define UTF8_IS_NONCHAR(s, e) \ UTF8_IS_NONCHAR_GIVEN_THAT_NON_SUPER_AND_GE_PROBLEMATIC(s, e) @@ -772,10 +840,12 @@ case any call to string overloading updates the internal UTF-8 encoding flag. #ifndef EBCDIC /* A helper macro for isUTF8_CHAR, so use that one instead of this. This was - * generated by regen/regcharclass.pl, and then moved here. The lines that - * generated it were then commented out. This was done solely because it takes - * on the order of 10 minutes to generate, and is never going to change, unless - * the generated code is improved. + * generated by regen/regcharclass.pl, and then moved here. Then it was + * hand-edited to add some LIKELY() calls, presuming that malformations are + * unlikely. The lines that generated it were then commented out. This was + * done because it takes on the order of 10 minutes to generate, and is never + * going to change, unless the generated code is improved, and figuring out + * there the LIKELYs would be hard. * * The EBCDIC versions have been cut to not cover all of legal Unicode, * otherwise they take too long to generate; besides there is a separate one @@ -788,27 +858,38 @@ case any call to string overloading updates the internal UTF-8 encoding flag. /*** GENERATED CODE ***/ #define is_UTF8_CHAR_utf8_no_length_checks(s) \ ( ( 0xC2 <= ((U8*)s)[0] && ((U8*)s)[0] <= 0xDF ) ? \ - ( ( ( ((U8*)s)[1] & 0xC0 ) == 0x80 ) ? 2 : 0 ) \ + ( LIKELY( ( ((U8*)s)[1] & 0xC0 ) == 0x80 ) ? 2 : 0 ) \ : ( 0xE0 == ((U8*)s)[0] ) ? \ - ( ( ( ( ((U8*)s)[1] & 0xE0 ) == 0xA0 ) && ( ( ((U8*)s)[2] & 0xC0 ) == 0x80 ) ) ? 3 : 0 )\ + ( LIKELY( ( ( ((U8*)s)[1] & 0xE0 ) == 0xA0 ) && ( ( ((U8*)s)[2] & 0xC0 ) == 0x80 ) ) ? 3 : 0 )\ : ( 0xE1 <= ((U8*)s)[0] && ((U8*)s)[0] <= 0xEF ) ? \ - ( ( ( ( ((U8*)s)[1] & 0xC0 ) == 0x80 ) && ( ( ((U8*)s)[2] & 0xC0 ) == 0x80 ) ) ? 3 : 0 )\ + ( LIKELY( ( ( ((U8*)s)[1] & 0xC0 ) == 0x80 ) && ( ( ((U8*)s)[2] & 0xC0 ) == 0x80 ) ) ? 3 : 0 )\ : ( 0xF0 == ((U8*)s)[0] ) ? \ - ( ( ( ( 0x90 <= ((U8*)s)[1] && ((U8*)s)[1] <= 0xBF ) && ( ( ((U8*)s)[2] & 0xC0 ) == 0x80 ) ) && ( ( ((U8*)s)[3] & 0xC0 ) == 0x80 ) ) ? 4 : 0 )\ -: ( ( ( ( 0xF1 <= ((U8*)s)[0] && ((U8*)s)[0] <= 0xF7 ) && ( ( ((U8*)s)[1] & 0xC0 ) == 0x80 ) ) && ( ( ((U8*)s)[2] & 0xC0 ) == 0x80 ) ) && ( ( ((U8*)s)[3] & 0xC0 ) == 0x80 ) ) ? 4 : 0 ) + ( LIKELY( ( ( 0x90 <= ((U8*)s)[1] && ((U8*)s)[1] <= 0xBF ) && ( ( ((U8*)s)[2] & 0xC0 ) == 0x80 ) ) && ( ( ((U8*)s)[3] & 0xC0 ) == 0x80 ) ) ? 4 : 0 )\ +: ( ( ( ( 0xF1 <= ((U8*)s)[0] && ((U8*)s)[0] <= 0xF7 ) && LIKELY( ( ((U8*)s)[1] & 0xC0 ) == 0x80 ) ) && LIKELY( ( ((U8*)s)[2] & 0xC0 ) == 0x80 ) ) && LIKELY( ( ((U8*)s)[3] & 0xC0 ) == 0x80 ) ) ? 4 : ... [3 chars truncated] #endif /* =for apidoc Am|STRLEN|isUTF8_CHAR|const U8 *s|const U8 *e -Returns the number of bytes beginning at C<s> which form a legal UTF-8 (or -UTF-EBCDIC) encoded character, looking no further than S<C<e - s>> bytes into -C<s>. Returns 0 if the sequence starting at C<s> through S<C<e - 1>> is not -well-formed UTF-8. +Evaluates to non-zero if the first few bytes of the string starting at C<s> and +looking no further than S<C<e - 1>> are well-formed UTF-8 that represents some +code point; otherwise it evaluates to 0. If non-zero, the value gives how many +many bytes starting at C<s> comprise the code point's representation. + +The code point can be any that will fit in a UV on this machine, using Perl's +extension to official UTF-8 to represent those higher than the Unicode maximum +of 0x10FFFF. That means that this macro is used to efficiently decide if the +next few bytes in C<s> is legal UTF-8 for a single character. Use +L</is_utf8_string>(), L</is_utf8_string_loclen>(), and +L</is_utf8_string_loc>() to check entire strings. + +Note that it is deprecated to use code points higher than what will fit in an +IV. This macro does not raise any warnings for such code points, treating them +as valid. -Note that an INVARIANT character (i.e. ASCII on non-EBCDIC -machines) is a valid UTF-8 character. +Note also that a UTF-8 INVARIANT character (i.e. ASCII on non-EBCDIC machines) +is a valid UTF-8 character. =cut */ @@ -821,7 +902,7 @@ machines) is a valid UTF-8 character. ? 0 \ : LIKELY(IS_UTF8_CHAR_FAST(UTF8SKIP(s))) \ ? is_UTF8_CHAR_utf8_no_length_checks(s) \ - : _is_utf8_char_slow(s, e)) + : _is_utf8_char_slow(s, UTF8SKIP(s))) #define is_utf8_char_buf(buf, buf_end) isUTF8_CHAR(buf, buf_end) diff --git a/utfebcdic.h b/utfebcdic.h index 10b666a..227e0eb 100644 --- a/utfebcdic.h +++ b/utfebcdic.h @@ -185,8 +185,36 @@ U+40000000..U+FFFFFFFF ttuuuuuvvvvvwwwwwzzzzzyyyyyxxxxx 11111111 10100000 101000 For 32-bit words, the 2nd through 7th bytes effectively function as leading zeros. Above 32 bits, these fill up, with each byte yielding 5 bits of information, so that with 13 continuation bytes, we can handle 65 bits, just -above what a 64 bit word can hold */ +above what a 64 bit word can hold + The following table gives the I8: + + I8 Code Points 1st Byte 2nd Byte 3rd 4th 5th 6th 7th 8th 9th-14th + + 0x0000..0x00BF 00..BF + 0x00A0..0x00FF * C5..C7 A0..BF + U+0100..U+03FF C8..DF A0..BF + U+0400..U+3FFF * E1..EF A0..BF A0..BF + U+4000..U+7FFF F0 * B0..BF A0..BF A0..BF + U+8000..U+D7FF F1 A0..B5 A0..BF A0..BF + U+D800..U+DFFF F1 B6..B7 A0..BF A0..BF (surrogates) + U+E000..U+FFFF F1 B8..BF A0..BF A0..BF + U+10000..U+3FFFF F2..F7 A0..BF A0..BF A0..BF + U+40000..U+FFFFF F8 * A8..BF A0..BF A0..BF A0..BF + U+100000..U+10FFFF F9 A0..A1 A0..BF A0..BF A0..BF + Below are above-Unicode code points + U+110000..U+1FFFFF F9 * A2..BF A0..BF A0..BF A0..BF + U+200000..U+3FFFFF FA..FB A0..BF A0..BF A0..BF A0..BF + U+400000..U+1FFFFFF FC * A4..BF A0..BF A0..BF A0..BF A0..BF +U+2000000..U+3FFFFFF FD A0..BF A0..BF A0..BF A0..BF A0..BF +U+4000000..U+3FFFFFFF FE * A2..BF A0..BF A0..BF A0..BF A0..BF A0..BF +U+40000000.. FF A0..BF A0..BF A0..BF A0..BF A0..BF A0..BF * A1..BF A0..BF + +Note the gaps before several of the byte entries above marked by '*'. These are +caused by legal UTF-8 avoiding non-shortest encodings: it is technically +possible to UTF-8-encode a single code point in different ways, but that is +explicitly forbidden, and the shortest possible encoding should always be used +(and that is what Perl does). */ /* This is a fundamental property of UTF-EBCDIC */ #define OFFUNI_IS_INVARIANT(c) (((UV)(c)) < 0xA0) @@ -240,6 +268,14 @@ above what a 64 bit word can hold */ * for more */ #define QUESTION_MARK_CTRL LATIN1_TO_NATIVE(0x9F) +/* Any I8 string larger than this will overflow the word if it were converted into a UV */ +#if defined(UV_IS_QUAD) +# define HIGHEST_REPRESENTABLE_UTF8 "\xFF\xAF\xBF\xBF\xBF\xBF\xBF\xBF\xBF\xBF\xBF\xBF\xBF\xBF" +#else +# define HIGHEST_REPRESENTABLE_UTF8 "\xFF\xA0\xA0\xA0\xA0\xA0\xA0\xA3\xBF\xBF\xBF\xBF\xBF\xBF" +#endif + + /* * ex: set ts=8 sts=4 sw=4 et: */ -- Perl5 Master Repository
