Skip to content

Commit a06a4d4

Browse files
hvdshvds
committed
[perl #134172] restrict scope of locale changes during sprintf
In some environments we must hold a mutex for the duration of a temporary locale change, so we must ensure that mutex is released appropriately. This means intervening code must not croak, or otherwise bypass the unlock. In sv_vcatpvfn_flags(), that requirement was violated when attempting to avoid multiple temporary locale changes by collapsing them into a single one. This partially undoes that to fix the problem, while still attempting to retain some of the benefits by caching the expensive hints check.
1 parent a3c7756 commit a06a4d4

File tree

2 files changed

+89
-55
lines changed

2 files changed

+89
-55
lines changed

‎perl.h

Lines changed: 33 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -6432,6 +6432,29 @@ expression, but with an empty argument list, like this:
64326432
...
64336433
}
64346434
6435+
=for apidoc Am|void|WITH_LC_NUMERIC_SET_TO_NEEDED
6436+
6437+
This macro invokes the supplied statement or block within the context
6438+
of a L</STORE_LC_NUMERIC_SET_TO_NEEDED> .. L</RESTORE_LC_NUMERIC> pair
6439+
if required, so eg:
6440+
6441+
WITH_LC_NUMERIC_SET_TO_NEEDED(
6442+
SNPRINTF_G(fv, ebuf, sizeof(ebuf), precis)
6443+
);
6444+
6445+
is equivalent to:
6446+
6447+
{
6448+
#ifdef USE_LOCALE_NUMERIC
6449+
DECLARATION_FOR_LC_NUMERIC_MANIPULATION;
6450+
STORE_LC_NUMERIC_SET_TO_NEEDED();
6451+
#endif
6452+
SNPRINTF_G(fv, ebuf, sizeof(ebuf), precis);
6453+
#ifdef USE_LOCALE_NUMERIC
6454+
RESTORE_LC_NUMERIC();
6455+
#endif
6456+
}
6457+
64356458
=cut
64366459
64376460
*/
@@ -6554,6 +6577,14 @@ expression, but with an empty argument list, like this:
65546577
__FILE__, __LINE__, PL_numeric_standard)); \
65556578
} STMT_END
65566579

6580+
# define WITH_LC_NUMERIC_SET_TO_NEEDED(block) \
6581+
STMT_START { \
6582+
DECLARATION_FOR_LC_NUMERIC_MANIPULATION; \
6583+
STORE_LC_NUMERIC_SET_TO_NEEDED(); \
6584+
block; \
6585+
RESTORE_LC_NUMERIC(); \
6586+
} STMT_END;
6587+
65576588
#else /* !USE_LOCALE_NUMERIC */
65586589

65596590
# define SET_NUMERIC_STANDARD()
@@ -6566,6 +6597,8 @@ expression, but with an empty argument list, like this:
65666597
# define RESTORE_LC_NUMERIC()
65676598
# define LOCK_LC_NUMERIC_STANDARD()
65686599
# define UNLOCK_LC_NUMERIC_STANDARD()
6600+
# define WITH_LC_NUMERIC_SET_TO_NEEDED(block) \
6601+
STMT_START { block; } STMT_END
65696602

65706603
#endif /* !USE_LOCALE_NUMERIC */
65716604

‎sv.c

