diff --git a/perl.h b/perl.h index 29d12696b50d..1b14e9c49a62 100644 --- a/perl.h +++ b/perl.h @@ -6411,7 +6411,15 @@ argument list, like this: On threaded perls not operating with thread-safe functionality, this macro uses a mutex to force a critical section. Therefore the matching RESTORE should be -close by, and guaranteed to be called. +close by, and guaranteed to be called; see L +for a more contained way to ensure that. + +=for apidoc Am|void|STORE_LC_NUMERIC_SET_TO_NEEDED_IN|bool in_lc_numeric + +Same as L with in_lc_numeric provided +as the precalculated value of C. It is the caller's +responsibility to ensure that the status of C and C +cannot have changed since the precalculation. =for apidoc Am|void|RESTORE_LC_NUMERIC @@ -6455,6 +6463,13 @@ is equivalent to: #endif } +=for apidoc Am|void|WITH_LC_NUMERIC_SET_TO_NEEDED_IN|bool in_lc_numeric + +Same as L with in_lc_numeric provided +as the precalculated value of C. It is the caller's +responsibility to ensure that the status of C and C +cannot have changed since the precalculation. + =cut */ @@ -6482,12 +6497,13 @@ is equivalent to: # define DECLARATION_FOR_LC_NUMERIC_MANIPULATION \ void (*_restore_LC_NUMERIC_function)(pTHX) = NULL -# define STORE_LC_NUMERIC_SET_TO_NEEDED() \ +# define STORE_LC_NUMERIC_SET_TO_NEEDED_IN(in) \ STMT_START { \ + bool _in_lc_numeric = (in); \ LC_NUMERIC_LOCK( \ - ( ( IN_LC(LC_NUMERIC) && _NOT_IN_NUMERIC_UNDERLYING) \ - || (! IN_LC(LC_NUMERIC) && _NOT_IN_NUMERIC_STANDARD)));\ - if (IN_LC(LC_NUMERIC)) { \ + ( ( _in_lc_numeric && _NOT_IN_NUMERIC_UNDERLYING) \ + || (! _in_lc_numeric && _NOT_IN_NUMERIC_STANDARD))); \ + if (_in_lc_numeric) { \ if (_NOT_IN_NUMERIC_UNDERLYING) { \ Perl_set_numeric_underlying(aTHX); \ _restore_LC_NUMERIC_function \ @@ -6503,6 +6519,9 @@ is equivalent to: } \ } STMT_END +# define STORE_LC_NUMERIC_SET_TO_NEEDED() \ + STORE_LC_NUMERIC_SET_TO_NEEDED_IN(IN_LC(LC_NUMERIC)) + # define RESTORE_LC_NUMERIC() \ STMT_START { \ if (_restore_LC_NUMERIC_function) { \ @@ -6577,14 +6596,17 @@ is equivalent to: __FILE__, __LINE__, PL_numeric_standard)); \ } STMT_END -# define WITH_LC_NUMERIC_SET_TO_NEEDED(block) \ +# define WITH_LC_NUMERIC_SET_TO_NEEDED_IN(in_lc_numeric, block) \ STMT_START { \ DECLARATION_FOR_LC_NUMERIC_MANIPULATION; \ - STORE_LC_NUMERIC_SET_TO_NEEDED(); \ + STORE_LC_NUMERIC_SET_TO_NEEDED_IN(in_lc_numeric); \ block; \ RESTORE_LC_NUMERIC(); \ } STMT_END; +# define WITH_LC_NUMERIC_SET_TO_NEEDED(block) \ + WITH_LC_NUMERIC_SET_TO_NEEDED_IN(IN_LC(LC_NUMERIC), block) + #else /* !USE_LOCALE_NUMERIC */ # define SET_NUMERIC_STANDARD() @@ -6593,10 +6615,13 @@ is equivalent to: # define DECLARATION_FOR_LC_NUMERIC_MANIPULATION # define STORE_LC_NUMERIC_SET_STANDARD() # define STORE_LC_NUMERIC_FORCE_TO_UNDERLYING() +# define STORE_LC_NUMERIC_SET_TO_NEEDED_IN(in_lc_numeric) # define STORE_LC_NUMERIC_SET_TO_NEEDED() # define RESTORE_LC_NUMERIC() # define LOCK_LC_NUMERIC_STANDARD() # define UNLOCK_LC_NUMERIC_STANDARD() +# define WITH_LC_NUMERIC_SET_TO_NEEDED_IN(in_lc_numeric, block) \ + STMT_START { block; } STMT_END # define WITH_LC_NUMERIC_SET_TO_NEEDED(block) \ STMT_START { block; } STMT_END diff --git a/sv.c b/sv.c index ef2c71126c9e..df0b601650ca 100644 --- a/sv.c +++ b/sv.c @@ -11784,7 +11784,7 @@ S_format_hexfp(pTHX_ char * const buf, const STRLEN bufsize, const char c, #else if (in_lc_numeric) { STRLEN n; - WITH_LC_NUMERIC_SET_TO_NEEDED({ + WITH_LC_NUMERIC_SET_TO_NEEDED_IN(TRUE, { const char* r = SvPV(PL_numeric_radix_sv, n); Copy(r, p, n, char); }); @@ -12978,7 +12978,7 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p } if (in_lc_numeric) { - WITH_LC_NUMERIC_SET_TO_NEEDED({ + WITH_LC_NUMERIC_SET_TO_NEEDED_IN(TRUE, { /* this can't wrap unless PL_numeric_radix_sv is a string * consuming virtually all the 32-bit or 64-bit address * space @@ -13071,7 +13071,7 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p && !fill && intsize != 'q' ) { - WITH_LC_NUMERIC_SET_TO_NEEDED( + WITH_LC_NUMERIC_SET_TO_NEEDED_IN(in_lc_numeric, SNPRINTF_G(fv, ebuf, sizeof(ebuf), precis) ); elen = strlen(ebuf); @@ -13174,7 +13174,7 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p const char* qfmt = quadmath_format_single(ptr); if (!qfmt) Perl_croak_nocontext("panic: quadmath invalid format \"%s\"", ptr); - WITH_LC_NUMERIC_SET_TO_NEEDED( + WITH_LC_NUMERIC_SET_TO_NEEDED_IN(in_lc_numeric, elen = quadmath_snprintf(PL_efloatbuf, PL_efloatsize, qfmt, nv); ); @@ -13187,13 +13187,13 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p Safefree(qfmt); } #elif defined(HAS_LONG_DOUBLE) - WITH_LC_NUMERIC_SET_TO_NEEDED( + WITH_LC_NUMERIC_SET_TO_NEEDED_IN(in_lc_numeric, elen = ((intsize == 'q') ? my_snprintf(PL_efloatbuf, PL_efloatsize, ptr, fv) : my_snprintf(PL_efloatbuf, PL_efloatsize, ptr, (double)fv)) ); #else - WITH_LC_NUMERIC_SET_TO_NEEDED( + WITH_LC_NUMERIC_SET_TO_NEEDED_IN(in_lc_numeric, elen = my_snprintf(PL_efloatbuf, PL_efloatsize, ptr, fv) ); #endif