threads-2.22_01

Fix Clang macro backward compatibility per patch by Andy Grundman.
Keep the old better doc.
Keep our modglobal fix in global destruction from 2.12_01.

Support PL_sv_zero.
Don't Copy() null pointer

The documentation now better describes the problems that arise when
returning values from threads, and no longer warns about creating threads
in BEGIN blocks. [perl #96538]

Author: rurban

Porting/Maintainers.pl

@@ -1464,7 +1464,8 @@ package Maintainers;
     },
 
     'threads' => {
-        'DISTRIBUTION' => 'JDHEDDEN/threads-2.16.tar.gz',
+        # https://github.com/rurban/threads/commits/cperl really
+        'DISTRIBUTION' => 'RURBAN/threads-2.22_01.tar.gz',
         'FILES'        => q[dist/threads],
         'EXCLUDED'     => [
             qr{^examples/},

dist/Module-CoreList/lib/Module/CoreList.pm

@@ -17833,6 +17833,7 @@ our %delta :const = (
             'TAP::Parser::YAMLish::Writer'=> '3.42_01',
             'Test::Harness'         => '3.42_01',
             'Thread::Queue'         => '3.13',
+            'threads'               => '2.22_01',
             'Time::HiRes'           => '1.9758_01',
             'Time::Local'           => '1.28',
             'Time::Piece'           => '1.33',

dist/threads/Changes

@@ -1,5 +1,16 @@
 Revision history for Perl extension threads.
 
+2.22_01 Fri Sep 7 13:00:29 2018 +0200 rurban
+        - locale safety backport
+
+2.22 Tue Jan 23 01:14:04 2018 +0100
+        - more locale safety from perl5
+
+2.21 Mon Jan 22 20:09:07 EST 2018
+	- Fix to CLANG macros
+	- Can return subs from threads.  See docs.
+	- Sync from blead
+
 2.16 Sun May  7 22:32:59 2017
 	- Fix Clang macro backward compatibility per patch by Andy Grundman
 	- Sync from blead
@@ -10,6 +21,9 @@ Revision history for Perl extension threads.
 2.14 Sun Feb 26 21:14:26 2017
 	- Sync from blead
 
+2.13_01 Sun Mar 5 19:27:49 2017 +0100
+        - locale safety from cperl
+
 2.13 Sun Feb 26 17:59:01 2017
 	- Added t/kill3.t to test that dir handles are thread-safe
 

dist/threads/lib/threads.pm

@@ -5,7 +5,7 @@ use 5.008;
 use strict;
 use warnings;
 
-our $VERSION = '2.16_01';
+our $VERSION = '2.22_01';      # remember to update version in POD!
 my $XS_VERSION = $VERSION;
 $VERSION = eval $VERSION;
 
@@ -29,8 +29,7 @@ $threads::threads = 1;
 
 # Load the XS code
 require XSLoader;
-XSLoader::load('threads', $XS_VERSION);
-
+XSLoader::load("threads", $XS_VERSION);
 
 ### Export ###
 
@@ -134,7 +133,7 @@ threads - Perl interpreter-based threads
 
 =head1 VERSION
 
-This document describes threads version 2.16
+This document describes threads version 2.22_01 (with fixes from cperl)
 
 =head1 WARNING
 
@@ -951,6 +950,36 @@ C<chdir()>) will affect all the threads in the application.
 On MSWin32, each thread maintains its own the current working directory
 setting.
 
+=item Locales
+
+Prior to Perl 5.28 or cperl 5.24 locales could not be used with
+threads, due to various race conditions.  Starting with Perl 5.28 on
+systems that implement thread-safe locale functions, threads can be
+used even on perl5 with some caveats. Previously only with cperl,
+but perl5 still has many unsolved issues.
+This includes Windows starting with Visual Studio 2005, and systems
+compatible with POSIX 2008.  See L<perllocale/Multi-threaded
+operation>.
+
+Each thread (except the main thread) is started using the C locale.  The main
+thread is started like all other Perl programs; see L<perllocale/ENVIRONMENT>.
+You can switch locales in any thread as often as you like.
+
+If you want to inherit the parent thread's locale, you can, in the parent, set
+a variable like so:
+
+    $foo = POSIX::setlocale(LC_ALL, NULL);
+
+and then pass to threads->create() a sub that closes over C<$foo>.  Then, in
+the child, you say
+
+    POSIX::setlocale(LC_ALL, $foo);
+
+Or you can use the facilities in L<threads::shared> to pass C<$foo>;
+or if the environment hasn't changed, in the child, do
+
+    POSIX::setlocale(LC_ALL, "");
+
 =item Environment variables
 
 Currently, on all platforms except MSWin32, all I<system> calls (e.g., using
@@ -1001,13 +1030,6 @@ L</"THREAD SIGNALLING"> to relay the signal to the thread:
 On some platforms, it might not be possible to destroy I<parent> threads while
 there are still existing I<child> threads.
 
-=item Creating threads inside special blocks
-
-Creating threads inside C<BEGIN>, C<CHECK> or C<INIT> blocks should not be
-relied upon.  Depending on the Perl version and the application code, results
-may range from success, to (apparently harmless) warnings of leaked scalar, or
-all the way up to crashing of the Perl interpreter.
-
 =item Unsafe signals
 
 Since Perl 5.8.0, signals have been made safer in Perl by postponing their
@@ -1032,16 +1054,27 @@ signalling behavior is only in effect in the following situations:
 If unsafe signals is in effect, then signal handling is not thread-safe, and
 the C<-E<gt>kill()> signalling method cannot be used.
 
-=item Returning closures from threads
+=item Identity of objects returned from threads
+
+When a value is returned from a thread through a C<join> operation,
+the value and everything that it references is copied across to the
+joining thread, in much the same way that values are copied upon thread
+creation.  This works fine for most kinds of value, including arrays,
+hashes, and subroutines.  The copying recurses through array elements,
+reference scalars, variables closed over by subroutines, and other kinds
+of reference.
 
-Returning closures from threads should not be relied upon.  Depending on the
-Perl version and the application code, results may range from success, to
-(apparently harmless) warnings of leaked scalar, or all the way up to crashing
-of the Perl interpreter.
+However, everything referenced by the returned value is a fresh copy in
+the joining thread, even if a returned object had in the child thread
+been a copy of something that previously existed in the parent thread.
+After joining, the parent will therefore have a duplicate of each such
+object.  This sometimes matters, especially if the object gets mutated;
+this can especially matter for private data to which a returned subroutine
+provides access.
 
-=item Returning objects from threads
+=item Returning blessed objects from threads
 
-Returning objects from threads does not work.  Depending on the classes
+Returning blessed objects from threads does not work.  Depending on the classes
 involved, you may be able to work around this by returning a serialized
 version of the object (e.g., using L<Data::Dumper> or L<Storable>), and then
 reconstituting it in the joining thread.  If you're using Perl 5.10.0 or

dist/threads/t/exit.t

@@ -48,7 +48,7 @@ my $rc = $thr->join();
 ok(! defined($rc), 'Exited: threads->exit()');
 
 
-run_perl(prog => 'use threads 2.16;' .
+run_perl(prog => 'use threads 2.21;' .
                  'threads->exit(86);' .
                  'exit(99);',
          nolib => ($ENV{PERL_CORE}) ? 0 : 1,
@@ -98,7 +98,7 @@ $rc = $thr->join();
 ok(! defined($rc), 'Exited: $thr->set_thread_exit_only');
 
 
-run_perl(prog => 'use threads 2.16 qw(exit thread_only);' .
+run_perl(prog => 'use threads 2.21 qw(exit thread_only);' .
                  'threads->create(sub { exit(99); })->join();' .
                  'exit(86);',
          nolib => ($ENV{PERL_CORE}) ? 0 : 1,
@@ -108,7 +108,7 @@ run_perl(prog => 'use threads 2.16 qw(exit thread_only);' .
     is($?>>8, 86, "'use threads 'exit' => 'thread_only'");
 }
 
-my $out = run_perl(prog => 'use threads 2.16;' .
+my $out = run_perl(prog => 'use threads 2.21;' .
                            'threads->create(sub {' .
                            '    exit(99);' .
                            '});' .
@@ -124,7 +124,7 @@ my $out = run_perl(prog => 'use threads 2.16;' .
 like($out, qr/1 finished and unjoined/, "exit(status) in thread");
 
 
-$out = run_perl(prog => 'use threads 2.16 qw(exit thread_only);' .
+$out = run_perl(prog => 'use threads 2.21 qw(exit thread_only);' .
                         'threads->create(sub {' .
                         '   threads->set_thread_exit_only(0);' .
                         '   exit(99);' .
@@ -141,7 +141,7 @@ $out = run_perl(prog => 'use threads 2.16 qw(exit thread_only);' .
 like($out, qr/1 finished and unjoined/, "set_thread_exit_only(0)");
 
 
-run_perl(prog => 'use threads 2.16;' .
+run_perl(prog => 'use threads 2.21;' .
                  'threads->create(sub {' .
                  '   $SIG{__WARN__} = sub { exit(99); };' .
                  '   die();' .

dist/threads/t/kill3.t

@@ -36,8 +36,9 @@ BEGIN {
 
 {
     $SIG{'KILL'} = undef;
-    chdir '/tmp';
-    my $dir = File::Spec->catdir( '/tmp', "toberead$$" );
+    my $tmp = File::Spec->tmpdir();
+    chdir $tmp;
+    my $dir = File::Spec->catdir( $tmp, "toberead$$" );
     mkdir $dir;
     chdir $dir;
     for ('a'..'e') {
@@ -77,8 +78,9 @@ EOI
 
 {
     $SIG{'KILL'} = undef;
-    chdir '/tmp';
-    my $dir = File::Spec->catdir( '/tmp', "shouldberead$$" );
+    my $tmp = File::Spec->tmpdir();
+    chdir $tmp;
+    my $dir = File::Spec->catdir( $tmp, "shouldberead$$" );
     mkdir $dir;
     chdir $dir;
     for ('a'..'e') {

dist/threads/t/thread.t

@@ -161,7 +161,7 @@ package main;
 
 # bugid #24165
 
-run_perl(prog => 'use threads 2.16;' .
+run_perl(prog => 'use threads 2.21;' .
                  'sub a{threads->create(shift)} $t = a sub{};' .
                  '$t->tid; $t->join; $t->tid',
          nolib => ($ENV{PERL_CORE}) ? 0 : 1,

dist/threads/threads.xs

@@ -20,6 +20,7 @@
 #endif
 #ifdef HAS_PPPORT_H
 #  define NEED_PL_signals
+#  define NEED_newRV_noinc
 #  define NEED_sv_2pv_flags
 #  include "ppport.h"
 #  include "threads.h"
@@ -35,6 +36,22 @@
 #  endif
 #endif
 
+#if PERL_VERSION < 28
+#define thread_locale_init()
+#define thread_locale_term()
+#endif
+
+#ifndef CLANG_DIAG_IGNORE
+# define CLANG_DIAG_IGNORE(x)
+# define CLANG_DIAG_RESTORE
+#endif
+#ifndef CLANG_DIAG_IGNORE_STMT
+# define CLANG_DIAG_IGNORE_STMT(x) CLANG_DIAG_IGNORE(x) NOOP
+# define CLANG_DIAG_RESTORE_STMT CLANG_DIAG_RESTORE NOOP
+# define CLANG_DIAG_IGNORE_DECL(x) CLANG_DIAG_IGNORE(x) dNOOP
+# define CLANG_DIAG_RESTORE_DECL CLANG_DIAG_RESTORE dNOOP
+#endif
+
 #ifdef USE_ITHREADS
 
 #ifdef __amigaos4__
@@ -132,9 +149,9 @@ typedef struct {
     IV page_size;
 } my_pool_t;
 
-#define dMY_POOL \
-    SV *my_pool_sv = *hv_fetch(PL_modglobal, MY_POOL_KEY,               \
-                               sizeof(MY_POOL_KEY)-1, TRUE);            \
+#define dMY_POOL                                                    \
+    SV *my_pool_sv = *hv_fetch(PL_modglobal, MY_POOL_KEY,           \
+                               sizeof(MY_POOL_KEY)-1, TRUE);        \
     my_pool_t *my_poolp = INT2PTR(my_pool_t*, SvUV(my_pool_sv))
 
 #define MY_POOL_set                                                 \
@@ -219,7 +236,7 @@ S_ithread_clear(pTHX_ ithread *thread)
 {
     PerlInterpreter *interp;
 #ifndef WIN32
-    sigset_t origmask;
+    static sigset_t origmask;
 #endif
 
     assert(((thread->state & PERL_ITHR_FINISHED) &&
@@ -583,6 +600,8 @@ S_ithread_run(void * arg)
     S_set_sigmask(&thread->initial_sigmask);
 #endif
 
+    thread_locale_init();
+
     PL_perl_destruct_level = 2;
 
     {
@@ -668,6 +687,8 @@ S_ithread_run(void * arg)
     MUTEX_UNLOCK(&thread->mutex);
     MUTEX_UNLOCK(&MY_POOL.create_destruct_mutex);
 
+    thread_locale_term();
+
     /* Exit application if required */
     if (exit_app) {
         (void)S_jmpenv_run(aTHX_ 2, thread, NULL, &exit_app, &exit_code);
@@ -884,15 +905,18 @@ S_ithread_create(
            reallocated (and hence move) as a side effect of calls to
            perl_clone() and sv_dup_inc(). Hence copy the parameters
            somewhere under our control first, before duplicating.  */
+        if (num_params) {
 #if (PERL_VERSION > 8)
-        Copy(parent_perl->Istack_base + params_start, array, num_params, SV *);
+            Copy(parent_perl->Istack_base + params_start, array, num_params, SV *);
 #else
-        Copy(parent_perl->Tstack_base + params_start, array, num_params, SV *);
+            Copy(parent_perl->Tstack_base + params_start, array, num_params, SV *);
 #endif
-        while (num_params--) {
-            *array = sv_dup_inc(*array, clone_param);
-            ++array;
+            while (num_params--) {
+                *array = sv_dup_inc(*array, clone_param);
+                ++array;
+            }
         }
+
 #if (PERL_VERSION > 13) || (PERL_VERSION == 13 && PERL_SUBVERSION > 1)
         Perl_clone_params_del(clone_param);
 #endif
@@ -1030,15 +1054,10 @@ S_ithread_create(
     MUTEX_UNLOCK(&my_pool->create_destruct_mutex);
     return (thread);
 
-#if defined(CLANG_DIAG_IGNORE)
-    CLANG_DIAG_IGNORE(-Wthread-safety);
+    CLANG_DIAG_IGNORE_STMT(-Wthread-safety);
     /* warning: mutex 'thread->mutex' is not held on every path through here [-Wthread-safety-analysis] */
-#endif
 }
-/* perl.h defines CLANG_DIAG_* but only in 5.24+ */
-#if defined(CLANG_DIAG_RESTORE)
-CLANG_DIAG_RESTORE
-#endif
+CLANG_DIAG_RESTORE_DECL;
 
 #endif /* USE_ITHREADS */
 
@@ -1161,6 +1180,7 @@ ithread_create(...)
         }
 
         /* Create thread */
+        /* Unlocked inside S_ithread_create */
         MUTEX_LOCK(&MY_POOL.create_destruct_mutex);
         thread = S_ithread_create(aTHX_ &MY_POOL,
                                         function_to_call,
@@ -1176,10 +1196,10 @@ ithread_create(...)
 
         /* Let thread run. */
         /* See S_ithread_run() for more detail. */
-        CLANG_DIAG_IGNORE(-Wthread-safety);
+        CLANG_DIAG_IGNORE_STMT(-Wthread-safety);
         /* warning: releasing mutex 'thread->mutex' that was not held [-Wthread-safety-analysis] */
         MUTEX_UNLOCK(&thread->mutex);
-        CLANG_DIAG_RESTORE;
+        CLANG_DIAG_RESTORE_STMT;
 
         /* XSRETURN(1); - implied */
 
@@ -1374,6 +1394,9 @@ ithread_join(...)
             ptr_table_store(PL_ptr_table, &other_perl->Isv_undef, &PL_sv_undef);
             ptr_table_store(PL_ptr_table, &other_perl->Isv_no, &PL_sv_no);
             ptr_table_store(PL_ptr_table, &other_perl->Isv_yes, &PL_sv_yes);
+#  ifdef PL_sv_zero
+            ptr_table_store(PL_ptr_table, &other_perl->Isv_zero, &PL_sv_zero);
+#  endif
             params = (AV *)sv_dup((SV*)params_copy, clone_params);
             S_ithread_set(aTHX_ current_thread);
             Perl_clone_params_del(clone_params);
@@ -1802,6 +1825,9 @@ ithread_error(...)
             ptr_table_store(PL_ptr_table, &other_perl->Isv_undef, &PL_sv_undef);
             ptr_table_store(PL_ptr_table, &other_perl->Isv_no, &PL_sv_no);
             ptr_table_store(PL_ptr_table, &other_perl->Isv_yes, &PL_sv_yes);
+#  ifdef PL_sv_zero
+            ptr_table_store(PL_ptr_table, &other_perl->Isv_zero, &PL_sv_zero);
+#  endif
             err = sv_dup(thread->err, clone_params);
             S_ithread_set(aTHX_ current_thread);
             Perl_clone_params_del(clone_params);
@@ -1834,7 +1860,6 @@ BOOT:
     SV *my_pool_sv = *hv_fetch(PL_modglobal, MY_POOL_KEY,
                                sizeof(MY_POOL_KEY)-1, TRUE);
     my_pool_t *my_poolp = (my_pool_t*)SvPVX(newSV(sizeof(my_pool_t)-1));
-
     MY_CXT_INIT;
 
     Zero(my_poolp, 1, my_pool_t);