In perl.git, the branch blead has been updated <https://perl5.git.perl.org/perl.git/commitdiff/58e4a4676d898b44a54a55a7062b3bb087afa275?hp=755599dacf0896e06380d44bf5f7dd624678415a>
- Log ----------------------------------------------------------------- commit 58e4a4676d898b44a54a55a7062b3bb087afa275 Author: Karl Williamson <[email protected]> Date: Wed Sep 13 16:03:53 2017 -0600 locale.c: Clarify some debug statements commit 4eb27fc5a6fd92f91bf314d9f2e4b4da46dc8db1 Author: Karl Williamson <[email protected]> Date: Mon Sep 11 18:56:49 2017 -0600 locale.c: Slight refactor This makes savepv() part of the expressions instead of a separate statement. commit b1d4925c105b6e865b16a8914b6819899889d639 Author: Karl Williamson <[email protected]> Date: Mon Sep 11 17:41:57 2017 -0600 locale.c: Use REPLACEMENT_CHARACTER as a test This is trying to determine if the locale is UTF-8. The easiest way to tell is if the codeset returned by nl_langinfo says UTF-8, but if that fails or nl_langinfo() is not present on the system, a fallback method is to use the libc routines to convert a known byte string to code point and see if that matches the expected Unicode code point. Prior to this patch, the byte string representing HYPHEN was used. That's probably good enough, but we can do better with no extra work. This commit changes to use the REPLACEMENT CHARACTER instead. That is a Unicode concept. The chances of a non-UTF-8 locale taking the UTF-8 byte string for the REPLACEMENT and evaluating to REPLACEMENT are vanishingly small. commit 51fc4b19eb5af1211f960bc49d322c020490bc61 Author: Karl Williamson <[email protected]> Date: Mon Sep 11 17:32:42 2017 -0600 locale.c: Avoid extra call to mbtowc() This is done only when debugging, but in some locales that have shift states, the extra call could blow up. Instead save the result of the mbtowc() call we care about. commit ff1b739b7e749b9f4005279ddb782cb23a2322a9 Author: Karl Williamson <[email protected]> Date: Mon Sep 11 17:19:05 2017 -0600 locale.c: Add macro This adds STRLENs() where the argument must be a literal string constant. This may deserve wider applicability, but in case it doesn't, I'm making it local to just this file. commit e70d440cf5ea40f241bbe6254b0c8540321376fb Author: Karl Williamson <[email protected]> Date: Mon Sep 11 16:10:42 2017 -0600 locale.c: Rmv extraneous detail from comment This comment contains a list of code points that are unusual, but it also included ones that are standard, which made me keep looking to see why they were unusual, each time realizing in the end that they were not. commit 5c1ff086bb032fe1320e5cd3a81b4f3841481d44 Author: Karl Williamson <[email protected]> Date: Mon Aug 28 17:51:06 2017 -0600 embed.fnc: Change fcn from A to X This function is marked as accessible anywhere, but experimental, and so is changeable at any time without notice, and its name begins with an underscore to indicate its private nature. I didn't know at the time I wrote it that we have an existing mechanism to deal with functions whose only use should be a public macro. This changes to use that mechanism. commit 5792c6421a2dffa32c7169e0ebe482427b43a1b8 Author: Karl Williamson <[email protected]> Date: Mon Aug 28 17:43:29 2017 -0600 Change name of internal function Following on the previous commit, this changes the name of the function that changes the variable to be in sync with it. commit 892e646556f1997b0384dc508d3223c2c2a7be74 Author: Karl Williamson <[email protected]> Date: Mon Aug 28 17:21:09 2017 -0600 Change name of locale per-interpreter variable The real purpose of this internal variable is to give the name of the locale that is the underlying one for the C program. Various macros already indicate that. This furthers the process. ----------------------------------------------------------------------- Summary of changes: embed.fnc | 4 ++-- embed.h | 4 ++-- embedvar.h | 2 +- intrpvar.h | 6 +++--- locale.c | 49 ++++++++++++++++++++++++++++--------------------- perl.h | 24 ++++++++++++------------ proto.h | 2 +- sv.c | 4 ++-- 8 files changed, 51 insertions(+), 44 deletions(-) diff --git a/embed.fnc b/embed.fnc index edd6659104..be12f88024 100644 --- a/embed.fnc +++ b/embed.fnc @@ -1268,9 +1268,9 @@ ApOM |int |init_i18nl14n |int printwarn p |char* |my_strerror |const int errnum Xpn |void |_warn_problematic_locale p |void |new_numeric |NULLOK const char* newcoll -Xp |void |set_numeric_local +Xp |void |set_numeric_underlying Xp |void |set_numeric_standard -ApM |bool |_is_in_locale_category|const bool compiling|const int category +Xp |bool |_is_in_locale_category|const bool compiling|const int category Apd |void |sync_locale ApdO |void |require_pv |NN const char* pv Apd |void |pack_cat |NN SV *cat|NN const char *pat|NN const char *patend \ diff --git a/embed.h b/embed.h index a07d719ec9..ea05c91343 100644 --- a/embed.h +++ b/embed.h @@ -28,7 +28,6 @@ #define Gv_AMupdate(a,b) Perl_Gv_AMupdate(aTHX_ a,b) #define _force_out_malformed_utf8_message(a,b,c,d) Perl__force_out_malformed_utf8_message(aTHX_ a,b,c,d) -#define _is_in_locale_category(a,b) Perl__is_in_locale_category(aTHX_ a,b) #define _is_uni_FOO(a,b) Perl__is_uni_FOO(aTHX_ a,b) #define _is_uni_perl_idcont(a) Perl__is_uni_perl_idcont(aTHX_ a) #define _is_uni_perl_idstart(a) Perl__is_uni_perl_idstart(aTHX_ a) @@ -1145,6 +1144,7 @@ #ifdef PERL_CORE #define Slab_Alloc(a) Perl_Slab_Alloc(aTHX_ a) #define Slab_Free(a) Perl_Slab_Free(aTHX_ a) +#define _is_in_locale_category(a,b) Perl__is_in_locale_category(aTHX_ a,b) #define _warn_problematic_locale Perl__warn_problematic_locale #define abort_execution(a,b) Perl_abort_execution(aTHX_ a,b) #define alloc_LOGOP(a,b,c) Perl_alloc_LOGOP(aTHX_ a,b,c) @@ -1377,8 +1377,8 @@ #define scalar(a) Perl_scalar(aTHX_ a) #define scalarvoid(a) Perl_scalarvoid(aTHX_ a) #define set_caret_X() Perl_set_caret_X(aTHX) -#define set_numeric_local() Perl_set_numeric_local(aTHX) #define set_numeric_standard() Perl_set_numeric_standard(aTHX) +#define set_numeric_underlying() Perl_set_numeric_underlying(aTHX) #define sub_crush_depth(a) Perl_sub_crush_depth(aTHX_ a) #define sv_2num(a) Perl_sv_2num(aTHX_ a) #define sv_clean_all() Perl_sv_clean_all(aTHX) diff --git a/embedvar.h b/embedvar.h index 76efb9104b..898b71cd31 100644 --- a/embedvar.h +++ b/embedvar.h @@ -219,10 +219,10 @@ #define PL_my_cxt_size (vTHX->Imy_cxt_size) #define PL_na (vTHX->Ina) #define PL_nomemok (vTHX->Inomemok) -#define PL_numeric_local (vTHX->Inumeric_local) #define PL_numeric_name (vTHX->Inumeric_name) #define PL_numeric_radix_sv (vTHX->Inumeric_radix_sv) #define PL_numeric_standard (vTHX->Inumeric_standard) +#define PL_numeric_underlying (vTHX->Inumeric_underlying) #define PL_ofsgv (vTHX->Iofsgv) #define PL_oldname (vTHX->Ioldname) #define PL_op (vTHX->Iop) diff --git a/intrpvar.h b/intrpvar.h index 87f33d8bb4..d88628a094 100644 --- a/intrpvar.h +++ b/intrpvar.h @@ -613,9 +613,9 @@ PERLVARI(I, perl_destruct_level, signed char, 0) #ifdef USE_LOCALE_NUMERIC PERLVARI(I, numeric_standard, int, TRUE) - /* Assume simple numerics */ -PERLVARI(I, numeric_local, bool, TRUE) - /* Assume local numerics */ + /* Assume C locale numerics */ +PERLVARI(I, numeric_underlying, bool, TRUE) + /* Assume underlying locale numerics */ PERLVAR(I, numeric_name, char *) /* Name of current numeric locale */ PERLVAR(I, numeric_radix_sv, SV *) /* The radix separator if not '.' */ diff --git a/locale.c b/locale.c index 364eb0bc38..b2eaf4c418 100644 --- a/locale.c +++ b/locale.c @@ -55,6 +55,10 @@ static bool debug_initialization = FALSE; # endif #endif +/* strlen() of a literal string constant. XXX We might want this more general, + * but using it in just this file for now */ +#define STRLENs(s) (sizeof("" s "") - 1) + #ifdef USE_LOCALE /* @@ -177,8 +181,8 @@ S_set_numeric_radix(pTHX_ const bool use_locale) * the odds are extremely small that it would return these two strings for some * other locale. Note that VMS in these two locales includes many non-ASCII * characters as controls and punctuation (below are hex bytes): - * cntrl: 00-1F 7F 84-97 9B-9F - * punct: 21-2F 3A-40 5B-60 7B-7E A1-A3 A5 A7-AB B0-B3 B5-B7 B9-BD BF-CF D1-DD DF-EF F1-FD + * cntrl: 84-97 9B-9F + * punct: A1-A3 A5 A7-AB B0-B3 B5-B7 B9-BD BF-CF D1-DD DF-EF F1-FD * Oddly, none there are listed as alphas, though some represent alphabetics * http://www.nntp.perl.org/group/perl.perl5.porters/2013/02/msg198753.html */ #define isNAME_C_OR_POSIX(name) \ @@ -201,8 +205,8 @@ Perl_new_numeric(pTHX_ const char *newnum) * It installs this locale as the current underlying default. * * The default locale and the C locale can be toggled between by use of the - * set_numeric_local() and set_numeric_standard() functions, which should - * probably not be called directly, but only via macros like + * set_numeric_underlying() and set_numeric_standard() functions, which + * should probably not be called directly, but only via macros like * SET_NUMERIC_STANDARD() in perl.h. * * The toggling is necessary mainly so that a non-dot radix decimal point @@ -211,7 +215,7 @@ Perl_new_numeric(pTHX_ const char *newnum) * * This sets several interpreter-level variables: * PL_numeric_name The underlying locale's name: a copy of 'newnum' - * PL_numeric_local A boolean indicating if the toggled state is such + * PL_numeric_underlying A boolean indicating if the toggled state is such * that the current locale is the program's underlying * locale * PL_numeric_standard An int indicating if the toggled state is such @@ -233,14 +237,14 @@ Perl_new_numeric(pTHX_ const char *newnum) Safefree(PL_numeric_name); PL_numeric_name = NULL; PL_numeric_standard = TRUE; - PL_numeric_local = TRUE; + PL_numeric_underlying = TRUE; return; } save_newnum = stdize_locale(savepv(newnum)); PL_numeric_standard = isNAME_C_OR_POSIX(save_newnum); - PL_numeric_local = TRUE; + PL_numeric_underlying = TRUE; if (! PL_numeric_name || strNE(PL_numeric_name, save_newnum)) { Safefree(PL_numeric_name); @@ -273,14 +277,14 @@ Perl_set_numeric_standard(pTHX) do_setlocale_c(LC_NUMERIC, "C"); PL_numeric_standard = TRUE; - PL_numeric_local = isNAME_C_OR_POSIX(PL_numeric_name); + PL_numeric_underlying = isNAME_C_OR_POSIX(PL_numeric_name); set_numeric_radix(0); # ifdef DEBUGGING if (DEBUG_L_TEST || debug_initialization) { PerlIO_printf(Perl_debug_log, - "Underlying LC_NUMERIC locale now is C\n"); + "LC_NUMERIC locale now is standard C\n"); } # endif @@ -289,7 +293,7 @@ Perl_set_numeric_standard(pTHX) } void -Perl_set_numeric_local(pTHX) +Perl_set_numeric_underlying(pTHX) { #ifdef USE_LOCALE_NUMERIC @@ -302,14 +306,14 @@ Perl_set_numeric_local(pTHX) do_setlocale_c(LC_NUMERIC, PL_numeric_name); PL_numeric_standard = isNAME_C_OR_POSIX(PL_numeric_name); - PL_numeric_local = TRUE; + PL_numeric_underlying = TRUE; set_numeric_radix(1); # ifdef DEBUGGING if (DEBUG_L_TEST || debug_initialization) { PerlIO_printf(Perl_debug_log, - "Underlying LC_NUMERIC locale now is %s\n", + "LC_NUMERIC locale now is %s\n", PL_numeric_name); } @@ -3051,17 +3055,22 @@ Perl__is_cur_LC_category_utf8(pTHX_ int category) * result */ if (is_utf8) { wchar_t wc; + int len; + PERL_UNUSED_RESULT(mbtowc(&wc, NULL, 0));/* Reset any shift state */ errno = 0; - if ((size_t)mbtowc(&wc, HYPHEN_UTF8, strlen(HYPHEN_UTF8)) - != strlen(HYPHEN_UTF8) - || wc != (wchar_t) 0x2010) + len = mbtowc(&wc, STR_WITH_LEN(REPLACEMENT_CHARACTER_UTF8)); + + + if ( len != STRLENs(REPLACEMENT_CHARACTER_UTF8) + || wc != (wchar_t) 0xFFFD) { is_utf8 = FALSE; - DEBUG_L(PerlIO_printf(Perl_debug_log, "\thyphen=U+%x\n", (unsigned int)wc)); + DEBUG_L(PerlIO_printf(Perl_debug_log, "\replacement=U+%x\n", + (unsigned int)wc)); DEBUG_L(PerlIO_printf(Perl_debug_log, "\treturn from mbtowc=%d; errno=%d; ?UTF8 locale=0\n", - mbtowc(&wc, HYPHEN_UTF8, strlen(HYPHEN_UTF8)), errno)); + len, errno)); } } @@ -3481,14 +3490,12 @@ Perl_my_strerror(pTHX_ const int errnum) /* This function is trivial if we have strerror_l() */ if (within_locale_scope) { - errstr = strerror(errnum); + errstr = savepv(strerror(errnum)); } else { - errstr = strerror_l(errnum, PL_C_locale_obj); + errstr = savepv(strerror_l(errnum, PL_C_locale_obj)); } - errstr = savepv(errstr); - # else /* Doesn't have strerror_l(). */ # ifdef USE_POSIX_2008_LOCALE diff --git a/perl.h b/perl.h index 1e4f8bc4d1..21b0a75c47 100644 --- a/perl.h +++ b/perl.h @@ -5502,10 +5502,10 @@ typedef struct am_table_short AMTS; # define IN_LC_COMPILETIME(category) \ (IN_LC_ALL_COMPILETIME || (IN_LC_PARTIAL_COMPILETIME \ - && _is_in_locale_category(TRUE, (category)))) + && Perl__is_in_locale_category(aTHX_ TRUE, (category)))) # define IN_LC_RUNTIME(category) \ (IN_LC_ALL_RUNTIME || (IN_LC_PARTIAL_RUNTIME \ - && _is_in_locale_category(FALSE, (category)))) + && Perl__is_in_locale_category(aTHX_ FALSE, (category)))) # define IN_LC(category) \ (IN_LC_COMPILETIME(category) || IN_LC_RUNTIME(category)) @@ -5682,7 +5682,7 @@ expression, but with an empty argument list, like this: * contrary be noops, in the dynamic scope by setting PL_numeric_standard to 2. * */ # define _NOT_IN_NUMERIC_UNDERLYING \ - (! PL_numeric_local && PL_numeric_standard < 2) + (! PL_numeric_underlying && PL_numeric_standard < 2) # define DECLARATION_FOR_LC_NUMERIC_MANIPULATION \ void (*_restore_LC_NUMERIC_function)(pTHX) = NULL @@ -5690,14 +5690,14 @@ expression, but with an empty argument list, like this: # define STORE_LC_NUMERIC_SET_TO_NEEDED() \ if (IN_LC(LC_NUMERIC)) { \ if (_NOT_IN_NUMERIC_UNDERLYING) { \ - Perl_set_numeric_local(aTHX); \ + Perl_set_numeric_underlying(aTHX); \ _restore_LC_NUMERIC_function = &Perl_set_numeric_standard; \ } \ } \ else { \ if (_NOT_IN_NUMERIC_STANDARD) { \ SET_NUMERIC_STANDARD(); \ - _restore_LC_NUMERIC_function = &Perl_set_numeric_local; \ + _restore_LC_NUMERIC_function = &Perl_set_numeric_underlying; \ } \ } @@ -5715,26 +5715,26 @@ expression, but with an empty argument list, like this: # define SET_NUMERIC_UNDERLYING() \ STMT_START { if (_NOT_IN_NUMERIC_UNDERLYING) \ - Perl_set_numeric_local(aTHX); } STMT_END + Perl_set_numeric_underlying(aTHX); } STMT_END /* The rest of these LC_NUMERIC macros toggle to one or the other state, with * the RESTORE_foo ones called to switch back, but only if need be */ # define STORE_LC_NUMERIC_UNDERLYING_SET_STANDARD() \ - bool _was_local = _NOT_IN_NUMERIC_STANDARD; \ - if (_was_local) Perl_set_numeric_standard(aTHX); + bool _was_underlying = _NOT_IN_NUMERIC_STANDARD; \ + if (_was_underlying) Perl_set_numeric_standard(aTHX); /* Doesn't change to underlying locale unless within the scope of some form of * 'use locale'. This is the usual desired behavior. */ # define STORE_LC_NUMERIC_STANDARD_SET_UNDERLYING() \ bool _was_standard = _NOT_IN_NUMERIC_UNDERLYING \ && IN_LC(LC_NUMERIC); \ - if (_was_standard) Perl_set_numeric_local(aTHX); + if (_was_standard) Perl_set_numeric_underlying(aTHX); /* Rarely, we want to change to the underlying locale even outside of 'use * locale'. This is principally in the POSIX:: functions */ # define STORE_LC_NUMERIC_FORCE_TO_UNDERLYING() \ if (_NOT_IN_NUMERIC_UNDERLYING) { \ - Perl_set_numeric_local(aTHX); \ + Perl_set_numeric_underlying(aTHX); \ _restore_LC_NUMERIC_function = &Perl_set_numeric_standard; \ } @@ -5753,8 +5753,8 @@ expression, but with an empty argument list, like this: } \ } STMT_END -# define RESTORE_LC_NUMERIC_UNDERLYING() \ - if (_was_local) Perl_set_numeric_local(aTHX); +# define RESTORE_LC_NUMERIC_UNDERLYING() \ + if (_was_underlying) Perl_set_numeric_underlying(aTHX); # define RESTORE_LC_NUMERIC_STANDARD() \ if (_restore_LC_NUMERIC_function) { \ diff --git a/proto.h b/proto.h index 1af9126325..bc24aee4fd 100644 --- a/proto.h +++ b/proto.h @@ -2925,8 +2925,8 @@ PERL_CALLCONV void Perl_set_caret_X(pTHX); PERL_CALLCONV void Perl_set_context(void *t); #define PERL_ARGS_ASSERT_SET_CONTEXT \ assert(t) -PERL_CALLCONV void Perl_set_numeric_local(pTHX); PERL_CALLCONV void Perl_set_numeric_standard(pTHX); +PERL_CALLCONV void Perl_set_numeric_underlying(pTHX); PERL_CALLCONV void Perl_setdefout(pTHX_ GV* gv); #define PERL_ARGS_ASSERT_SETDEFOUT \ assert(gv) diff --git a/sv.c b/sv.c index 1e173ed48e..225e5c855a 100644 --- a/sv.c +++ b/sv.c @@ -3141,7 +3141,7 @@ Perl_sv_2pv_flags(pTHX_ SV *const sv, STRLEN *const lp, const I32 flags) DECLARATION_FOR_LC_NUMERIC_MANIPULATION; STORE_LC_NUMERIC_SET_TO_NEEDED(); - local_radix = PL_numeric_local && PL_numeric_radix_sv; + local_radix = PL_numeric_underlying && PL_numeric_radix_sv; if (local_radix && SvCUR(PL_numeric_radix_sv) > 1) { size += SvCUR(PL_numeric_radix_sv) - 1; s = SvGROW_mutable(sv, size); @@ -15337,7 +15337,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, #ifdef USE_LOCALE_NUMERIC PL_numeric_standard = proto_perl->Inumeric_standard; - PL_numeric_local = proto_perl->Inumeric_local; + PL_numeric_underlying = proto_perl->Inumeric_underlying; #endif /* !USE_LOCALE_NUMERIC */ /* Did the locale setup indicate UTF-8? */ -- Perl5 Master Repository
