commit 027471cf breaks t/op/sprintf2.t on FreeBSD-11 #17034
Comments
From @jkeenanThe following smoke test indicates that a recent change to blead is ##### In each of 36 different configurations in the smoke test run, all tests ##### ok 1 - the sprintf "%.<number>g" optimization Test Summary Report op/sprintf2.t (Wstat: 2304 Tests: 1699 Failed: 0) Bisecting with the following command ... ##### ... gave this result: ##### ... which is not useful. I hypothesized that something is tickling To test this hypothesis, I reviewed 'git log' and noticed two commits ##### (perl #133913) limit numeric format results to INT_MAX The return value of v?snprintf() is int, and we pay attention to that Thank you very much. ##### Characteristics of this binary (from libperl): |
From @jkeenanOn Tue, 04 Jun 2019 00:14:02 GMT, jkeenan@pobox.com wrote:
The problem lies in this unit test which was added to t/op/sprintf2.t in the commit in question: ##### If I comment out this test, I get a PASS. So something's amiss with that test in relation to the harness. Thank you very much. -- |
From [Unknown Contact. See original ticket]On Tue, 04 Jun 2019 00:14:02 GMT, jkeenan@pobox.com wrote:
The problem lies in this unit test which was added to t/op/sprintf2.t in the commit in question: ##### If I comment out this test, I get a PASS. So something's amiss with that test in relation to the harness. Thank you very much. -- |
From @hvdsOn Mon, 03 Jun 2019 17:14:02 -0700, jkeenan@pobox.com wrote:
It's this non-zero exit status that's making it a fail. That's reporting that it terminated with a SEGV. It's a bit strange that a change is causing a segv only after that test has run successfully, but definitely a good reason for calling it failure. I can't yet reproduce it here, but you should be getting a core dump. If you can generate one (ideally on a debugging perl) and get a stack trace out of gdb it should be possible to diagnose the problem. Hugo |
|
The RT System itself - Status changed from 'new' to 'open' |
From @jkeenanOn Tue, 04 Jun 2019 01:15:35 GMT, hv wrote:
I haven't used gdb in years, so I'm fumbling around. Does this help? ##### |
From @jkeenanOn Tue, 04 Jun 2019 02:22:56 GMT, jkeenan wrote:
That non-printing character is octal: 357 277 275
Same here. -- |
From @khwilliamsonOn 6/3/19 8:35 PM, James E Keenan via RT wrote:
which is REPLACEMENT CHARACTER
|
From @hvdsOn Mon, 03 Jun 2019 19:22:56 -0700, jkeenan wrote:
Well, it is exactly what I asked for.
We're in sys_term, so most of the interpreter has already been wiped out, but we're then calling croak(), which relies on the interpreter's infrastructure. My best guess is that we're hitting 'Perl_croak_nocontext("panic: MUTEX_UNLOCK (%d) [%s:%d]" ...)' in one of the MUTEX_UNLOCK calls, and some wild writes have corrupted both one of our mutexes and perhaps this panic string. It seems like it'd be hard for it to get this far with that level of corruption though. I'll try harder to reproduce it: I'd need some interactive gdb work to diagnose it. Hugo |
From @hvdsOn Mon, 03 Jun 2019 21:15:59 -0700, hv wrote:
Oops, s/MUTEX_UNLOCK/MUTEX_DESTROY/g
|
From @jkeenanOn Tue, 04 Jun 2019 04:15:59 GMT, hv wrote:
This is now showing up on other OSes. See: -- |
From @hvdsOn Mon, 03 Jun 2019 21:15:59 -0700, hv wrote:
I still cannot reproduce here. Please could you try getting another stacktrace with the attached patch applied, to narrow down which bit of Perl_sys_term() we're in? To help with subsequent tests, it would also be useful to narrow down the testcase. Please check if any of these reproduce the SEGV: Cheers, Hugo |
From @hvds0001-DO-NOT-COMMIT-expand-PERL_SYS_TERM_BODY.patchFrom 03ad1fae97d9b34922e0e00f387cebe466ca13ef Mon Sep 17 00:00:00 2001
From: Hugo van der Sanden <hv@crypt.org>
Date: Wed, 5 Jun 2019 11:29:12 +0100
Subject: [PATCH] DO NOT COMMIT: expand PERL_SYS_TERM_BODY
Expand the unixish body for Perl_sys_term() for more useful stacktrace.
---
perl.c | 9 ++++++++-
1 file changed, 8 insertions(+), 1 deletion(-)
diff --git a/perl.c b/perl.c
index 69e3efcd70..acb7c4f2a2 100644
--- a/perl.c
+++ b/perl.c
@@ -143,7 +143,14 @@ Perl_sys_term(void)
{
dVAR;
if (!PL_veto_cleanup) {
- PERL_SYS_TERM_BODY();
+ HINTS_REFCNT_TERM; /* PL_hints_mutex */
+ KEYWORD_PLUGIN_MUTEX_TERM; /* PL_keyword_plugin_mutex */
+ OP_CHECK_MUTEX_TERM; /* PL_check_mutex */
+ OP_REFCNT_TERM; /* PL_op_mutex */
+ PERLIO_TERM; /* PerlIO_teardown() */
+ MALLOC_TERM; /* PL_malloc_mutex */
+ LOCALE_TERM; /* PL_locale_mutex */
+ USER_PROP_MUTEX_TERM; /* PL_user_prop_mutex */
}
}
--
2.17.1
|
From @hvds#!./perl -w # Tests for sprintf that do not fit the format of sprintf.t. BEGIN { use strict; # large uvsize needed so the large width is parsed properly |
From @jkeenanOn Wed, 05 Jun 2019 10:39:48 GMT, hv wrote:
(The previously reported backtrace was from a version of t/op/sprintf2.t with all tests but the final one commented out.) See attachment, hugo-results-20190605.txt. -- |
From @jkeenanWork on RT 134172 sprintf2.t on FreeBSD 06/05 07:53 am 1. Confirmed that I still have intact the DEBUGGING perl I built on nycbug host. Noted that at this point, while I'm in local branch rt-134172-sprintf2, that branch is identical to blead. Confirmed that t/op/sprintf2.t FAIL with segfault. 2. Copied Hugo's sprintf2-short.t into t/op. Ran it thru harness. Got FAIL. 3. Tried Hugo's two one-liners with my DEBUGGING build. a. Hugo's first one-liner. (Note that this generates a warning.) $ rm ./perl.core; ./perl -e 'my $x = sprintf("%7000000000E", 0)'; ls -ltr . | tail -1 b. Hugo's second one-liner. (Note that this does not generate a warning.) $ rm ./perl.core; ./perl -e 'eval { my $x = sprintf("%7000000000E", 0) }; print "ok\n"'; ls -ltr . | tail -1 4. Applied Hugo's patch to branch; rebuilt perl with customary FreeBSD configuration switches plus '-DDEBUGGING'. $ git clean -dfx a. Re-run the test file and inspect the core dump. ##### ok 1 - croak for very large numeric format results Test Summary Report op/sprintf2-short.t (Wstat: 139 Tests: 1 Failed: 0) $ gdb perl t/perl.core $ rm t/perl.core b. Run Hugo's first one-liner and inspect the core dump. ##### [perl] $ gdb perl ./perl.core c. Run Hugo's second one-liner and inspect the core-dump. ##### $ gdb perl ./perl.core |
From @jkeenanOn Wed, 05 Jun 2019 00:37:31 GMT, jkeenan wrote:
But, to further aggravate us, the FAIL is showing up on our FreeBSD-11 smokers but not our FreeBSD-12 or -13 smoker. FreeBSD-12.0-RELEASE-p4: http://perl5.test-smoke.org/report/89000 PASS |
From @hvdsOn Wed, 05 Jun 2019 05:39:11 -0700, jkeenan wrote:
Ah ok; since the first one-liner is enough to reproduce the crash, I suggest sticking with that for further testing: [...]
That looks like it is in the line: From here I'll need some help: I'm not sure how to refer to the location of this mutex for a threaded build in gdb - I was expecting it to be something like 'my_vars->Glocale_mutex', but at least on my local build that's not recognised. If someone can tell us that, the next step will be to run the test in gdb with a hardware watchpoint on the mutex. That'll look something like this: shell% gdb --args ./perl -e 'my $x = sprintf("%7000000000E", 0)' Hopefully that would then stop somewhere other than in the MUTEX_DESTROY, and a stack trace will show us where and how the corruption is occurring. Hugo |
From @jkeenanOn Wed, 05 Jun 2019 13:22:36 GMT, hv wrote:
I'm not sure whether you wanted *me* to run the above commands prior to hearing from someone about mutexes, but, for what it's worth, here's what I got: ##### Starting program: /usr/home/jkeenan/gitwork/perl/perl -e my\ \$x\ =\ sprintf\(\"%7000000000E\",\ 0\) Old value = 0x0 Thank you very much. -- |
From @hvdsOn Wed, 05 Jun 2019 06:32:12 -0700, jkeenan wrote:
I had not expected it would work, but since it did let's go with it. :) (For me that just gives 'No symbol "PL_locale_mutex" in current context'.)
That's slightly odd, the intent of the tbreak was to get past the initialize (which the stack trace shows is invoked from perlmain.c:119). Never mind, please get to this point again, then continue with: (gdb) cont .. and let's see where it stops next, and get another stack trace. Hugo |
From @jkeenanOn Wed, 05 Jun 2019 14:22:10 GMT, hv wrote:
After 'cont', the program hung for > 1 minute, so I Ctrl-C-ed it. ##### Old value = 0x0 -- |
From @hvdsOn Wed, 05 Jun 2019 07:54:26 -0700, jkeenan wrote:
Watchpoints can make things rather slow; you'll see from the stack trace that we're still in perl_parse(), so we haven't got as far as running the program yet. My guess is that it should complete in 10-15 minutes, but if possible please allow at least up to an hour before giving up on it. Hugo |
From @jkeenanOn Wed, 05 Jun 2019 15:26:36 GMT, hv wrote:
Did not know that. Have to go AFK. Will resume tonight. Thanks. -- |
From @khwilliamsonOn 6/5/19 9:40 AM, James E Keenan via RT wrote:
I have access to a 11.1-RELEASE FreeBSD 11.1-RELEASE #0 r321309: Fri Jul When I run ./perl -e 'my $x = sprintf("%7000000000E", 0)' |
From @jkeenanOn Wed, 05 Jun 2019 15:26:36 GMT, hv wrote:
I let it run overnight. No difference in results. ##### -- |
From @hvdsOn Thu, 06 Jun 2019 04:37:28 -0700, jkeenan wrote:
Oh, that's sad, it's clearly hanging in that time() call for some reason. Let's try a different approach, closer to the likely source of the problem. Line 12950 of sv.c should be "float_need = 1 /* possible unary minus */", the point we start handling the large number in the sprintf pattern. Check that this is the right line, and thn try the following: shell% gdb --args ./perl -we 'my $x = sprintf("%7000000000E", 0)' and then: Hugo |
From @jkeenanOn Thu, 06 Jun 2019 14:17:46 GMT, hv wrote:
##### Breakpoint 1, Perl_sv_vcatpvfn_flags (my_perl=<value optimized out>, sv=<value optimized out>, Breakpoint 1, Perl_sv_vcatpvfn_flags (my_perl=<value optimized out>, sv=<value optimized out>, Program received signal SIGSEGV, Segmentation fault. -- |
From @jkeenanOn Thu, 06 Jun 2019 15:12:34 GMT, jkeenan wrote:
Followed by: ##### -- |
From @hvdsOn Thu, 06 Jun 2019 08:16:29 -0700, jkeenan wrote:
Ok, so at this point it still looks valid ...
.. but by the time we get here it has been corrupted to 0x2. I think it's worth another go at the 'watch', but if that fails we may have to step through with 'next' and 'step' until the displayed value changes. If we set the watchpoint later, it may work better: shell% gdb --args ./perl -we 'my $x = sprintf("%7000000000E", 0)' As before, it should not take more than a few minutes after the 'cont'. Hugo |
From @jkeenanOn Thu, 06 Jun 2019 15:47:02 GMT, hv wrote:
'cont' returned within 1 second. ##### Breakpoint 1, Perl_sv_vcatpvfn_flags (my_perl=<value optimized out>, sv=<value optimized out>, Breakpoint 1, Perl_sv_vcatpvfn_flags (my_perl=<value optimized out>, sv=<value optimized out>, -- |
From @khwilliamsonI’m traveling but cursory examining the patch looks good Sent from my iPhone
|
From @jkeenanOn Mon, 10 Jun 2019 12:24:19 GMT, jkeenan wrote:
Smoke results are looking good. I intend to merge this branch into blead within 24 hours unless we get bad results or someone objects. TonyC, does this look okay to you? Hugo, would you like to suggest a better commit message? Thank you very much. |
From @hvdsOn Tue, 11 Jun 2019 05:59:02 -0700, jkeenan wrote:
I don't think this should be merged at is, it was intended only as a proof of concept. In particular, I strongly dislike the additional 5 lines (in a NOTREACHED area) simply to satisfy the macro's expectations of balance: if we keep the current general structure, the solution here will also need to be wrapped around any other part of the code that can bypass the unlock, and I anticipate there will be quite a few such areas. I've looked some more today, and I think a larger change would be merited, but I'd want some input from DaveM and Karl. I feel the problems here are essentially a clash between the work from bc37e90: "Perl_sv_vcatpvfn_flags: set locale at most once" and from e9bc6d6: "Add thread-safe locale handling". Because of the mutex requirements of the latter, attempting to retain the former will need us to identify every possible route out of sv_vcatpvfn - not only the explicit croaks, but also eg any attempt to read an SV that might be tied or overloaded. I don't think that's a practical thing to do; as such, I'm not convinced there's a practical route to getting correct mutex-protected locale changes on the platforms that need it while retaining the "do this only once" performance benefits. What I'm not sure of is whether _some_ of the "only once" benefits can be retained, eg to discover if switching is necessary - I suspect that subsidiary code (such as tied and overloaded arguments, again) might make that unsafe even in an unthreaded application. I guess another possibility would be to put an unlock request on a save stack, but that feels like it's going even further in the wrong direction - you want to be shortening the time you hold a mutex rather than lengthening it. Hugo |
From @jkeenanOn Thu, 06 Jun 2019 15:54:29 GMT, jkeenan wrote:
We're getting the same test failure on threaded builds on OpenBSD-6.4 and 6.5. On 6.5, this is not showing up in the regular smoke-testing reports, but if you go to the "log" version of Carlos's reports, you can see it. See, e.g., http://perl5.test-smoke.org/logfile/89510, where t/op/sprintf2.t is graded '?????' on threaded builds. I build a threaded perl on blead on an OpenBSD-6.4 VM. Some results for t/op/sprintf2.t and for Hugo's one-liner. ##### $ ./perl -Ilib -V:config_args $ ./perl -Ilib -v | head -2 | tail -1 $ cd t;./perl harness -v op/sprintf2.t;cd - Test Summary Report op/sprintf2.t (Wstat: 138 Tests: 1699 Failed: 0) Note how on this platform an error message is printed: pthread_mutex_destroy on mutex with waiters! ##### $ ./perl -Ilib -v | head -2 | tail -1 $ ./perl -Ilib -V:config_args $ gdb --args ./perl -we 'my $x = sprintf("%7000000000E", 0)' Breakpoint 1, Perl_sv_vcatpvfn_flags (my_perl=Variable "my_perl" is not available. Breakpoint 1, Perl_sv_vcatpvfn_flags (my_perl=Variable "my_perl" is not available. Old value = 0x18a52d7d7160 Thank you very much. -- |
From @iabynOn Tue, Jun 11, 2019 at 06:30:21AM -0700, Hugo van der Sanden via RT wrote:
I have no objection to making it potentially switch locales for each
From my commit message in bc37e90, it appears that checking whether -- |
From @hvdsOn Tue, 11 Jun 2019 06:30:21 -0700, hv wrote:
Attached is an attempt to fix this by defining a new more tightly scoped As Dave mentioned, the expensive part is the hints check of IN_LC(LC_NUMERIC); I'd appreciate if someone could look through for any location I might Hugo |
From @hvds0001-perl-134172-restrict-scope-of-locale-changes-during-.patchFrom 8ced26e934d146385433fe888a9111f611f76d3d Mon Sep 17 00:00:00 2001
From: Hugo van der Sanden <hv@crypt.org>
Date: Mon, 22 Jul 2019 16:29:13 +0100
Subject: [PATCH] [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.
---
perl.h | 32 +++++++++++++++++
sv.c | 111 +++++++++++++++++++++++++++++----------------------------
2 files changed, 88 insertions(+), 55 deletions(-)
diff --git a/perl.h b/perl.h
index 37b2637ca1..3be4a53756 100644
--- a/perl.h
+++ b/perl.h
@@ -6426,6 +6426,29 @@ expression, but with an empty argument list, like this:
...
}
+=for apidoc Amn|void|WITH_LC_NUMERIC_SET_TO_NEEDED
+
+This macro invokes the supplied statement or block within the context
+of a L</STORE_LC_NUMERIC_SET_TO_NEEDED> .. L</RESTORE_LC_NUMERIC> pair
+if required, so eg:
+
+ WITH_LC_NUMERIC_SET_TO_NEEDED(
+ SNPRINTF_G(fv, ebuf, sizeof(ebuf), precis)
+ );
+
+is equivalent to:
+
+ {
+#ifdef USE_LOCALE_NUMERIC
+ DECLARATION_FOR_LC_NUMERIC_MANIPULATION;
+ STORE_LC_NUMERIC_SET_TO_NEEDED();
+#endif
+ SNPRINTF_G(fv, ebuf, sizeof(ebuf), precis);
+#ifdef USE_LOCALE_NUMERIC
+ RESTORE_LC_NUMERIC();
+#endif
+ }
+
=cut
*/
@@ -6548,6 +6571,14 @@ expression, but with an empty argument list, like this:
__FILE__, __LINE__, PL_numeric_standard)); \
} STMT_END
+# define WITH_LC_NUMERIC_SET_TO_NEEDED(block) \
+ STMT_START { \
+ DECLARATION_FOR_LC_NUMERIC_MANIPULATION; \
+ STORE_LC_NUMERIC_SET_TO_NEEDED(); \
+ block; \
+ RESTORE_LC_NUMERIC(); \
+ } STMT_END;
+
#else /* !USE_LOCALE_NUMERIC */
# define SET_NUMERIC_STANDARD()
@@ -6560,6 +6591,7 @@ expression, but with an empty argument list, like this:
# define RESTORE_LC_NUMERIC()
# define LOCK_LC_NUMERIC_STANDARD()
# define UNLOCK_LC_NUMERIC_STANDARD()
+# define WITH_LC_NUMERIC_SET_TO_NEEDED(block) block;
#endif /* !USE_LOCALE_NUMERIC */
diff --git a/sv.c b/sv.c
index 4315fe9b64..ef2c71126c 100644
--- a/sv.c
+++ b/sv.c
@@ -11562,7 +11562,9 @@ S_hextract(pTHX_ const NV nv, int* exponent, bool *subnormal,
* The rest of the args have the same meaning as the local vars of the
* same name within Perl_sv_vcatpvfn_flags().
*
- * It assumes the caller has already done STORE_LC_NUMERIC_SET_TO_NEEDED();
+ * The caller's determination of IN_LC(LC_NUMERIC), passed as in_lc_numeric,
+ * is used to ensure we do the right thing when we need to access the locale's
+ * numeric radix.
*
* It requires the caller to make buf large enough.
*/
@@ -11571,7 +11573,7 @@ static STRLEN
S_format_hexfp(pTHX_ char * const buf, const STRLEN bufsize, const char c,
const NV nv, const vcatpvfn_long_double_t fv,
bool has_precis, STRLEN precis, STRLEN width,
- bool alt, char plus, bool left, bool fill)
+ bool alt, char plus, bool left, bool fill, bool in_lc_numeric)
{
/* Hexadecimal floating point. */
char* p = buf;
@@ -11778,17 +11780,19 @@ S_format_hexfp(pTHX_ char * const buf, const STRLEN bufsize, const char c,
if (hexradix) {
#ifndef USE_LOCALE_NUMERIC
- *p++ = '.';
+ *p++ = '.';
#else
- if (IN_LC(LC_NUMERIC)) {
- STRLEN n;
+ if (in_lc_numeric) {
+ STRLEN n;
+ WITH_LC_NUMERIC_SET_TO_NEEDED({
const char* r = SvPV(PL_numeric_radix_sv, n);
Copy(r, p, n, char);
- p += n;
- }
- else {
- *p++ = '.';
- }
+ });
+ p += n;
+ }
+ else {
+ *p++ = '.';
+ }
#endif
}
@@ -11894,9 +11898,10 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
char ebuf[IV_DIG * 4 + NV_DIG + 32];
bool no_redundant_warning = FALSE; /* did we use any explicit format parameter index? */
#ifdef USE_LOCALE_NUMERIC
- DECLARATION_FOR_LC_NUMERIC_MANIPULATION;
- bool lc_numeric_set = FALSE; /* called STORE_LC_NUMERIC_SET_TO_NEEDED? */
+ bool have_in_lc_numeric = FALSE;
#endif
+ /* we never change this unless USE_LOCALE_NUMERIC */
+ bool in_lc_numeric = FALSE;
PERL_ARGS_ASSERT_SV_VCATPVFN_FLAGS;
PERL_UNUSED_ARG(maybe_tainted);
@@ -12967,33 +12972,31 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
* below, or implicitly, via an snprintf() variant.
* Note also things like ps_AF.utf8 which has
* "\N{ARABIC DECIMAL SEPARATOR} as a radix point */
- if (!lc_numeric_set) {
- /* only set once and reuse in-locale value on subsequent
- * iterations.
- * XXX what happens if we die in an eval?
- */
- STORE_LC_NUMERIC_SET_TO_NEEDED();
- lc_numeric_set = TRUE;
+ if (! have_in_lc_numeric) {
+ in_lc_numeric = IN_LC(LC_NUMERIC);
+ have_in_lc_numeric = TRUE;
}
- if (IN_LC(LC_NUMERIC)) {
- /* this can't wrap unless PL_numeric_radix_sv is a string
- * consuming virtually all the 32-bit or 64-bit address
- * space
- */
- float_need += (SvCUR(PL_numeric_radix_sv) - 1);
-
- /* floating-point formats only get utf8 if the radix point
- * is utf8. All other characters in the string are < 128
- * and so can be safely appended to both a non-utf8 and utf8
- * string as-is.
- * Note that this will convert the output to utf8 even if
- * the radix point didn't get output.
- */
- if (SvUTF8(PL_numeric_radix_sv) && !has_utf8) {
- sv_utf8_upgrade(sv);
- has_utf8 = TRUE;
- }
+ if (in_lc_numeric) {
+ WITH_LC_NUMERIC_SET_TO_NEEDED({
+ /* this can't wrap unless PL_numeric_radix_sv is a string
+ * consuming virtually all the 32-bit or 64-bit address
+ * space
+ */
+ float_need += (SvCUR(PL_numeric_radix_sv) - 1);
+
+ /* floating-point formats only get utf8 if the radix point
+ * is utf8. All other characters in the string are < 128
+ * and so can be safely appended to both a non-utf8 and utf8
+ * string as-is.
+ * Note that this will convert the output to utf8 even if
+ * the radix point didn't get output.
+ */
+ if (SvUTF8(PL_numeric_radix_sv) && !has_utf8) {
+ sv_utf8_upgrade(sv);
+ has_utf8 = TRUE;
+ }
+ });
}
#endif
@@ -13068,7 +13071,9 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
&& !fill
&& intsize != 'q'
) {
- SNPRINTF_G(fv, ebuf, sizeof(ebuf), precis);
+ WITH_LC_NUMERIC_SET_TO_NEEDED(
+ SNPRINTF_G(fv, ebuf, sizeof(ebuf), precis)
+ );
elen = strlen(ebuf);
eptr = ebuf;
goto float_concat;
@@ -13113,7 +13118,7 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
if (UNLIKELY(hexfp)) {
elen = S_format_hexfp(aTHX_ PL_efloatbuf, PL_efloatsize, c,
nv, fv, has_precis, precis, width,
- alt, plus, left, fill);
+ alt, plus, left, fill, in_lc_numeric);
}
else {
char *ptr = ebuf + sizeof ebuf;
@@ -13169,8 +13174,10 @@ 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);
- elen = quadmath_snprintf(PL_efloatbuf, PL_efloatsize,
- qfmt, nv);
+ WITH_LC_NUMERIC_SET_TO_NEEDED(
+ elen = quadmath_snprintf(PL_efloatbuf, PL_efloatsize,
+ qfmt, nv);
+ );
if ((IV)elen == -1) {
if (qfmt != ptr)
SAVEFREEPV(qfmt);
@@ -13180,11 +13187,15 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
Safefree(qfmt);
}
#elif defined(HAS_LONG_DOUBLE)
- elen = ((intsize == 'q')
- ? my_snprintf(PL_efloatbuf, PL_efloatsize, ptr, fv)
- : my_snprintf(PL_efloatbuf, PL_efloatsize, ptr, (double)fv));
+ WITH_LC_NUMERIC_SET_TO_NEEDED(
+ elen = ((intsize == 'q')
+ ? my_snprintf(PL_efloatbuf, PL_efloatsize, ptr, fv)
+ : my_snprintf(PL_efloatbuf, PL_efloatsize, ptr, (double)fv))
+ );
#else
- elen = my_snprintf(PL_efloatbuf, PL_efloatsize, ptr, fv);
+ WITH_LC_NUMERIC_SET_TO_NEEDED(
+ elen = my_snprintf(PL_efloatbuf, PL_efloatsize, ptr, fv)
+ );
#endif
GCC_DIAG_RESTORE_STMT;
}
@@ -13406,16 +13417,6 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
}
SvTAINT(sv);
-
-#ifdef USE_LOCALE_NUMERIC
-
- if (lc_numeric_set) {
- RESTORE_LC_NUMERIC(); /* Done outside loop, so don't have to
- save/restore each iteration. */
- }
-
-#endif
-
}
/* =========================================================================
--
2.17.1
|
From @hvdsOn Mon, 22 Jul 2019 08:47:39 -0700, hv wrote:
Something like the attached (not extensively tested). Hugo |
From @hvds0002-Avoid-multiple-checks-of-IN_LC-LC_NUMERIC.patchFrom 025dca8448365565bb5121614ae17bd7b726642a Mon Sep 17 00:00:00 2001
From: Hugo van der Sanden <hv@crypt.org>
Date: Mon, 22 Jul 2019 17:08:45 +0100
Subject: [PATCH] Avoid multiple checks of IN_LC(LC_NUMERIC)
---
perl.h | 20 ++++++++++++++------
sv.c | 12 ++++++------
2 files changed, 20 insertions(+), 12 deletions(-)
diff --git a/perl.h b/perl.h
index 3be4a53756..c4afb3f2c7 100644
--- a/perl.h
+++ b/perl.h
@@ -6476,12 +6476,12 @@ 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_i(in_lc_numeric) \
STMT_START { \
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 \
@@ -6497,6 +6497,9 @@ is equivalent to:
} \
} STMT_END
+# define STORE_LC_NUMERIC_SET_TO_NEEDED() \
+ STORE_LC_NUMERIC_SET_TO_NEEDED_i(IN_LC(LC_NUMERIC))
+
# define RESTORE_LC_NUMERIC() \
STMT_START { \
if (_restore_LC_NUMERIC_function) { \
@@ -6571,14 +6574,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_i(in_lc_numeric, block) \
STMT_START { \
DECLARATION_FOR_LC_NUMERIC_MANIPULATION; \
- STORE_LC_NUMERIC_SET_TO_NEEDED(); \
+ STORE_LC_NUMERIC_SET_TO_NEEDED_i(in_lc_numeric); \
block; \
RESTORE_LC_NUMERIC(); \
} STMT_END;
+# define WITH_LC_NUMERIC_SET_TO_NEEDED(block) \
+ WITH_LC_NUMERIC_SET_TO_NEEDED_i(IN_LC(LC_NUMERIC), block)
+
#else /* !USE_LOCALE_NUMERIC */
# define SET_NUMERIC_STANDARD()
@@ -6587,10 +6593,12 @@ 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_i()
# 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_i(in_lc_numeric, block) block;
# define WITH_LC_NUMERIC_SET_TO_NEEDED(block) block;
#endif /* !USE_LOCALE_NUMERIC */
diff --git a/sv.c b/sv.c
index ef2c71126c..dfe5f88e52 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_i(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_i(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_i(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_i(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_i(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_i(in_lc_numeric,
elen = my_snprintf(PL_efloatbuf, PL_efloatsize, ptr, fv)
);
#endif
--
2.17.1
|
From @jkeenanOn Mon, 22 Jul 2019 16:11:13 GMT, hv wrote:
Hugo, I created this smoke branch just now after seeing our *first* patch: smoke-me/jkeenan/hv/134172-sprintf Should this second patch be applied to that branch as well? Thank you very much. -- |
From @hvdsOn Mon, 22 Jul 2019 09:15:20 -0700, jkeenan wrote:
Up to you: I'd like a second opinion on it, particularly about the naming of the additional macros, but I think it's reasonably likely to work. (It passed tests here on a build with -DNO_THREAD_SAFE_LOCALE, but I haven't tried any other variations.) Hugo |
From @jkeenanOn Mon, 22 Jul 2019 18:14:11 GMT, hv wrote:
Applying to branch for smoke testing. -- |
From @jkeenanOn Mon, 22 Jul 2019 20:06:30 GMT, jkeenan wrote:
Smoke-test results in the branch appear satisfactory. http://perl.develop-help.com/?b=smoke-me%2Fjkeenan%2Fhv%2F134172-sprintf What else do we have to decide before merging this branch and closing this ticket? Thank you very much. |
From @hvdsOn Wed, 24 Jul 2019 14:18:01 -0700, jkeenan wrote:
I'd like to get some feedback, particularly from Karl and Dave; Karl has already indicated he'll try to take a look this weekend. It also looks like Tony has been looking into the same issue, I just noticed he has created a branch tonyc/134172-in-lc which may have duplicated some of the work. Given clean smokes, I'm already pretty comfortable with the first patch; the second patch ("Avoid multiple checks of IN_LC(LC_NUMERIC)") probably needs better documentation, possibly better naming, and due consideration whether to expose the new macros as part of the API. Hugo |
From @tonycozOn Wed, Jul 24, 2019 at 03:07:48PM -0700, Hugo van der Sanden via RT wrote:
It looks reasonable to me. One thing I noticed in the original code was that + ( ( in_lc_numeric && _NOT_IN_NUMERIC_UNDERLYING) \ (for a bare STORE_LC_NUMERIC_SET_TO_NEEDED() in_lc_numeric is Tony |
From @iabynOn Wed, Jul 24, 2019 at 03:07:48PM -0700, Hugo van der Sanden via RT wrote:
I've been dead to the world with flu for the last 8 days, so you probably -- |
From @hvdsOn Wed, 24 Jul 2019 17:38:13 -0700, tonyc wrote:
Thanks.
Yes, I addressed the same in my second patch, in a slightly different manner. Hugo |
From @khwilliamsonOn 7/25/19 8:17 AM, Hugo van der Sanden via RT wrote:
The patches both look good to me. I have two very minor concerns. Is saying foo({...}) portable? And on platforms that don't have locales enabled, is it ok to just say As far as the names, I don't know. It's not clear to me what the _i |
From @hvdsOn Mon, 29 Jul 2019 21:13:20 -0700, public@khwilliamson.com wrote:
Thanks.
We do this in many places with DEBUG_foo() type macros.
By analogy with DEBUG_foo, I thought I'd found evidence it was; but I don't see that now, and DEBUG_r (for example) does wrap them, I'll modify this.
I agree, but I didn't have a better name. I see Tony used ..._IN(in) in his closely equivalent version, so I'll go with that. I plan to commit both patches with those changes, along with some docs for the _IN variants, later today. Hugo |
From @hvdsNow pushed: commit a06a4d4 commit 39b0ad1 commit 061637c |
|
@hvds - Status changed from 'open' to 'pending release' |
Migrated from rt.perl.org#134172 (status was 'pending release')
Searchable as RT134172$
The text was updated successfully, but these errors were encountered: