In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/260c7ace105800f6155b335bb32178a4cb5c5609?hp=b367c45de1e716917350f403e8cac1658767f7a6>
- Log ----------------------------------------------------------------- commit 260c7ace105800f6155b335bb32178a4cb5c5609 Author: Karl Williamson <[email protected]> Date: Thu Mar 19 14:41:14 2015 -0600 perl.h: Fix nit in comment M perl.h commit 45235d99f4be019fd96bd9bdac073e7ebbdaa322 Author: Karl Williamson <[email protected]> Date: Thu Mar 19 14:39:06 2015 -0600 Document API for XS LC_NUMERIC locale manipulation XS writers may need to manipulate the LC_NUMERIC locale. Some macros are available to do this. This documents them and the issues. M dist/ExtUtils-ParseXS/lib/perlxs.pod M perl.h M pod/perldelta.pod commit c5c882243da904929942ec6479cbc421f5e92cfa Author: Karl Williamson <[email protected]> Date: Wed Mar 18 21:58:24 2015 -0600 perllocale: Correctly document behavior M pod/perllocale.pod commit e737dcc5adb493caa5a9ba93970c4d3e4a8ed30f Author: Karl Williamson <[email protected]> Date: Thu Mar 19 13:28:30 2015 -0600 perl.h: White-space only Remove some empty /**/ and align line continuation backslashes onto tab boundaries M perl.h commit 67d796aebd5882a4f28c5b95fb63f198a160c844 Author: Karl Williamson <[email protected]> Date: Thu Mar 19 13:06:27 2015 -0600 Change some locale manipulation macros in prep for API This changes the way some of the current internal-only macros are named and used in order to simplify things and minimize what gets exposed as part of the API. Although these have not been listed as publicly available, it costs essentially nothing to keep the old names around in case someone was illegally using them. M dump.c M ext/POSIX/POSIX.xs M numeric.c M perl.h M pp_ctl.c M sv.c M toke.c commit 0c36c41be6ceb31ab6c2cb9eaebf3d1fd7746e21 Author: Karl Williamson <[email protected]> Date: Thu Mar 19 11:23:58 2015 -0600 regen/regcharclass.pl: Need to rebuild when source files change Like regen/mk_invlists.pl, if any of various Unicode-related files change, we can't rely on the generated file remaining unchanged. M regcharclass.h M regen/regcharclass.pl commit af9bd4b5d0228d8d1bc08c845b796b642a2596d9 Author: Karl Williamson <[email protected]> Date: Thu Mar 19 11:05:50 2015 -0600 regen/mk_invlists.pl depends on mktables If mktables changes, the input data for this may also change. M charclass_invlists.h M regen/mk_invlists.pl commit 2308ab830eeb3b85bac797c2cb240ce1f9af2710 Author: Karl Williamson <[email protected]> Date: Fri Mar 13 12:20:18 2015 -0600 regen/mk_invlists.pl: Don't quit so easily Like the previous commit, this script may be called before mktables.lst exists, and we can't generate mktables.lst without this script executing to completion. The missing file is only used to determine if something has changed that we would need to recompile for so this script can run faster next time it is called. M charclass_invlists.h M regen/mk_invlists.pl commit fc809980424f38e78f04420842099c0978f0e40f Author: Karl Williamson <[email protected]> Date: Fri Mar 13 12:06:40 2015 -0600 regen/regen_lib.pl: Don't die on missing digest regen_lib now has the capability of calculating a digest for various files passed to it, and saving those values in the generated output file. The passed in files are supposed to be the sources of the generated file, so that on future regen runs, if no digest value has changed, there should be no need to actually do the (potentially slow) regen. When bootstrapping up a perl, not everything may have been built before a regen is attempted. This was dieing under those conditions, preventing the build from happening. Thus we come to a dead-end. This commit causes a random digest to be generated for a source file that doesn't (yet) exist, instead of dieing. That means that the build can continue, and the source should be generated at some point in it. The random digest is not going to match the real one, so the next time the regen happens, it will signal that things need to be rebuilt, and then the actual digest of the source will be calculated and stored. Having the fake digest be a random number makes sure that, should the missing file remain missing, that the regen will continue to rebuild things each time. So, if someone carelessly commits the result without realizing there is an empty source, the Porting tests will fail, drawing attention to the problem. M regen/regen_lib.pl ----------------------------------------------------------------------- Summary of changes: charclass_invlists.h | 3 +- dist/ExtUtils-ParseXS/lib/perlxs.pod | 45 ++++--- dump.c | 8 +- ext/POSIX/POSIX.xs | 21 ++-- numeric.c | 8 +- perl.h | 231 +++++++++++++++++++++++++---------- pod/perldelta.pod | 4 +- pod/perllocale.pod | 19 ++- pp_ctl.c | 3 +- regcharclass.h | 46 ++++++- regen/mk_invlists.pl | 20 +-- regen/regcharclass.pl | 21 +++- regen/regen_lib.pl | 8 +- sv.c | 5 +- toke.c | 4 +- 15 files changed, 326 insertions(+), 120 deletions(-) diff --git a/charclass_invlists.h b/charclass_invlists.h index f6a7c75..c5a9e20 100644 --- a/charclass_invlists.h +++ b/charclass_invlists.h @@ -97321,6 +97321,7 @@ static const UV XPosixXDigit_invlist[] = { /* for EBCDIC POSIX-BC */ * a9791f08281d7b0a417e4ad882cf64463f6815db8156932acd85228ac717fd94 lib/unicore/extracted/DLineBreak.txt * a17a0330e57d774343a53c019f1bc69827c2676982a1bf48e0898a76710e8877 lib/unicore/extracted/DNumType.txt * c2cb810a67cc5fb4a8d236b6c1bc6dd4d89733d8603881997e8aae2c816a3db1 lib/unicore/extracted/DNumValues.txt + * 2ee1b1f995a63cfdc5abe9b16f165447f85030420f452f7bbd47586c1b64020a lib/unicore/mktables * 746472de66b936ac885ca6d6e68058242b4e909e3260c6317f3ec719f78f76cc lib/unicore/version - * 52906c205cae4bc9e878d2bcdf8c2bbb1382356f8b4870fe3ac1949ad59b03cd regen/mk_invlists.pl + * 72754dc48de5bcad92cd0f84c691d099f429ddf2222f24531c928ad610cd8050 regen/mk_invlists.pl * ex: set ro: */ diff --git a/dist/ExtUtils-ParseXS/lib/perlxs.pod b/dist/ExtUtils-ParseXS/lib/perlxs.pod index 8d762a8..d77ac1b 100644 --- a/dist/ExtUtils-ParseXS/lib/perlxs.pod +++ b/dist/ExtUtils-ParseXS/lib/perlxs.pod @@ -2141,13 +2141,18 @@ this model, the less likely conflicts will occur. One area where there has been conflict is in regards to C locales. (See L<perllocale>.) perl, with one exception and unless told otherwise, -sets up the underlying locale the program is running in to that passed -into it from the environment. As of v5.20, this underlying locale is -completely hidden from pure perl code outside the lexical scope of -C<S<use locale>>; except a couple of function calls in the POSIX -module of necessity use it. But the underlying locale, with that one -exception is exposed to XS code, affecting all C library routines whose -behavior is locale-dependent. The exception is the +sets up the underlying locale the program is running in to the locale +passed +into it from the environment. This is an important difference from a +generic C language program, where the underlying locale is the "C" +locale unless the program changes it. As of v5.20, this underlying +locale is completely hidden from pure perl code outside the lexical +scope of C<S<use locale>> except for a couple of function calls in the +POSIX module which of necessity use it. But the underlying locale, with +that +one exception is exposed to XS code, affecting all C library routines +whose behavior is locale-dependent. Your XS code better not assume that +the underlying locale is "C". The exception is the L<C<LC_NUMERIC>|perllocale/Category LC_NUMERIC: Numeric Formatting> locale category, and the reason it is an exception is that experience has shown that it can be problematic for XS code, whereas we have not @@ -2174,16 +2179,20 @@ may call a C library function that is. Hopefully the man page for such a function will indicate that dependency, but the documentation is imperfect. -The current locale is exposed to XS code except possibly C<LC_NUMERIC>. -There have not been reports of problems with these other categories. +The current locale is exposed to XS code except possibly C<LC_NUMERIC> +(explained in the next paragraph). +There have not been reports of problems with the other categories. +Perl initializes things on start-up so that the current locale is the +one which is indicated by the user's environment in effect at that time. +See L<perllocale/ENVIRONMENT>. -Up through v5.20, Perl initializes things on start-up so that -C<LC_NUMERIC> is set to the "C" locale. But if any code anywhere -changes it, it will stay changed. This means that your module can't +However, up through v5.20, Perl initialized things on start-up so that +C<LC_NUMERIC> was set to the "C" locale. But if any code anywhere +changed it, it would stay changed. This means that your module can't count on C<LC_NUMERIC> being something in particular, and you can't expect floating point numbers (including version strings) to have dots in them. If you don't allow for a non-dot, your code could break if -anyone anywhere changes the locale. For this reason, v5.22 is changing +anyone anywhere changed the locale. For this reason, v5.22 changed the behavior so that Perl tries to keep C<LC_NUMERIC> in the "C" locale except around the operations internally where it should be something else. Misbehaving XS code will always be able to change the locale @@ -2201,15 +2210,13 @@ C<Gtk>. This can cause problems for the perl core and other modules. Starting in v5.20.1, calling the function L<sync_locale()|perlapi/sync_locale> from XS should be sufficient to avoid most of these problems. Prior to this, you need a pure Perl -segment that does this: +statement that does this: POSIX::setlocale(LC_ALL, POSIX::setlocale(LC_ALL)); -Macros are provided for XS code to temporarily change to use the -underlying C<LC_NUMERIC> locale when necessary. An API is being -developed for this, but has not yet been nailed down, but will be during -the course of v5.21. Send email to L<mailto:[email protected]> for -guidance. +In the event that your XS code may need the underlying C<LC_NUMERIC> +locale, there are macros available to access this; see +L<perlapi/Locale-related functions and macros>. =back diff --git a/dump.c b/dump.c index 2e0bc01..0629514 100644 --- a/dump.c +++ b/dump.c @@ -477,9 +477,9 @@ Perl_sv_peek(pTHX_ SV *sv) } } else if (SvNOKp(sv)) { - STORE_NUMERIC_LOCAL_SET_STANDARD(); + STORE_LC_NUMERIC_UNDERLYING_SET_STANDARD(); Perl_sv_catpvf(aTHX_ t, "(%"NVgf")",SvNVX(sv)); - RESTORE_NUMERIC_LOCAL(); + RESTORE_LC_NUMERIC_UNDERLYING(); } else if (SvIOKp(sv)) { if (SvIsUV(sv)) @@ -1575,9 +1575,9 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo && type != SVt_PVCV && type != SVt_PVFM && type != SVt_REGEXP && type != SVt_PVIO && !isGV_with_GP(sv) && !SvVALID(sv)) || type == SVt_NV) { - STORE_NUMERIC_LOCAL_SET_STANDARD(); + STORE_LC_NUMERIC_UNDERLYING_SET_STANDARD(); Perl_dump_indent(aTHX_ level, file, " NV = %.*" NVgf "\n", NV_DIG, SvNVX(sv)); - RESTORE_NUMERIC_LOCAL(); + RESTORE_LC_NUMERIC_UNDERLYING(); } if (SvROK(sv)) { diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs index 5a2c306..43fad83 100644 --- a/ext/POSIX/POSIX.xs +++ b/ext/POSIX/POSIX.xs @@ -2002,7 +2002,8 @@ localeconv() /* localeconv() deals with both LC_NUMERIC and LC_MONETARY, but * LC_MONETARY is already in the correct locale */ - STORE_NUMERIC_STANDARD_FORCE_LOCAL(); + DECLARATION_FOR_LC_NUMERIC_MANIPULATION; + STORE_LC_NUMERIC_FORCE_TO_UNDERLYING(); RETVAL = newHV(); sv_2mortal((SV*)RETVAL); @@ -2055,7 +2056,7 @@ localeconv() integers++; } } - RESTORE_NUMERIC_STANDARD(); + RESTORE_LC_NUMERIC_STANDARD(); #endif /* HAS_LOCALECONV */ OUTPUT: RETVAL @@ -2079,7 +2080,7 @@ setlocale(category, locale = 0) } # ifdef LC_ALL else if (category == LC_ALL) { - SET_NUMERIC_LOCAL(); + SET_NUMERIC_UNDERLYING(); } # endif } @@ -2101,8 +2102,8 @@ setlocale(category, locale = 0) /* Save retval since subsequent setlocale() calls may overwrite it. */ retval = savepv(retval); - /* For locale == 0, we may have switched to NUMERIC_LOCAL. Switch back - * */ + /* For locale == 0, we may have switched to NUMERIC_UNDERLYING. Switch + * back */ if (locale == 0) { SET_NUMERIC_STANDARD(); XSRETURN_PV(retval); @@ -3188,7 +3189,8 @@ strtod(str) double num; char *unparsed; PPCODE: - STORE_NUMERIC_STANDARD_FORCE_LOCAL(); + DECLARATION_FOR_LC_NUMERIC_MANIPULATION; + STORE_LC_NUMERIC_FORCE_TO_UNDERLYING(); num = strtod(str, &unparsed); PUSHs(sv_2mortal(newSVnv(num))); if (GIMME_V == G_ARRAY) { @@ -3198,7 +3200,7 @@ strtod(str) else PUSHs(&PL_sv_undef); } - RESTORE_NUMERIC_STANDARD(); + RESTORE_LC_NUMERIC_STANDARD(); #ifdef HAS_STRTOLD @@ -3209,7 +3211,8 @@ strtold(str) long double num; char *unparsed; PPCODE: - STORE_NUMERIC_STANDARD_FORCE_LOCAL(); + DECLARATION_FOR_LC_NUMERIC_MANIPULATION; + STORE_LC_NUMERIC_FORCE_TO_UNDERLYING(); num = strtold(str, &unparsed); PUSHs(sv_2mortal(newSVnv(num))); if (GIMME_V == G_ARRAY) { @@ -3219,7 +3222,7 @@ strtold(str) else PUSHs(&PL_sv_undef); } - RESTORE_NUMERIC_STANDARD(); + RESTORE_LC_NUMERIC_STANDARD(); #endif diff --git a/numeric.c b/numeric.c index a13a5e2..e97bc26 100644 --- a/numeric.c +++ b/numeric.c @@ -522,7 +522,8 @@ Perl_grok_numeric_radix(pTHX_ const char **sp, const char *send) PERL_ARGS_ASSERT_GROK_NUMERIC_RADIX; if (IN_LC(LC_NUMERIC)) { - DECLARE_STORE_LC_NUMERIC_SET_TO_NEEDED(); + DECLARATION_FOR_LC_NUMERIC_MANIPULATION; + STORE_LC_NUMERIC_SET_TO_NEEDED(); if (PL_numeric_radix_sv) { STRLEN len; const char * const radix = SvPV(PL_numeric_radix_sv, len); @@ -1209,7 +1210,8 @@ Perl_my_atof(pTHX_ const char* s) PERL_ARGS_ASSERT_MY_ATOF; { - DECLARE_STORE_LC_NUMERIC_SET_TO_NEEDED(); + DECLARATION_FOR_LC_NUMERIC_MANIPULATION; + STORE_LC_NUMERIC_SET_TO_NEEDED(); if (PL_numeric_radix_sv && IN_LC(LC_NUMERIC)) { const char *standard = NULL, *local = NULL; bool use_standard_radix; @@ -1232,7 +1234,7 @@ Perl_my_atof(pTHX_ const char* s) Perl_atof2(s, x); if (use_standard_radix) - SET_NUMERIC_LOCAL(); + SET_NUMERIC_UNDERLYING(); } else Perl_atof2(s, x); diff --git a/perl.h b/perl.h index 7313de0..8c05ff1 100644 --- a/perl.h +++ b/perl.h @@ -5866,48 +5866,128 @@ typedef struct am_table_short AMTS; #ifdef USE_LOCALE_NUMERIC -/* These macros are for toggling between the underlying locale (LOCAL) and the - * C locale. */ - -/* The first set makes sure that the locale is set to C unless within a 'use - * locale's scope; otherwise to the default locale. A function pointer is - * used, which can be declared separately by - * DECLARATION_FOR_STORE_LC_NUMERIC_SET_TO_NEEDED, followed by the actual - * setting (using STORE_LC_NUMERIC_SET_TO_NEEDED()), or the two can be combined - * into one call DECLARE_STORE_LC_NUMERIC_SET_TO_NEEDED(). - * RESTORE_LC_NUMERIC() in all cases restores the locale to what it was before - * these were called */ +/* These macros are for toggling between the underlying locale (UNDERLYING or + * LOCAL) and the C locale (STANDARD). + +=head1 Locale-related functions and macros + +=for apidoc Amn|void|DECLARATION_FOR_LC_NUMERIC_MANIPULATION + +This macro should be used as a statement. It declares a private variable +(whose name begins with an underscore) that is needed by the other macros in +this section. Failing to include this correctly should lead to a syntax error. +For compatibility with C89 C compilers it should be placed in a block before +any executable statements. + +=for apidoc Am|void|STORE_LC_NUMERIC_FORCE_TO_UNDERLYING + +This is used by XS code that that is C<LC_NUMERIC> locale-aware to force the +locale for category C<LC_NUMERIC> to be what perl thinks is the current +underlying locale. (The perl interpreter could be wrong about what the +underlying locale actually is if some C or XS code has called the C library +function L<setlocale(3)> behind its back; calling L</sync_locale> before calling +this macro will update perl's records.) + +A call to L</DECLARATION_FOR_LC_NUMERIC_MANIPULATION> must have been made to +declare at compile time a private variable used by this macro. This macro +should be called as a single statement, not an expression, but with an empty +argument list, like this: + + { + DECLARATION_FOR_LC_NUMERIC_MANIPULATION; + ... + STORE_LC_NUMERIC_FORCE_TO_UNDERLYING(); + ... + RESTORE_LC_NUMERIC(); + ... + } + +The private variable is used to save the current locale state, so +that the requisite matching call to L</RESTORE_LC_NUMERIC> can restore it. + +=for apidoc Am|void|STORE_LC_NUMERIC_SET_TO_NEEDED + +This is used to help wrap XS or C code that that is C<LC_NUMERIC> locale-aware. +This locale category is generally kept set to the C locale by Perl for +backwards compatibility, and because most XS code that reads floating point +values can cope only with the decimal radix character being a dot. + +This macro makes sure the current C<LC_NUMERIC> state is set properly, to be +aware of locale if the call to the XS or C code from the Perl program is +from within the scope of a S<C<use locale>>; or to ignore locale if the call is +instead from outside such scope. + +This macro is the start of wrapping the C or XS code; the wrap ending is done +by calling the L</RESTORE_LC_NUMERIC> macro after the operation. Otherwise +the state can be changed that will adversely affect other XS code. + +A call to L</DECLARATION_FOR_LC_NUMERIC_MANIPULATION> must have been made to +declare at compile time a private variable used by this macro. This macro +should be called as a single statement, not an expression, but with an empty +argument list, like this: + + { + DECLARATION_FOR_LC_NUMERIC_MANIPULATION; + ... + STORE_LC_NUMERIC_SET_TO_NEEDED(); + ... + RESTORE_LC_NUMERIC(); + ... + } + +=for apidoc Am|void|RESTORE_LC_NUMERIC + +This is used in conjunction with one of the macros +L</STORE_LC_NUMERIC_SET_TO_NEEDED> +and +L</STORE_LC_NUMERIC_FORCE_TO_UNDERLYING> + +to properly restore the C<LC_NUMERIC> state. + +A call to L</DECLARATION_FOR_LC_NUMERIC_MANIPULATION> must have been made to +declare at compile time a private variable used by this macro and the two +C<STORE> ones. This macro should be called as a single statement, not an +expression, but with an empty argument list, like this: + + { + DECLARATION_FOR_LC_NUMERIC_MANIPULATION; + ... + RESTORE_LC_NUMERIC(); + ... + } + +=cut + +*/ #define _NOT_IN_NUMERIC_STANDARD (! PL_numeric_standard) /* We can lock the category to stay in the C locale, making requests to the - * contrary noops, in the dynamic scope by setting PL_numeric_standard to 2 */ -#define _NOT_IN_NUMERIC_LOCAL (! PL_numeric_local && PL_numeric_standard < 2) - -#define DECLARATION_FOR_STORE_LC_NUMERIC_SET_TO_NEEDED \ - void (*_restore_LC_NUMERIC_function)(pTHX) = NULL; - -#define STORE_LC_NUMERIC_SET_TO_NEEDED() \ - if (IN_LC(LC_NUMERIC)) { \ - if (_NOT_IN_NUMERIC_LOCAL) { \ - set_numeric_local(); \ - _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; \ - } \ + * 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) + +#define DECLARATION_FOR_LC_NUMERIC_MANIPULATION \ + void (*_restore_LC_NUMERIC_function)(pTHX) = NULL + +#define STORE_LC_NUMERIC_SET_TO_NEEDED() \ + if (IN_LC(LC_NUMERIC)) { \ + if (_NOT_IN_NUMERIC_UNDERLYING) { \ + set_numeric_local(); \ + _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; \ + } \ } -#define DECLARE_STORE_LC_NUMERIC_SET_TO_NEEDED() \ - DECLARATION_FOR_STORE_LC_NUMERIC_SET_TO_NEEDED; \ - STORE_LC_NUMERIC_SET_TO_NEEDED(); - -#define RESTORE_LC_NUMERIC() \ - if (_restore_LC_NUMERIC_function) { \ - _restore_LC_NUMERIC_function(aTHX); \ +#define RESTORE_LC_NUMERIC() \ + if (_restore_LC_NUMERIC_function) { \ + _restore_LC_NUMERIC_function(aTHX); \ } /* The next two macros set unconditionally. These should be rarely used, and @@ -5916,65 +5996,88 @@ typedef struct am_table_short AMTS; STMT_START { if (_NOT_IN_NUMERIC_STANDARD) set_numeric_standard(); \ } STMT_END -#define SET_NUMERIC_LOCAL() \ - STMT_START { if (_NOT_IN_NUMERIC_LOCAL) \ +#define SET_NUMERIC_UNDERLYING() \ + STMT_START { if (_NOT_IN_NUMERIC_UNDERLYING) \ set_numeric_local(); } 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_NUMERIC_LOCAL_SET_STANDARD() \ - bool _was_local = _NOT_IN_NUMERIC_STANDARD; \ +#define STORE_LC_NUMERIC_UNDERLYING_SET_STANDARD() \ + bool _was_local = _NOT_IN_NUMERIC_STANDARD; \ if (_was_local) set_numeric_standard(); /* Doesn't change to underlying locale unless within the scope of some form of * 'use locale'. This is the usual desired behavior. */ -#define STORE_NUMERIC_STANDARD_SET_LOCAL() \ - bool _was_standard = _NOT_IN_NUMERIC_LOCAL \ - && IN_LC(LC_NUMERIC); \ +#define STORE_LC_NUMERIC_STANDARD_SET_UNDERLYING() \ + bool _was_standard = _NOT_IN_NUMERIC_UNDERLYING \ + && IN_LC(LC_NUMERIC); \ if (_was_standard) set_numeric_local(); /* Rarely, we want to change to the underlying locale even outside of 'use * locale'. This is principally in the POSIX:: functions */ -#define STORE_NUMERIC_STANDARD_FORCE_LOCAL() \ - bool _was_standard = _NOT_IN_NUMERIC_LOCAL; \ - if (_was_standard) set_numeric_local(); +#define STORE_LC_NUMERIC_FORCE_TO_UNDERLYING() \ + if (_NOT_IN_NUMERIC_UNDERLYING) { \ + set_numeric_local(); \ + _restore_LC_NUMERIC_function = &Perl_set_numeric_standard; \ + } /* Lock to the C locale until unlock is called */ -#define LOCK_NUMERIC_STANDARD() \ - (__ASSERT_(PL_numeric_standard) \ +#define LOCK_LC_NUMERIC_STANDARD() \ + (__ASSERT_(PL_numeric_standard) \ PL_numeric_standard = 2) -#define UNLOCK_NUMERIC_STANDARD() \ - (__ASSERT_(PL_numeric_standard == 2) \ +#define UNLOCK_LC_NUMERIC_STANDARD() \ + (__ASSERT_(PL_numeric_standard == 2) \ PL_numeric_standard = 1) -#define RESTORE_NUMERIC_LOCAL() \ +#define RESTORE_LC_NUMERIC_UNDERLYING() \ if (_was_local) set_numeric_local(); -#define RESTORE_NUMERIC_STANDARD() \ - if (_was_standard) SET_NUMERIC_STANDARD(); +#define RESTORE_LC_NUMERIC_STANDARD() \ + if (_restore_LC_NUMERIC_function) { \ + _restore_LC_NUMERIC_function(aTHX); \ + } #else /* !USE_LOCALE_NUMERIC */ -#define SET_NUMERIC_STANDARD() /**/ -#define SET_NUMERIC_LOCAL() /**/ +#define SET_LC_NUMERIC_STANDARD() +#define SET_LC_NUMERIC_UNDERLYING() #define IS_NUMERIC_RADIX(a, b) (0) -#define STORE_NUMERIC_LOCAL_SET_STANDARD() /**/ -#define STORE_NUMERIC_STANDARD_SET_LOCAL() /**/ -#define STORE_NUMERIC_STANDARD_FORCE_LOCAL() -#define RESTORE_NUMERIC_LOCAL() /**/ -#define RESTORE_NUMERIC_STANDARD() /**/ -#define DECLARATION_FOR_STORE_LC_NUMERIC_SET_TO_NEEDED +#define STORE_LC_NUMERIC_UNDERLYING_SET_STANDARD() +#define STORE_LC_NUMERIC_STANDARD_SET_UNDERLYING() +#define STORE_LC_NUMERIC_FORCE_TO_UNDERLYING() +#define RESTORE_LC_NUMERIC_UNDERLYING() +#define RESTORE_LC_NUMERIC_STANDARD() +#define DECLARATION_FOR_LC_NUMERIC_MANIPULATION #define STORE_LC_NUMERIC_SET_TO_NEEDED() -#define DECLARE_STORE_LC_NUMERIC_SET_TO_NEEDED() #define RESTORE_LC_NUMERIC() -#define LOCK_NUMERIC_STANDARD() -#define UNLOCK_NUMERIC_STANDARD() +#define LOCK_LC_NUMERIC_STANDARD() +#define UNLOCK_LC_NUMERIC_STANDARD() #endif /* !USE_LOCALE_NUMERIC */ #define Atof my_atof +/* Back-compat names */ +#define DECLARATION_FOR_STORE_LC_NUMERIC_SET_TO_NEEDED \ + DECLARATION_FOR_LC_NUMERIC_MANIPULATION +#define DECLARE_STORE_LC_NUMERIC_SET_TO_NEEDED() \ + DECLARATION_FOR_STORE_LC_NUMERIC_SET_TO_NEEDED; \ + STORE_LC_NUMERIC_SET_TO_NEEDED(); +#define LOCK_NUMERIC_STANDARD() LOCK_LC_NUMERIC_STANDARD() +#define RESTORE_NUMERIC_LOCAL() RESTORE_LC_NUMERIC_UNDERLYING() +#define RESTORE_NUMERIC_STANDARD() RESTORE_LC_NUMERIC_STANDARD() +#define SET_NUMERIC_LOCAL() SET_NUMERIC_UNDERLYING() +#define STORE_NUMERIC_LOCAL_SET_STANDARD() \ + STORE_LC_NUMERIC_UNDERLYING_SET_STANDARD() +#define STORE_NUMERIC_STANDARD_SET_LOCAL() \ + STORE_LC_NUMERIC_STANDARD_SET_UNDERLYING() +#define STORE_NUMERIC_STANDARD_FORCE_LOCAL() \ + STORE_LC_NUMERIC_FORCE_TO_UNDERLYING() +#define UNLOCK_NUMERIC_STANDARD() UNLOCK_LC_NUMERIC_STANDARD() + + + #ifdef USE_QUADMATH # define Perl_strtod(s, e) strtoflt128(s, e) #elif defined(HAS_LONG_DOUBLE) && defined(USE_LONG_DOUBLE) diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 64fb24b..747bd2f 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -480,7 +480,9 @@ well. =item * -XXX +Macros have been created to allow XS code to better manipulate the POSIX +locale category C<LC_NUMERIC>. +See L<perlapi/Locale-related functions and macros>. =back diff --git a/pod/perllocale.pod b/pod/perllocale.pod index 15e9181..2db9185 100644 --- a/pod/perllocale.pod +++ b/pod/perllocale.pod @@ -104,7 +104,8 @@ deficiencies, so keep reading. =head1 PREPARING TO USE LOCALES -Perl itself will not use locales unless specifically requested to (but +Perl itself (outside the L<POSIX> module) will not use locales unless +specifically requested to (but again note that Perl may interact with code that does use them). Even if there is such a request, B<all> of the following must be true for it to work properly: @@ -162,7 +163,8 @@ L<The setlocale function>. =head2 The C<"use locale"> pragma -By default, Perl itself ignores the current locale. The S<C<use locale>> +By default, Perl itself (outside the L<POSIX> module) +ignores the current locale. The S<C<use locale>> pragma tells Perl to use the current locale for some operations. Starting in v5.16, there are optional parameters to this pragma, described below, which restrict which operations are affected by it. @@ -215,6 +217,15 @@ underlying locale. For more discussion, see L<perlxs/CAVEATS>. =back +Note that all C programs (including the perl interpreter, which is +written in C) always have an underlying locale. That locale is the "C" +locale unless changed by a call to L<setlocale()|/The setlocale +function>. When Perl starts up, it changes the underlying locale to the +one which is indicated by the L</ENVIRONMENT>. When using the L<POSIX> +module or writing XS code, it is important to keep in mind that the +underlying locale may be something other than "C", even if the program +hasn't explicitly changed it. + =for comment The nbsp below makes this look better (though not great) @@ -1183,8 +1194,8 @@ of a match involving C<\w> while C<use locale> is in effect. =item PERL_SKIP_LOCALE_INIT -This environment variable, available starting in Perl v5.20, and if it -evaluates to a TRUE value, tells Perl to not use the rest of the +This environment variable, available starting in Perl v5.20, if set +(to any value), tells Perl to not use the rest of the environment variables to initialize with. Instead, Perl uses whatever the current locale settings are. This is particularly useful in embedded environments, see diff --git a/pp_ctl.c b/pp_ctl.c index ac0f1bc..6726802 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -824,7 +824,8 @@ PP(pp_formline) { Size_t max = SvLEN(PL_formtarget) - (t - SvPVX(PL_formtarget)); int len; - DECLARE_STORE_LC_NUMERIC_SET_TO_NEEDED(); + DECLARATION_FOR_LC_NUMERIC_MANIPULATION; + STORE_LC_NUMERIC_SET_TO_NEEDED(); arg &= ~(FORM_NUM_POINT|FORM_NUM_BLANK); #ifdef USE_QUADMATH { diff --git a/regcharclass.h b/regcharclass.h index 9f9c828..78340b8 100644 --- a/regcharclass.h +++ b/regcharclass.h @@ -2472,5 +2472,49 @@ #endif /* H_REGCHARCLASS */ /* Generated from: - * 76d3d07dadbba1440342f5ab3701db8c9f6df5a851b1cfd08f7b09014d4efc52 regen/regcharclass.pl + * 083180df694deb1fc173361406c1a75619fb8376403db3a76dc585c1e3951eca lib/Unicode/UCD.pm + * 827aa7ee45ca9fe09f3e0969a5a27a69ce58a6c7134548125266210018d27b49 lib/unicore/ArabicShaping.txt + * 3748fbbe9d280a9da700bfd0c28beaaf6f32a67ec263a124fcb0a4095a30fae5 lib/unicore/BidiBrackets.txt + * 3925329c2432fa7248b2e180cddcedb9a4f9eafbbb10ab9e105eaf833043b2fb lib/unicore/BidiMirroring.txt + * 7f5a1b4a346c6cdbe948d3baf50fc31fff29c26bcd4ad422dc1fbcc1c23b0bde lib/unicore/Blocks.txt + * 82f3cc8217455f22d294d7df767a62906baf31456ea8902336ae7fee943a2538 lib/unicore/CaseFolding.txt + * 8be553529f7dd22e3e0ffa25eb3f1743f5243bbfe868559be73bf3a163c21913 lib/unicore/CompositionExclusions.txt + * ab64278818411762311b9d5974438ac5cf14e98c79b44a6373022f0780de38a7 lib/unicore/DAge.txt + * f2ff892add5e6624cee8300c297373216df7f1a596c6e74510afe5e8b96c8d91 lib/unicore/DCoreProperties.txt + * 656aa2c6996a049e84c6d38676bc73c3245c808869d64073b812690ae475d534 lib/unicore/DNormalizationProps.txt + * e064b066e555cbace95951fcba9b5336a4d04c88c5949a1ff7615190eaa67682 lib/unicore/EastAsianWidth.txt + * 2aa574984e9cea6980eddd6e36044168d543b7f0449266fa3248aca28790cf06 lib/unicore/HangulSyllableType.txt + * e7122c4d4d598854b5fbefeb2b1ee9f05aef6a8d6e718b5f56c2a8ea31145f12 lib/unicore/IndicMatraCategory.txt + * 478ca00ea86b47209f0b27eb3959ad83cb2b76f5159213d242390d07d5af2b8d lib/unicore/IndicSyllabicCategory.txt + * 0aa8af5cbb4d0570b1006aefffc021c6ef637dffb15572a5a85e7f7e7778fe22 lib/unicore/Jamo.txt + * 3b359eeff325f7e773ea9d5feb8af053b94c579844f0db7ce648f418c9d136d8 lib/unicore/LineBreak.txt + * af85d961d0ed6055271ca6e0174451a8dc1822e31de9e07e1246535318b9341a lib/unicore/NameAliases.txt + * 1c379b9c1b0f6cd14208b766f74fc92ff5a9528aee66083db307f1fc9a615729 lib/unicore/NamedSequences.txt + * 0df343d93293f14e9ff0b0a721d8b8e6c23c86dbad7be18d362d6bf1281590d9 lib/unicore/PropList.txt + * 6c14f474761b8db46f95cf2d1e235ce40abf3382226c5b1a2210df83775fe6fa lib/unicore/PropValueAliases.txt + * 3f3dd77644faa905ce02de7c0e3167fdc4afdf94748f074192bd70821c8341ea lib/unicore/PropertyAliases.txt + * 2767531dec8c525a317ab488b95eed73461fe9c6fbb8088594f3886964724475 lib/unicore/ScriptExtensions.txt + * a638f9f0eb3c521ed6c7755fce93c04bf6e4ba89f23ac3d1bd4c4e486c400118 lib/unicore/Scripts.txt + * 35496d45fc8babd8deb866491ea82ff7b3d2d49ad4c9c656685cd14833101e25 lib/unicore/SpecialCasing.txt + * bfa3da58ea982199829e1107ac5a9a544b83100470a2d0cc28fb50ec234cb840 lib/unicore/UnicodeData.txt + * 916289f471c4a337fb1e0715985a11e6bc8bb205736e84164849d601d265d9e0 lib/unicore/auxiliary/GCBTest.txt + * 3d7ffae56e506d595f3e0e5d36978bc6721d53470e5ca9666ad7cdfc4a46cb3d lib/unicore/auxiliary/GraphemeBreakProperty.txt + * 370ddf3ba9b337819cf21795c2bd7cda578ac5ff4700d1a3ac923e8be988b57e lib/unicore/auxiliary/SBTest.txt + * 28356f6912113a9fe8244d9396e9786115dbc10b3ffb5e31b08969122e91d3f3 lib/unicore/auxiliary/SentenceBreakProperty.txt + * 3f56d3ccfc35c6dac44d143a4d6087af4e4ee9f1bdbae482c12f6149b60dec3b lib/unicore/auxiliary/WBTest.txt + * 82f7304030e6866ef8e02cdfb0485c52c18a661282bfce9c259cc6300abd79ad lib/unicore/auxiliary/WordBreakProperty.txt + * b88801b4a469207892a0401697c6b1c5fd64042ae0ef867f4ad0ec04942b415c lib/unicore/extracted/DBidiClass.txt + * 074d33ea6c7349eab840d690369dffb3568e2f7b039552b7c10480274d321545 lib/unicore/extracted/DBinaryProperties.txt + * 8ad457aef3525aedce823b9177dad33e0088df536dff11e3df405ecefc92ba08 lib/unicore/extracted/DCombiningClass.txt + * 59ec46c1e30458ffff50d41196fd45e3bbaf3172a8111117af1b930199be2d96 lib/unicore/extracted/DDecompositionType.txt + * cf7c07557ae915a7508c6c7fc8c2e8c900782364ec62e8a5d2813f3b97449ee0 lib/unicore/extracted/DEastAsianWidth.txt + * 56a5b47331a7ec784e848bcaae1ddc08cbf72aab583ca82dcc98ecf2851a3d43 lib/unicore/extracted/DGeneralCategory.txt + * c14e83161e56eb15d78b1589352d6c0bd8feb7889a5d17f70a2ebb2a43cab86d lib/unicore/extracted/DJoinGroup.txt + * 8c9405c54d8b1dd3fe2f2d691b30c0816ca15481995152ed07fc9b844dfd0ad4 lib/unicore/extracted/DJoinType.txt + * a9791f08281d7b0a417e4ad882cf64463f6815db8156932acd85228ac717fd94 lib/unicore/extracted/DLineBreak.txt + * a17a0330e57d774343a53c019f1bc69827c2676982a1bf48e0898a76710e8877 lib/unicore/extracted/DNumType.txt + * c2cb810a67cc5fb4a8d236b6c1bc6dd4d89733d8603881997e8aae2c816a3db1 lib/unicore/extracted/DNumValues.txt + * 2ee1b1f995a63cfdc5abe9b16f165447f85030420f452f7bbd47586c1b64020a lib/unicore/mktables + * 746472de66b936ac885ca6d6e68058242b4e909e3260c6317f3ec719f78f76cc lib/unicore/version + * 3eaedce3745bef6219cff3b5f63e5f8622c58dc66736281a82df991636d54451 regen/regcharclass.pl * ex: set ro: */ diff --git a/regen/mk_invlists.pl b/regen/mk_invlists.pl index 1473b55..7cd5bac 100644 --- a/regen/mk_invlists.pl +++ b/regen/mk_invlists.pl @@ -710,16 +710,22 @@ for my $charset (get_supported_code_pages()) { print $out_fh "\n" . get_conditional_compile_line_end(); } -my @sources = ($0, "lib/Unicode/UCD.pm"); +my $sources_list = "lib/unicore/mktables.lst"; +my @sources = ($0, qw(lib/unicore/mktables lib/Unicode/UCD.pm)); { # Depend on mktablesâ own sources. Itâs a shorter list of files than # those that Unicode::UCD uses. - open my $mktables_list, "lib/unicore/mktables.lst" - or die "$0 cannot open lib/unicore/mktables.lst: $!"; - while(<$mktables_list>) { - last if /===/; - chomp; - push @sources, "lib/unicore/$_" if /^[^#]/; + if (! open my $mktables_list, $sources_list) { + + # This should force a rebuild once $sources_list exists + push @sources, $sources_list; + } + else { + while(<$mktables_list>) { + last if /===/; + chomp; + push @sources, "lib/unicore/$_" if /^[^#]/; + } } } read_only_bottom_close_and_rename($out_fh, \@sources) diff --git a/regen/regcharclass.pl b/regen/regcharclass.pl index 9a83e54..0e12d8e 100755 --- a/regen/regcharclass.pl +++ b/regen/regcharclass.pl @@ -1456,7 +1456,26 @@ EOF if($path eq '-') { print $out_fh "/* ex: set ro: */\n"; } else { - read_only_bottom_close_and_rename($out_fh, [$0]) + # Some of the sources for these macros come from Unicode tables + my $sources_list = "lib/unicore/mktables.lst"; + my @sources = ($0, qw(lib/unicore/mktables lib/Unicode/UCD.pm)); + { + # Depend on mktablesâ own sources. Itâs a shorter list of files than + # those that Unicode::UCD uses. + if (! open my $mktables_list, $sources_list) { + + # This should force a rebuild once $sources_list exists + push @sources, $sources_list; + } + else { + while(<$mktables_list>) { + last if /===/; + chomp; + push @sources, "lib/unicore/$_" if /^[^#]/; + } + } + } + read_only_bottom_close_and_rename($out_fh, \@sources) } } diff --git a/regen/regen_lib.pl b/regen/regen_lib.pl index abeecba..81069fa 100644 --- a/regen/regen_lib.pl +++ b/regen/regen_lib.pl @@ -182,7 +182,13 @@ sub read_only_bottom_close_and_rename { if ($sources) { $comment = "Generated from:\n"; foreach my $file (sort @$sources) { - my $digest = digest($file); + my $digest = (-e $file) + ? digest($file) + # Use a random number that won't match the real + # digest, so will always show as out-of-date, so + # Porting tests likely will fail drawing attention + # to the problem. + : int(rand(1_000_000)); $comment .= "$digest $file\n"; } } diff --git a/sv.c b/sv.c index 5c92c0b..341d591 100644 --- a/sv.c +++ b/sv.c @@ -3160,7 +3160,8 @@ Perl_sv_2pv_flags(pTHX_ SV *const sv, STRLEN *const lp, const I32 flags) #else { bool local_radix; - DECLARE_STORE_LC_NUMERIC_SET_TO_NEEDED(); + DECLARATION_FOR_LC_NUMERIC_MANIPULATION; + STORE_LC_NUMERIC_SET_TO_NEEDED(); local_radix = PL_numeric_local && @@ -11205,7 +11206,7 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p bool no_redundant_warning = FALSE; /* did we use any explicit format parameter index? */ bool hexfp = FALSE; /* hexadecimal floating point? */ - DECLARATION_FOR_STORE_LC_NUMERIC_SET_TO_NEEDED; + DECLARATION_FOR_LC_NUMERIC_MANIPULATION; PERL_ARGS_ASSERT_SV_VCATPVFN_FLAGS; PERL_UNUSED_ARG(maybe_tainted); diff --git a/toke.c b/toke.c index 3b60488..610db62 100644 --- a/toke.c +++ b/toke.c @@ -10472,7 +10472,7 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) floatit = TRUE; } if (floatit) { - STORE_NUMERIC_LOCAL_SET_STANDARD(); + STORE_LC_NUMERIC_UNDERLYING_SET_STANDARD(); /* terminate the string */ *d = '\0'; if (UNLIKELY(hexfp)) { @@ -10489,7 +10489,7 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) } else { nv = Atof(PL_tokenbuf); } - RESTORE_NUMERIC_LOCAL(); + RESTORE_LC_NUMERIC_UNDERLYING(); sv = newSVnv(nv); } -- Perl5 Master Repository
