In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/2d8d9d71ead3add211debdd99298f23011146431?hp=23de7b6916352e57ff2a82e1327840e4fe9304a6>
- Log ----------------------------------------------------------------- commit 2d8d9d71ead3add211debdd99298f23011146431 Author: Karl Williamson <[email protected]> Date: Mon Aug 8 17:28:30 2016 -0600 Add Sergey Aleynikov to AUTHORS M AUTHORS commit 706055ce526ecd141030ea93bddf940bb955ae72 Author: Karl Williamson <[email protected]> Date: Mon Aug 8 17:22:54 2016 -0600 lib/locale_threads.t: Add new test file This file tests locale and thread interactions. At the moment, it has just one test, adapted from [perl #127708]. The adaptations include placing it under t/test.pl, and using my knowledge of the underlying bug cause to stress it more than the original by Sergey Aleynikov. He says it fails nearly 50% of the time on an unpatched perl. M MANIFEST M Porting/Maintainers.pl A lib/locale_threads.t commit ffdde3068076349ae00c2cd96695f84a7ace347d Author: Karl Williamson <[email protected]> Date: Wed Aug 10 12:02:38 2016 -0600 Move some global destruction to where it belongs Out of ignorance, I put this locale global destruction in the per-thread destruction code, leading to segfaults on at least Darwin. M perl.c M perl.h commit c9dda6da16cae65cd25b1efee98854803bda6063 Author: Karl Williamson <[email protected]> Date: Wed Aug 10 12:08:51 2016 -0600 Add some error checking/debugging for locale We are starting to use libc functions for locale that have never been used before. I previously hadn't bothered to check error returns on things that "shouldn't" fail. But given that there may be bugs in various vendors' implementations or documentation of these, and/or my misreading of how to use them, it is warranted to actually do the checking. This also adds a couple of debug statements to lib/locale.t that I wished were already there. M lib/locale.t M locale.c ----------------------------------------------------------------------- Summary of changes: AUTHORS | 1 + MANIFEST | 1 + Porting/Maintainers.pl | 1 + lib/locale.t | 4 +++- lib/locale_threads.t | 53 ++++++++++++++++++++++++++++++++++++++++++++++++++ locale.c | 40 ++++++++++++++++++++++++++----------- perl.c | 10 ---------- perl.h | 18 ++++++++++++++++- 8 files changed, 105 insertions(+), 23 deletions(-) create mode 100644 lib/locale_threads.t diff --git a/AUTHORS b/AUTHORS index 595f3f3..7fed86b 100644 --- a/AUTHORS +++ b/AUTHORS @@ -1102,6 +1102,7 @@ Sebastian Steinlechner <[email protected]> Sébastien Aperghis-Tramoni <[email protected]> Sebastien Barre <[email protected]> Sergey Alekseev <[email protected]> +Sergey Aleynikov <[email protected]> Sérgio Durigan Júnior <[email protected]> Shawn <[email protected]> Shawn M Moore <[email protected]> diff --git a/MANIFEST b/MANIFEST index f170c93..606b654 100644 --- a/MANIFEST +++ b/MANIFEST @@ -4423,6 +4423,7 @@ lib/less.pm For "use less" lib/less.t See if less support works lib/locale.pm For "use locale" lib/locale.t See if locale support works +lib/locale_threads.t Tes locale and threads interactions lib/meta_notation.pm Helper for certain /lib .pm's lib/meta_notation.t See if meta_notation.t works lib/Net/hostent.pm By-name interface to Perl's builtin gethost* diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 50e25a8..0bf2b63 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -1528,6 +1528,7 @@ use File::Glob qw(:case); lib/integer.{pm,t} lib/less.{pm,t} lib/locale.{pm,t} + lib/locale_threads.t lib/open.{pm,t} lib/overload/numbers.pm lib/overloading.{pm,t} diff --git a/lib/locale.t b/lib/locale.t index 85fb157..0b7f415 100644 --- a/lib/locale.t +++ b/lib/locale.t @@ -1993,6 +1993,7 @@ foreach my $Locale (@Locale) { $ok14 = utf8::is_utf8($strerror); no locale; $ok14_5 = "$!" !~ /\P{ASCII}/; + debug(disp_str("non-ASCII \$!=$!")) if ! $ok14_5; last; } } @@ -2038,8 +2039,9 @@ foreach my $Locale (@Locale) { use Errno; $! = eval "&Errno::$err"; # Convert to strerror() output my $strerror = "$!"; - if ("$strerror" =~ /\P{ASCII}/) { + if ($strerror =~ /\P{ASCII}/) { $ok21 = 0; + debug(disp_str("non-ASCII strerror=$strerror")); last; } } diff --git a/lib/locale_threads.t b/lib/locale_threads.t new file mode 100644 index 0000000..5559f91 --- /dev/null +++ b/lib/locale_threads.t @@ -0,0 +1,53 @@ +use strict; +use warnings; + +# This file tests interactions with locale and threads + +BEGIN { + chdir 't' if -d 't'; + require './test.pl'; + set_up_inc('../lib'); + require './loc_tools.pl'; + skip_all("No locales") unless locales_enabled(); + skip_all_without_config('useithreads'); + $| = 1; +} + +SKIP: { # perl #127708 + my @locales = grep { $_ !~ / ^ C \b | POSIX /x } find_locales('LC_MESSAGES', + 'non-problematic-only'); + skip("No valid locale to test with", 1) unless @locales; + + # reset the locale environment + local @ENV{'LANG', (grep /^LC_/, keys %ENV)}; + local $ENV{LC_MESSAGES} = $locales[0]; + + # We're going to try with all possible error numbers on this platform + my $error_count = keys(%!) + 1; + + print fresh_perl(" + use threads; + use strict; + use warnings; + + my \$errnum = 1; + + my \@threads = map +threads->create(sub { + sleep 0.1; + + for (1..5_000) { + \$errnum = (\$errnum + 1) % $error_count; + \$! = \$errnum; + + # no-op to trigger stringification + next if \"\$!\" eq \"\"; + } + }), (0..1); + \$_->join for splice \@threads;", + {} + ); + + pass("Didn't segfault"); +} + +done_testing; diff --git a/locale.c b/locale.c index f698377..5b76fd6 100644 --- a/locale.c +++ b/locale.c @@ -2529,7 +2529,7 @@ Perl_my_strerror(pTHX_ const int errnum) locale_t save_locale; # else char * save_locale; - bool locale_is_C; + bool locale_is_C = FALSE; /* We have a critical section to prevent another thread from changing the * locale out from under us (or zapping the buffer returned from @@ -2539,23 +2539,34 @@ Perl_my_strerror(pTHX_ const int errnum) # endif if (! within_locale_scope) { + errno = 0; # ifdef USE_THREAD_SAFE_LOCALE /* Use the thread-safe locale functions */ save_locale = uselocale(PL_C_locale_obj); + if (! save_locale) { + DEBUG_L(PerlIO_printf(Perl_debug_log, + "uselocale failed, errno=%d\n", errno)); + } # else /* Not thread-safe build */ save_locale = setlocale(LC_MESSAGES, NULL); - locale_is_C = isNAME_C_OR_POSIX(save_locale); + if (! save_locale) { + DEBUG_L(PerlIO_printf(Perl_debug_log, + "setlocale failed, errno=%d\n", errno)); + } + else { + locale_is_C = isNAME_C_OR_POSIX(save_locale); - /* Switch to the C locale if not already in it */ - if (! locale_is_C) { + /* Switch to the C locale if not already in it */ + if (! locale_is_C) { - /* The setlocale() just below likely will zap 'save_locale', so - * create a copy. */ - save_locale = savepv(save_locale); - setlocale(LC_MESSAGES, "C"); + /* The setlocale() just below likely will zap 'save_locale', so + * create a copy. */ + save_locale = savepv(save_locale); + setlocale(LC_MESSAGES, "C"); + } } # endif @@ -2573,16 +2584,23 @@ Perl_my_strerror(pTHX_ const int errnum) #ifdef USE_LOCALE_MESSAGES if (! within_locale_scope) { + errno = 0; # ifdef USE_THREAD_SAFE_LOCALE - uselocale(save_locale); + if (save_locale && ! uselocale(save_locale)) { + DEBUG_L(PerlIO_printf(Perl_debug_log, + "uselocale restore failed, errno=%d\n", errno)); + } } # else - if (! locale_is_C) { - setlocale(LC_MESSAGES, save_locale); + if (save_locale && ! locale_is_C) { + if (! setlocale(LC_MESSAGES, save_locale)) { + DEBUG_L(PerlIO_printf(Perl_debug_log, + "setlocale restore failed, errno=%d\n", errno)); + } Safefree(save_locale); } } diff --git a/perl.c b/perl.c index 44f8642..21a8b30 100644 --- a/perl.c +++ b/perl.c @@ -1127,16 +1127,6 @@ perl_destruct(pTHXx) PL_SB_invlist = NULL; PL_WB_invlist = NULL; -#ifdef USE_THREAD_SAFE_LOCALE - if (PL_C_locale_obj) { - /* Make sure we aren't using the locale space we are about to free */ - uselocale(LC_GLOBAL_LOCALE); - - freelocale(PL_C_locale_obj); - PL_C_locale_obj = (locale_t) NULL; - } -#endif - if (!specialWARN(PL_compiling.cop_warnings)) PerlMemShared_free(PL_compiling.cop_warnings); PL_compiling.cop_warnings = NULL; diff --git a/perl.h b/perl.h index c0f487d..ac302bd 100644 --- a/perl.h +++ b/perl.h @@ -5963,7 +5963,23 @@ typedef struct am_table_short AMTS; /* These locale things are all subject to change */ # define LOCALE_INIT MUTEX_INIT(&PL_locale_mutex) -# define LOCALE_TERM MUTEX_DESTROY(&PL_locale_mutex) + +# ifdef USE_THREAD_SAFE_LOCALE +# define LOCALE_TERM \ + STMT_START { \ + MUTEX_DESTROY(&PL_locale_mutex); \ + if (PL_C_locale_obj) { \ + /* Make sure we aren't using the locale \ + * space we are about to free */ \ + uselocale(LC_GLOBAL_LOCALE); \ + freelocale(PL_C_locale_obj); \ + PL_C_locale_obj = (locale_t) NULL; \ + } \ + } STMT_END + } +# else +# define LOCALE_TERM MUTEX_DESTROY(&PL_locale_mutex) +# endif # define LOCALE_LOCK MUTEX_LOCK(&PL_locale_mutex) # define LOCALE_UNLOCK MUTEX_UNLOCK(&PL_locale_mutex) -- Perl5 Master Repository
