In perl.git, the branch blead has been updated
<https://perl5.git.perl.org/perl.git/commitdiff/c6fbd3534700ea217d0e7553adb13aaaf116c6a6?hp=63e5b0d74e16f32c89cdb039e79f0fdb47d1b819>
- Log -----------------------------------------------------------------
commit c6fbd3534700ea217d0e7553adb13aaaf116c6a6
Author: Karl Williamson <k...@cpan.org>
Date: Thu Nov 9 18:46:17 2017 -0700
sv.c: Fix typo in comment
commit c656fadc5045091645f773ff71cfe0039be5ddaf
Author: Karl Williamson <k...@cpan.org>
Date: Thu Nov 9 18:38:02 2017 -0700
malloc.c: Fix typo in comment
commit 149651df9be1c2d09b767da7cad61d661cd5222b
Author: Karl Williamson <k...@cpan.org>
Date: Thu Nov 9 18:37:30 2017 -0700
lib/locale.t: Clarify test name
commit 464decb62c023e46cc194963698a26d39b491f4d
Author: Karl Williamson <k...@cpan.org>
Date: Thu Nov 9 18:26:43 2017 -0700
handy.h: Clarify comment
commit 43cb665150ddf892c277cba7edc80937fa053fb1
Author: Karl Williamson <k...@cpan.org>
Date: Mon Sep 11 18:57:54 2017 -0600
locale.c: strerror_l() not fool proof
Commit 7aaa36b196e5a478a3d1bd32506797db7cebf0b2 changed to use
strerror_l() if available on the platform. But there is a potential bug
with this on threaded perls. The code uses strerror_l() when it needs
the answer on a locale that isn't necessarily the current one. But it
uses plain strerror() when the locale is known to be the current one.
Plain strerror() isn't necessarily thread-safe. However, on systems
that have strerror_r(), reentr.h has caused our apparent call to plain
strerror() to instead call the thread-safe strerror_r() under the hood.
So there is no bug on unthreaded perls nor on ones that have
strerror_r().
This commit fixes the bug on threaded builds which have strerror_l() but
not strerror_r(). It does this by using strerror_l() for everything,
and constructing a locale object that is the current locale to use when
the locale doesn't need to be changed. This is somewhat more work than
the alternative above does, so that one is used if available.
No changes are made to how it works on systems that don't have
strerror_l().
Some systems have deprecated strerror_r(). reentr.h does not use it on
such systems. The reason for the deprecation, we would hope, may be
that the plain strerror() is implemented thread-safely. We don't know
that, so we just assume that the plain version is thread-unsafe.
We do have tests that try to find races here, but they haven't shown
any. It could be that systems that are advanced enough to have
strerror_l() also have strerror_r().
-----------------------------------------------------------------------
Summary of changes:
handy.h | 5 +++--
lib/locale.t | 2 +-
locale.c | 41 +++++++++++++++++++++++++++++++++++++++--
malloc.c | 2 +-
sv.c | 2 +-
5 files changed, 45 insertions(+), 7 deletions(-)
diff --git a/handy.h b/handy.h
index 53477994a3..f75c900656 100644
--- a/handy.h
+++ b/handy.h
@@ -260,8 +260,9 @@ typedef U64TYPE U64;
#endif
-/* log(2) is pretty close to 0.30103, just in case anyone is grepping for it
*/
-#define BIT_DIGITS(N) (((N)*146)/485 + 1) /* log2(10) =~ 146/485 */
+/* log(2) (i.e., log base 10 of 2) is pretty close to 0.30103, just in case
+ * anyone is grepping for it */
+#define BIT_DIGITS(N) (((N)*146)/485 + 1) /* log10(2) =~ 146/485 */
#define TYPE_DIGITS(T) BIT_DIGITS(sizeof(T) * 8)
#define TYPE_CHARS(T) (TYPE_DIGITS(T) + 2) /* sign, NUL */
diff --git a/lib/locale.t b/lib/locale.t
index cb39d06208..85843acae7 100644
--- a/lib/locale.t
+++ b/lib/locale.t
@@ -2258,7 +2258,7 @@ foreach my $Locale (@Locale) {
# OS X 10.9.3
report_result($Locale, ++$locales_test_number, $ok21);
- $test_names{$locales_test_number} = '"$!" is ASCII only outside of locale
scope';
+ $test_names{$locales_test_number} = '"$!" is ASCII-only outside of locale
scope';
debug "$first_f_test..$locales_test_number: \$f = $f, \$g = $g, back to
locale = $Locale\n";
diff --git a/locale.c b/locale.c
index d56fd40016..436456a8c2 100644
--- a/locale.c
+++ b/locale.c
@@ -3403,7 +3403,17 @@ Perl_my_strerror(pTHX_ const int errnum)
# if defined(HAS_POSIX_2008_LOCALE) && defined(HAS_STRERROR_L)
- /* This function is trivial if we have strerror_l() */
+ /* This function is trivial if we don't have to worry about thread safety
+ * and have strerror_l(), as it handles the switch of locales so we don't
+ * have to deal with that. We don't have to worry about thread safety if
+ * this is an unthreaded build, or if strerror_r() is also available. Both
+ * it and strerror_l() are thread-safe. Plain strerror() isn't thread
+ * safe. But on threaded builds when strerror_r() is available, the
+ * apparent call to strerror() below is actually a macro that
+ * behind-the-scenes calls strerror_r().
+ */
+
+# if ! defined(USE_ITHREADS) || defined(HAS_STRERROR_R)
if (within_locale_scope) {
errstr = savepv(strerror(errnum));
@@ -3412,7 +3422,34 @@ Perl_my_strerror(pTHX_ const int errnum)
errstr = savepv(strerror_l(errnum, PL_C_locale_obj));
}
-# else /* Doesn't have strerror_l(). */
+# else
+
+ /* Here we have strerror_l(), but not strerror_r() and we are on a
+ * threaded-build. We use strerror_l() for everything, constructing a
+ * locale to pass to it if necessary */
+
+ bool do_free = FALSE;
+ locale_t locale_to_use;
+
+ if (within_locale_scope) {
+ locale_to_use = uselocale((locale_t) 0);
+ if (locale_to_use == LC_GLOBAL_LOCALE) {
+ locale_to_use = duplocale(LC_GLOBAL_LOCALE);
+ do_free = TRUE;
+ }
+ }
+ else { /* Use C locale if not within 'use locale' scope */
+ locale_to_use = PL_C_locale_obj;
+ }
+
+ errstr = savepv(strerror_l(errnum, locale_to_use));
+
+ if (do_free) {
+ freelocale(locale_to_use);
+ }
+
+# endif
+# else /* Doesn't have strerror_l() */
# ifdef USE_POSIX_2008_LOCALE
diff --git a/malloc.c b/malloc.c
index 1809ab3b8d..bb72cddef1 100644
--- a/malloc.c
+++ b/malloc.c
@@ -1655,7 +1655,7 @@ morecore(int bucket)
return;
#ifndef NO_PERL_MALLOC_ENV
if (!were_called) {
- /* It's the our first time. Initialize ourselves */
+ /* It's our first time. Initialize ourselves */
were_called = 1; /* Avoid a loop */
if (!MallocCfg[MallocCfg_skip_cfg_env]) {
char *s = getenv("PERL_MALLOC_OPT"), *t = s, *off;
diff --git a/sv.c b/sv.c
index 225e5c855a..c1a33fb0a0 100644
--- a/sv.c
+++ b/sv.c
@@ -11921,7 +11921,7 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char
*const pat, const STRLEN p
bool has_utf8 = DO_UTF8(sv); /* has the result utf8? */
const bool pat_utf8 = has_utf8; /* the pattern is in utf8? */
/* Times 4: a decimal digit takes more than 3 binary digits.
- * NV_DIG: mantissa takes than many decimal digits.
+ * NV_DIG: mantissa takes that many decimal digits.
* Plus 32: Playing safe. */
char ebuf[IV_DIG * 4 + NV_DIG + 32];
bool no_redundant_warning = FALSE; /* did we use any explicit format
parameter index? */
--
Perl5 Master Repository