Lines changed: 56 additions & 55 deletions
Original file line numberDiff line numberDiff line change
@@ -11562,7 +11562,9 @@ S_hextract(pTHX_ const NV nv, int* exponent, bool *subnormal,
1156211562
* The rest of the args have the same meaning as the local vars of the
1156311563
* same name within Perl_sv_vcatpvfn_flags().
1156411564
*
11565-
* It assumes the caller has already done STORE_LC_NUMERIC_SET_TO_NEEDED();
11565+
* The caller's determination of IN_LC(LC_NUMERIC), passed as in_lc_numeric,
11566+
* is used to ensure we do the right thing when we need to access the locale's
11567+
* numeric radix.
1156611568
*
1156711569
* It requires the caller to make buf large enough.
1156811570
*/
@@ -11571,7 +11573,7 @@ static STRLEN
1157111573
S_format_hexfp(pTHX_ char * const buf, const STRLEN bufsize, const char c,
1157211574
const NV nv, const vcatpvfn_long_double_t fv,
1157311575
bool has_precis, STRLEN precis, STRLEN width,
11574-
bool alt, char plus, bool left, bool fill)
11576+
bool alt, char plus, bool left, bool fill, bool in_lc_numeric)
1157511577
{
1157611578
/* Hexadecimal floating point. */
1157711579
char* p = buf;
@@ -11778,17 +11780,19 @@ S_format_hexfp(pTHX_ char * const buf, const STRLEN bufsize, const char c,
1177811780

1177911781
if (hexradix) {
1178011782
#ifndef USE_LOCALE_NUMERIC
11781-
*p++ = '.';
11783+
*p++ = '.';
1178211784
#else
11783-
if (IN_LC(LC_NUMERIC)) {
11784-
STRLEN n;
11785+
if (in_lc_numeric) {
11786+
STRLEN n;
11787+
WITH_LC_NUMERIC_SET_TO_NEEDED({
1178511788
const char* r = SvPV(PL_numeric_radix_sv, n);
1178611789
Copy(r, p, n, char);
11787-
p += n;
11788-
}
11789-
else {
11790-
*p++ = '.';
11791-
}
11790+
});
11791+
p += n;
11792+
}
11793+
else {
11794+
*p++ = '.';
11795+
}
1179211796
#endif
1179311797
}
1179411798

@@ -11894,9 +11898,10 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
1189411898
char ebuf[IV_DIG * 4 + NV_DIG + 32];
1189511899
bool no_redundant_warning = FALSE; /* did we use any explicit format parameter index? */
1189611900
#ifdef USE_LOCALE_NUMERIC
11897-
DECLARATION_FOR_LC_NUMERIC_MANIPULATION;
11898-
bool lc_numeric_set = FALSE; /* called STORE_LC_NUMERIC_SET_TO_NEEDED? */
11901+
bool have_in_lc_numeric = FALSE;
1189911902
#endif
11903+
/* we never change this unless USE_LOCALE_NUMERIC */
11904+
bool in_lc_numeric = FALSE;
1190011905

1190111906
PERL_ARGS_ASSERT_SV_VCATPVFN_FLAGS;
1190211907
PERL_UNUSED_ARG(maybe_tainted);
@@ -12967,33 +12972,31 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
1296712972
* below, or implicitly, via an snprintf() variant.
1296812973
* Note also things like ps_AF.utf8 which has
1296912974
* "\N{ARABIC DECIMAL SEPARATOR} as a radix point */
12970-
if (!lc_numeric_set) {
12971-
/* only set once and reuse in-locale value on subsequent
12972-
* iterations.
12973-
* XXX what happens if we die in an eval?
12974-
*/
12975-
STORE_LC_NUMERIC_SET_TO_NEEDED();
12976-
lc_numeric_set = TRUE;
12975+
if (! have_in_lc_numeric) {
12976+
in_lc_numeric = IN_LC(LC_NUMERIC);
12977+
have_in_lc_numeric = TRUE;
1297712978
}
1297812979

12979-
if (IN_LC(LC_NUMERIC)) {
12980-
/* this can't wrap unless PL_numeric_radix_sv is a string
12981-
* consuming virtually all the 32-bit or 64-bit address
12982-
* space
12983-
*/
12984-
float_need += (SvCUR(PL_numeric_radix_sv) - 1);
12985-
12986-
/* floating-point formats only get utf8 if the radix point
12987-
* is utf8. All other characters in the string are < 128
12988-
* and so can be safely appended to both a non-utf8 and utf8
12989-
* string as-is.
12990-
* Note that this will convert the output to utf8 even if
12991-
* the radix point didn't get output.
12992-
*/
12993-
if (SvUTF8(PL_numeric_radix_sv) && !has_utf8) {
12994-
sv_utf8_upgrade(sv);
12995-
has_utf8 = TRUE;
12996-
}
12980+
if (in_lc_numeric) {
12981+
WITH_LC_NUMERIC_SET_TO_NEEDED({
12982+
/* this can't wrap unless PL_numeric_radix_sv is a string
12983+
* consuming virtually all the 32-bit or 64-bit address
12984+
* space
12985+
*/
12986+
float_need += (SvCUR(PL_numeric_radix_sv) - 1);
12987+
12988+
/* floating-point formats only get utf8 if the radix point
12989+
* is utf8. All other characters in the string are < 128
12990+
* and so can be safely appended to both a non-utf8 and utf8
12991+
* string as-is.
12992+
* Note that this will convert the output to utf8 even if
12993+
* the radix point didn't get output.
12994+
*/
12995+
if (SvUTF8(PL_numeric_radix_sv) && !has_utf8) {
12996+
sv_utf8_upgrade(sv);
12997+
has_utf8 = TRUE;
12998+
}
12999+
});
1299713000
}
1299813001
#endif
1299913002

@@ -13068,7 +13071,9 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
1306813071
&& !fill
1306913072
&& intsize != 'q'
1307013073
) {
13071-
SNPRINTF_G(fv, ebuf, sizeof(ebuf), precis);
13074+
WITH_LC_NUMERIC_SET_TO_NEEDED(
13075+
SNPRINTF_G(fv, ebuf, sizeof(ebuf), precis)
13076+
);
1307213077
elen = strlen(ebuf);
1307313078
eptr = ebuf;
1307413079
goto float_concat;
@@ -13113,7 +13118,7 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
1311313118
if (UNLIKELY(hexfp)) {
1311413119
elen = S_format_hexfp(aTHX_ PL_efloatbuf, PL_efloatsize, c,
1311513120
nv, fv, has_precis, precis, width,
13116-
alt, plus, left, fill);
13121+
alt, plus, left, fill, in_lc_numeric);
1311713122
}
1311813123
else {
1311913124
char *ptr = ebuf + sizeof ebuf;
@@ -13169,8 +13174,10 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
1316913174
const char* qfmt = quadmath_format_single(ptr);
1317013175
if (!qfmt)
1317113176
Perl_croak_nocontext("panic: quadmath invalid format \"%s\"", ptr);
13172-
elen = quadmath_snprintf(PL_efloatbuf, PL_efloatsize,
13173-
qfmt, nv);
13177+
WITH_LC_NUMERIC_SET_TO_NEEDED(
13178+
elen = quadmath_snprintf(PL_efloatbuf, PL_efloatsize,
13179+
qfmt, nv);
13180+
);
1317413181
if ((IV)elen == -1) {
1317513182
if (qfmt != ptr)
1317613183
SAVEFREEPV(qfmt);
@@ -13180,11 +13187,15 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
1318013187
Safefree(qfmt);
1318113188
}
1318213189
#elif defined(HAS_LONG_DOUBLE)
13183-
elen = ((intsize == 'q')
13184-
? my_snprintf(PL_efloatbuf, PL_efloatsize, ptr, fv)
13185-
: my_snprintf(PL_efloatbuf, PL_efloatsize, ptr, (double)fv));
13190+
WITH_LC_NUMERIC_SET_TO_NEEDED(
13191+
elen = ((intsize == 'q')
13192+
? my_snprintf(PL_efloatbuf, PL_efloatsize, ptr, fv)
13193+
: my_snprintf(PL_efloatbuf, PL_efloatsize, ptr, (double)fv))
13194+
);
1318613195
#else
13187-
elen = my_snprintf(PL_efloatbuf, PL_efloatsize, ptr, fv);
13196+
WITH_LC_NUMERIC_SET_TO_NEEDED(
13197+
elen = my_snprintf(PL_efloatbuf, PL_efloatsize, ptr, fv)
13198+
);
1318813199
#endif
1318913200
GCC_DIAG_RESTORE_STMT;
1319013201
}
@@ -13406,16 +13417,6 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
1340613417
}
1340713418

1340813419
SvTAINT(sv);
13409-
13410-
#ifdef USE_LOCALE_NUMERIC
13411-
13412-
if (lc_numeric_set) {
13413-
RESTORE_LC_NUMERIC(); /* Done outside loop, so don't have to
13414-
save/restore each iteration. */
13415-
}
13416-
13417-
#endif
13418-
1341913420
}
1342013421

1342113422
/* =========================================================================

0 commit comments

Comments
 (0)