diff options
| -rw-r--r-- | dump.c | 8 | ||||
| -rw-r--r-- | ext/POSIX/POSIX.xs | 21 | ||||
| -rw-r--r-- | numeric.c | 8 | ||||
| -rw-r--r-- | perl.h | 131 | ||||
| -rw-r--r-- | pp_ctl.c | 3 | ||||
| -rw-r--r-- | sv.c | 5 | ||||
| -rw-r--r-- | toke.c | 4 |
7 files changed, 99 insertions, 81 deletions
@@ -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 5a2c30622f..43fad83ce4 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 @@ -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); @@ -5866,45 +5866,33 @@ 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). */ #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; \ - } \ +#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); \ @@ -5916,65 +5904,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) @@ -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 { @@ -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); @@ -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); } |