packages/perl-threads
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Compare commits

base: packages:afd3638e4a3e2d48075251ed44405ed4f224ebdf
Branches Tags
packages:main
..
compare: packages:8d00b961134f55fb092710b2950da163ffb45dc1
Branches Tags
packages:main

No commits in common. "afd3638e4a3e2d48075251ed44405ed4f224ebdf" and "8d00b961134f55fb092710b2950da163ffb45dc1" have entirely different histories.
afd3638e4a ... 8d00b96113

2 changed files with 7 additions and 900 deletions
Show Stats Expand all files Collapse all files

875
backport-threads-2.21-upgradeto-2.36.patch
View File

@ -1,875 +0,0 @@
From 21c0eec75d068f0dd12704a40071fe8fd2df5061 Mon Sep 17 00:00:00 2001
From: zhangyao <zhangyao108@huawei.com>
Date: Mon, 8 Apr 2024 16:02:04 +0800
Subject: [PATCH] threads 2.21 upgrade to 2.36
Reference: Unbundled from perl 5.38.2
---
MANIFEST | 2 +-
lib/threads.pm | 51 ++++++++++++++++++++++-------
t/libc.t | 3 ++
t/pod.t | 87 --------------------------------------------------
t/stack.t | 82 ++++++++++++++++++++++++++++++++++-------------
t/stack_env.t | 46 +++++++++++++++++++++++---
t/thread.t | 4 ++-
t/version.t | 31 ++++++++++++++++++
threads.h | 31 ------------------
threads.xs | 87 +++++++++++++++++++++++++++++++++-----------------
10 files changed, 235 insertions(+), 189 deletions(-)
delete mode 100644 t/pod.t
create mode 100644 t/version.t
diff --git a/MANIFEST b/MANIFEST
index 8c069bc..de44909 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -23,7 +23,6 @@ t/kill3.t
t/libc.t
t/list.t
t/no_threads.t
-t/pod.t
t/problems.t
t/stack.t
t/stack_env.t
@@ -33,6 +32,7 @@ t/stress_re.t
t/stress_string.t
t/thread.t
t/unique.t
+t/version.t
t/test.pl
examples/pool.pl
examples/pool_reuse.pl
diff --git a/lib/threads.pm b/lib/threads.pm
index 2eb926a..ecf025d 100644
--- a/lib/threads.pm
+++ b/lib/threads.pm
@@ -5,7 +5,7 @@ use 5.008;
use strict;
use warnings;
-our $VERSION = '2.21'; # remember to update version in POD!
+our $VERSION = '2.36'; # remember to update version in POD!
my $XS_VERSION = $VERSION;
$VERSION = eval $VERSION;
@@ -134,13 +134,13 @@ threads - Perl interpreter-based threads
=head1 VERSION
-This document describes threads version 2.21
+This document describes threads version 2.36
=head1 WARNING
The "interpreter-based threads" provided by Perl are not the fast, lightweight
system for multitasking that one might expect or hope for. Threads are
-implemented in a way that make them easy to misuse. Few people know how to
+implemented in a way that makes them easy to misuse. Few people know how to
use them correctly or will be able to provide help.
The use of interpreter-based threads in perl is officially
@@ -914,7 +914,7 @@ C<-E<gt>import()>) after any threads are started, and in such a way that no
other threads are started afterwards.
If the above does not work, or is not adequate for your application, then file
-a bug report on L<http://rt.cpan.org/Public/> against the problematic module.
+a bug report on L<https://rt.cpan.org/Public/> against the problematic module.
=item Memory consumption
@@ -937,6 +937,33 @@ 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, locales could not be used with threads, due to various
+race conditions. Starting in that release, on systems that implement
+thread-safe locale functions, threads can be used, with some caveats.
+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
@@ -999,7 +1026,7 @@ signalling behavior is only in effect in the following situations:
=over 4
-=item * Perl has been built with C<PERL_OLD_SIGNALS> (see C<perl -V>).
+=item * Perl has been built with C<PERL_OLD_SIGNALS> (see S<C<perl -V>>).
=item * The environment variable C<PERL_SIGNALS> is set to C<unsafe>
(see L<perlrun/"PERL_SIGNALS">).
@@ -1063,7 +1090,7 @@ determine whether your system supports it.
In prior perl versions, spawning threads with open directory handles would
crash the interpreter.
-L<[perl #75154]|http://rt.perl.org/rt3/Public/Bug/Display.html?id=75154>
+L<[perl #75154]|https://rt.perl.org/rt3/Public/Bug/Display.html?id=75154>
=item Detached threads and global destruction
@@ -1091,8 +1118,8 @@ unreferenced scalars. However, such warnings are harmless, and may safely be
ignored.
You can search for L<threads> related bug reports at
-L<http://rt.cpan.org/Public/>. If needed submit any new bugs, problems,
-patches, etc. to: L<http://rt.cpan.org/Public/Dist/Display.html?Name=threads>
+L<https://rt.cpan.org/Public/>. If needed submit any new bugs, problems,
+patches, etc. to: L<https://rt.cpan.org/Public/Dist/Display.html?Name=threads>
=back
@@ -1110,14 +1137,14 @@ L<https://github.com/Dual-Life/threads>
L<threads::shared>, L<perlthrtut>
-L<http://www.perl.com/pub/a/2002/06/11/threads.html> and
-L<http://www.perl.com/pub/a/2002/09/04/threads.html>
+L<https://www.perl.com/pub/a/2002/06/11/threads.html> and
+L<https://www.perl.com/pub/a/2002/09/04/threads.html>
Perl threads mailing list:
-L<http://lists.perl.org/list/ithreads.html>
+L<https://lists.perl.org/list/ithreads.html>
Stack size discussion:
-L<http://www.perlmonks.org/?node_id=532956>
+L<https://www.perlmonks.org/?node_id=532956>
Sample code in the I<examples> directory of this distribution on CPAN.
diff --git a/t/libc.t b/t/libc.t
index 4f6f6ed..592b8d3 100644
--- a/t/libc.t
+++ b/t/libc.t
@@ -9,6 +9,9 @@ BEGIN {
skip_all(q/Perl not compiled with 'useithreads'/);
}
+ # Guard against bugs that result in deadlock
+ watchdog(1 * 60);
+
plan(11);
}
diff --git a/t/pod.t b/t/pod.t
deleted file mode 100644
index 390f7e2..0000000
--- a/t/pod.t
+++ /dev/null
@@ -1,87 +0,0 @@
-use strict;
-use warnings;
-
-use Test::More;
-if ($ENV{RUN_MAINTAINER_TESTS}) {
- plan 'tests' => 3;
-} else {
- plan 'skip_all' => 'Module maintainer tests';
-}
-
-SKIP: {
- if (! eval 'use Test::Pod 1.26; 1') {
- skip('Test::Pod 1.26 required for testing POD', 1);
- }
-
- pod_file_ok('lib/threads.pm');
-}
-
-SKIP: {
- if (! eval 'use Test::Pod::Coverage 1.08; 1') {
- skip('Test::Pod::Coverage 1.08 required for testing POD coverage', 1);
- }
-
- pod_coverage_ok('threads',
- {
- 'trustme' => [
- qr/^new$/,
- qr/^exit$/,
- qr/^async$/,
- qr/^\(/,
- qr/^(all|running|joinable)$/,
- ],
- 'private' => [
- qr/^import$/,
- qr/^DESTROY$/,
- qr/^bootstrap$/,
- ]
- }
- );
-}
-
-SKIP: {
- if (! eval 'use Test::Spelling; 1') {
- skip('Test::Spelling required for testing POD spelling', 1);
- }
- if (system('aspell help >/dev/null 2>&1')) {
- skip(q/'aspell' required for testing POD spelling/, 1);
- }
- set_spell_cmd('aspell list --lang=en');
- add_stopwords(<DATA>);
- pod_file_spelling_ok('lib/threads.pm', 'thread.pm spelling');
- unlink("/home/$ENV{'USER'}/en.prepl", "/home/$ENV{'USER'}/en.pws");
-}
-
-exit(0);
-
-__DATA__
-
-API
-async
-cpan
-MSWin32
-pthreads
-SIGTERM
-TID
-Config.pm
-
-Hedden
-Artur
-Soderberg
-crystalflame
-brecon
-netrus
-Rocco
-Caputo
-netrus
-vipul
-Ved
-Prakash
-presicient
-
-okay
-unjoinable
-incrementing
-
-MetaCPAN
-__END__
diff --git a/t/stack.t b/t/stack.t
index cfd6cf7..0dcc947 100644
--- a/t/stack.t
+++ b/t/stack.t
@@ -9,6 +9,20 @@ BEGIN {
}
}
+my $frame_size;
+my $frames;
+my $size;
+
+BEGIN {
+ # XXX Note that if the default stack size happens to be the same as these
+ # numbers, that test 2 would return success just out of happenstance.
+ # This possibility could be lessened by choosing $frames to be something
+ # less likely than a power of 2
+ $frame_size = 4096;
+ $frames = 128;
+ $size = $frames * $frame_size;
+}
+
use ExtUtils::testlib;
sub ok {
@@ -25,77 +39,101 @@ sub ok {
return ($ok);
}
+sub is {
+ my ($id, $got, $expected, $name) = @_;
+
+ my $ok = ok($id, $got == $expected, $name);
+ if (! $ok) {
+ print(" GOT: $got\n");
+ print("EXPECTED: $expected\n");
+ }
+
+ return ($ok);
+}
+
BEGIN {
$| = 1;
print("1..18\n"); ### Number of tests that will be run ###
};
-use threads ('stack_size' => 128*4096);
+use threads ('stack_size' => $size);
ok(1, 1, 'Loaded');
### Start of Testing ###
-ok(2, threads->get_stack_size() == 128*4096,
- 'Stack size set in import');
-ok(3, threads->set_stack_size(160*4096) == 128*4096,
+my $actual_size = threads->get_stack_size();
+
+{
+ if ($actual_size > $size) {
+ print("ok 2 # skip because system needs larger minimum stack size\n");
+ $size = $actual_size;
+ }
+ else {
+ is(2, $actual_size, $size, 'Stack size set in import');
+ }
+}
+
+my $size_plus_quarter = $size * 1.25; # 128 frames map to 160
+is(3, threads->set_stack_size($size_plus_quarter), $size,
'Set returns previous value');
-ok(4, threads->get_stack_size() == 160*4096,
+is(4, threads->get_stack_size(), $size_plus_quarter,
'Get stack size');
threads->create(
sub {
- ok(5, threads->get_stack_size() == 160*4096,
+ is(5, threads->get_stack_size(), $size_plus_quarter,
'Get stack size in thread');
- ok(6, threads->self()->get_stack_size() == 160*4096,
+ is(6, threads->self()->get_stack_size(), $size_plus_quarter,
'Thread gets own stack size');
- ok(7, threads->set_stack_size(128*4096) == 160*4096,
+ is(7, threads->set_stack_size($size), $size_plus_quarter,
'Thread changes stack size');
- ok(8, threads->get_stack_size() == 128*4096,
+ is(8, threads->get_stack_size(), $size,
'Get stack size in thread');
- ok(9, threads->self()->get_stack_size() == 160*4096,
+ is(9, threads->self()->get_stack_size(), $size_plus_quarter,
'Thread stack size unchanged');
}
)->join();
-ok(10, threads->get_stack_size() == 128*4096,
+is(10, threads->get_stack_size(), $size,
'Default thread sized changed in thread');
threads->create(
- { 'stack' => 160*4096 },
+ { 'stack' => $size_plus_quarter },
sub {
- ok(11, threads->get_stack_size() == 128*4096,
+ is(11, threads->get_stack_size(), $size,
'Get stack size in thread');
- ok(12, threads->self()->get_stack_size() == 160*4096,
+ is(12, threads->self()->get_stack_size(), $size_plus_quarter,
'Thread gets own stack size');
}
)->join();
-my $thr = threads->create( { 'stack' => 160*4096 }, sub { } );
+my $thr = threads->create( { 'stack' => $size_plus_quarter }, sub { } );
$thr->create(
sub {
- ok(13, threads->get_stack_size() == 128*4096,
+ is(13, threads->get_stack_size(), $size,
'Get stack size in thread');
- ok(14, threads->self()->get_stack_size() == 160*4096,
+ is(14, threads->self()->get_stack_size(), $size_plus_quarter,
'Thread gets own stack size');
}
)->join();
+my $size_plus_eighth = $size * 1.125; # 128 frames map to 144
$thr->create(
- { 'stack' => 144*4096 },
+ { 'stack' => $size_plus_eighth },
sub {
- ok(15, threads->get_stack_size() == 128*4096,
+ is(15, threads->get_stack_size(), $size,
'Get stack size in thread');
- ok(16, threads->self()->get_stack_size() == 144*4096,
+ is(16, threads->self()->get_stack_size(), $size_plus_eighth,
'Thread gets own stack size');
- ok(17, threads->set_stack_size(160*4096) == 128*4096,
+ is(17, threads->set_stack_size($size_plus_quarter), $size,
'Thread changes stack size');
}
)->join();
$thr->join();
-ok(18, threads->get_stack_size() == 160*4096,
+is(18, threads->get_stack_size(), $size_plus_quarter,
'Default thread sized changed in thread');
exit(0);
diff --git a/t/stack_env.t b/t/stack_env.t
index e36812f..fdb38cc 100644
--- a/t/stack_env.t
+++ b/t/stack_env.t
@@ -25,11 +25,36 @@ sub ok {
return ($ok);
}
+sub is {
+ my ($id, $got, $expected, $name) = @_;
+
+ my $ok = ok($id, $got == $expected, $name);
+ if (! $ok) {
+ print(" GOT: $got\n");
+ print("EXPECTED: $expected\n");
+ }
+
+ return ($ok);
+}
+
+my $frame_size;
+my $frames;
+my $size;
+
BEGIN {
$| = 1;
print("1..4\n"); ### Number of tests that will be run ###
- $ENV{'PERL5_ITHREADS_STACK_SIZE'} = 128*4096;
+ # XXX Note that if the default stack size happens to be the same as these
+ # numbers, that test 2 would return success just out of happenstance.
+ # This possibility could be lessened by choosing $frames to be something
+ # less likely than a power of 2
+
+ $frame_size = 4096;
+ $frames = 128;
+ $size = $frames * $frame_size;
+
+ $ENV{'PERL5_ITHREADS_STACK_SIZE'} = $size;
};
use threads;
@@ -37,11 +62,22 @@ ok(1, 1, 'Loaded');
### Start of Testing ###
-ok(2, threads->get_stack_size() == 128*4096,
- '$ENV{PERL5_ITHREADS_STACK_SIZE}');
-ok(3, threads->set_stack_size(144*4096) == 128*4096,
+my $actual_size = threads->get_stack_size();
+
+{
+ if ($actual_size > $size) {
+ print("ok 2 # skip because system needs larger minimum stack size\n");
+ $size = $actual_size;
+ }
+ else {
+ is(2, $actual_size, $size, '$ENV{PERL5_ITHREADS_STACK_SIZE}');
+ }
+}
+
+my $size_plus_eighth = $size * 1.125; # 128 frames map to 144
+is(3, threads->set_stack_size($size_plus_eighth), $size,
'Set returns previous value');
-ok(4, threads->get_stack_size() == 144*4096,
+is(4, threads->get_stack_size(), $size_plus_eighth,
'Get stack size');
exit(0);
diff --git a/t/thread.t b/t/thread.t
index 4dc1a29..8a56bb6 100644
--- a/t/thread.t
+++ b/t/thread.t
@@ -11,6 +11,7 @@ BEGIN {
}
use ExtUtils::testlib;
+use Data::Dumper;
use threads;
@@ -156,7 +157,8 @@ package main;
rand(10);
threads->create( sub { $rand{int(rand(10000000000))}++ } ) foreach 1..25;
$_->join foreach threads->list;
- ok((keys %rand >= 23), "Check that rand() is randomized in new threads");
+ ok((keys %rand >= 23), "Check that rand() is randomized in new threads")
+ or diag Dumper(\%rand);
}
# bugid #24165
diff --git a/t/version.t b/t/version.t
new file mode 100644
index 0000000..fb91309
--- /dev/null
+++ b/t/version.t
@@ -0,0 +1,31 @@
+use strict;
+use warnings;
+use Test::More;
+
+BEGIN {
+ use Config;
+ if (! $Config{'useithreads'}) {
+ print("1..0 # SKIP Perl not compiled with 'useithreads'\n");
+ exit(0);
+ }
+}
+
+use threads;
+
+# test that the version documented in threads.pm pod matches
+# that of the code.
+
+open my $fh, "<", $INC{"threads.pm"}
+ or die qq(Failed to open '$INC{"threads.pm"}': $!);
+my $file= do { local $/; <$fh> };
+close $fh;
+my $pod_version = 0;
+if ($file=~/This document describes threads version (\d.\d+)/) {
+ $pod_version = $1;
+}
+is($pod_version, $threads::VERSION,
+ "Check that pod and \$threads::VERSION match");
+done_testing();
+
+
+
diff --git a/threads.h b/threads.h
index bdfab49..e69de29 100644
--- a/threads.h
+++ b/threads.h
@@ -1,31 +0,0 @@
-#ifndef _THREADS_H_
-#define _THREADS_H_
-
-/* Needed for 5.8.0 */
-#ifndef CLONEf_JOIN_IN
-# define CLONEf_JOIN_IN 8
-#endif
-#ifndef SAVEBOOL
-# define SAVEBOOL(a)
-#endif
-
-/* Added in 5.11.x */
-#ifndef G_WANT
-# define G_WANT (128|1)
-#endif
-
-/* Added in 5.24.x */
-#ifndef PERL_TSA_RELEASE
-# define PERL_TSA_RELEASE(x)
-#endif
-#ifndef PERL_TSA_EXCLUDES
-# define PERL_TSA_EXCLUDES(x)
-#endif
-#ifndef CLANG_DIAG_IGNORE
-# define CLANG_DIAG_IGNORE(x)
-#endif
-#ifndef CLANG_DIAG_RESTORE
-# define CLANG_DIAG_RESTORE
-#endif
-
-#endif
diff --git a/threads.xs b/threads.xs
index 4e9e31f..25fec16 100644
--- a/threads.xs
+++ b/threads.xs
@@ -15,18 +15,20 @@
# define setjmp(x) _setjmp(x)
# endif
# if defined(__MINGW64__)
+# include <intrin.h>
# define setjmp(x) _setjmpex((x), mingw_getsp())
# endif
#endif
-#ifdef HAS_PPPORT_H
-# define NEED_PL_signals
-# define NEED_sv_2pv_flags
-# include "ppport.h"
-# include "threads.h"
-#endif
+#define NEED_PL_signals
+#define NEED_sv_2pv_flags
+#include "ppport.h"
+#include "threads.h"
#ifndef sv_dup_inc
# define sv_dup_inc(s,t) SvREFCNT_inc(sv_dup(s,t))
#endif
+#ifndef SvREFCNT_dec_NN
+# define SvREFCNT_dec_NN(x) SvREFCNT_dec(x)
+#endif
#ifndef PERL_UNUSED_RESULT
# if defined(__GNUC__) && defined(HASATTRIBUTE_WARN_UNUSED_RESULT)
# define PERL_UNUSED_RESULT(v) STMT_START { __typeof__(v) z = (v); (void)sizeof(z); } STMT_END
@@ -91,8 +93,8 @@ typedef perl_os_thread pthread_t;
typedef struct _ithread {
struct _ithread *next; /* Next thread in the list */
struct _ithread *prev; /* Prev thread in the list */
- PerlInterpreter *interp; /* The threads interpreter */
- UV tid; /* Threads module's thread id */
+ PerlInterpreter *interp; /* The thread's interpreter */
+ UV tid; /* Thread's module's thread id */
perl_mutex mutex; /* Mutex for updating things in this struct */
int count; /* Reference count. See S_ithread_create. */
int state; /* Detached, joined, finished, etc. */
@@ -203,6 +205,9 @@ S_ithread_set(pTHX_ ithread *thread)
{
dMY_CXT;
MY_CXT.context = thread;
+#ifdef PERL_SET_NON_tTHX_CONTEXT
+ PERL_SET_NON_tTHX_CONTEXT(thread->interp);
+#endif
}
STATIC ithread *
@@ -241,18 +246,31 @@ S_ithread_clear(pTHX_ ithread *thread)
S_block_most_signals(&origmask);
#endif
+#if PERL_VERSION_GE(5, 37, 5)
+ int save_veto = PL_veto_switch_non_tTHX_context;
+#endif
+
interp = thread->interp;
if (interp) {
dTHXa(interp);
+ /* We will pretend to be a thread that we are not by switching tTHX,
+ * which doesn't work with things that don't rely on tTHX during
+ * tear-down, as they will tend to rely on a mapping from the tTHX
+ * structure, and that structure is being destroyed. */
+#if PERL_VERSION_GE(5, 37, 5)
+ PL_veto_switch_non_tTHX_context = true;
+#endif
+
PERL_SET_CONTEXT(interp);
+
S_ithread_set(aTHX_ thread);
SvREFCNT_dec(thread->params);
thread->params = NULL;
if (thread->err) {
- SvREFCNT_dec(thread->err);
+ SvREFCNT_dec_NN(thread->err);
thread->err = Nullsv;
}
@@ -262,6 +280,10 @@ S_ithread_clear(pTHX_ ithread *thread)
}
PERL_SET_CONTEXT(aTHX);
+#if PERL_VERSION_GE(5, 37, 5)
+ PL_veto_switch_non_tTHX_context = save_veto;
+#endif
+
#ifdef THREAD_SIGNAL_BLOCKING
S_set_sigmask(&origmask);
#endif
@@ -421,7 +443,7 @@ STATIC const MGVTBL ithread_vtbl = {
ithread_mg_free, /* free */
0, /* copy */
ithread_mg_dup, /* dup */
-#if (PERL_VERSION > 8) || (PERL_VERSION == 8 && PERL_SUBVERSION > 8)
+#if PERL_VERSION_GT(5,8,8)
0 /* local */
#endif
};
@@ -580,6 +602,8 @@ S_ithread_run(void * arg)
S_set_sigmask(&thread->initial_sigmask);
#endif
+ thread_locale_init();
+
PL_perl_destruct_level = 2;
{
@@ -665,6 +689,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);
@@ -672,7 +698,7 @@ S_ithread_run(void * arg)
}
/* At this point, the interpreter may have been freed, so call
- * free in the the context of of the 'main' interpreter which
+ * free in the context of the 'main' interpreter which
* can't have been freed due to the veto_cleanup mechanism.
*/
aTHX = MY_POOL.main_thread.interp;
@@ -747,7 +773,7 @@ S_ithread_create(
AV *params;
SV **array;
-#if PERL_VERSION <= 8 && PERL_SUBVERSION <= 7
+#if PERL_VERSION_LE(5,8,7)
SV **tmps_tmp = PL_tmps_stack;
IV tmps_ix = PL_tmps_ix;
#endif
@@ -803,6 +829,7 @@ S_ithread_create(
thread->gimme = gimme;
thread->state = exit_opt;
+
/* "Clone" our interpreter into the thread's interpreter.
* This gives thread access to "static data" and code.
*/
@@ -845,7 +872,7 @@ S_ithread_create(
* context for the duration of our work for new interpreter.
*/
{
-#if (PERL_VERSION > 13) || (PERL_VERSION == 13 && PERL_SUBVERSION > 1)
+#if PERL_VERSION_GE(5,13,2)
CLONE_PARAMS *clone_param = Perl_clone_params_new(aTHX, thread->interp);
#else
CLONE_PARAMS clone_param_s;
@@ -855,7 +882,7 @@ S_ithread_create(
MY_CXT_CLONE;
-#if (PERL_VERSION < 13) || (PERL_VERSION == 13 && PERL_SUBVERSION <= 1)
+#if PERL_VERSION_LT(5,13,2)
clone_param->flags = 0;
#endif
@@ -882,7 +909,7 @@ S_ithread_create(
perl_clone() and sv_dup_inc(). Hence copy the parameters
somewhere under our control first, before duplicating. */
if (num_params) {
-#if (PERL_VERSION > 8)
+#if PERL_VERSION_GE(5,9,0)
Copy(parent_perl->Istack_base + params_start, array, num_params, SV *);
#else
Copy(parent_perl->Tstack_base + params_start, array, num_params, SV *);
@@ -893,11 +920,11 @@ S_ithread_create(
}
}
-#if (PERL_VERSION > 13) || (PERL_VERSION == 13 && PERL_SUBVERSION > 1)
+#if PERL_VERSION_GE(5,13,2)
Perl_clone_params_del(clone_param);
#endif
-#if PERL_VERSION <= 8 && PERL_SUBVERSION <= 7
+#if PERL_VERSION_LT(5,8,8)
/* The code below checks that anything living on the tmps stack and
* has been cloned (so it lives in the ptr_table) has a refcount
* higher than 0.
@@ -1030,10 +1057,10 @@ S_ithread_create(
MUTEX_UNLOCK(&my_pool->create_destruct_mutex);
return (thread);
- CLANG_DIAG_IGNORE_STMT(-Wthread-safety);
+ CLANG_DIAG_IGNORE(-Wthread-safety)
/* warning: mutex 'thread->mutex' is not held on every path through here [-Wthread-safety-analysis] */
}
-CLANG_DIAG_RESTORE_DECL;
+CLANG_DIAG_RESTORE
#endif /* USE_ITHREADS */
@@ -1111,7 +1138,7 @@ ithread_create(...)
case 'A':
case 'l':
case 'L':
- context = G_ARRAY;
+ context = G_LIST;
break;
case 's':
case 'S':
@@ -1126,11 +1153,11 @@ ithread_create(...)
}
} else if ((svp = hv_fetchs(specs, "array", 0))) {
if (SvTRUE(*svp)) {
- context = G_ARRAY;
+ context = G_LIST;
}
} else if ((svp = hv_fetchs(specs, "list", 0))) {
if (SvTRUE(*svp)) {
- context = G_ARRAY;
+ context = G_LIST;
}
} else if ((svp = hv_fetchs(specs, "scalar", 0))) {
if (SvTRUE(*svp)) {
@@ -1152,7 +1179,7 @@ ithread_create(...)
if (context == -1) {
context = GIMME_V; /* Implicit context */
} else {
- context |= (GIMME_V & (~(G_ARRAY|G_SCALAR|G_VOID)));
+ context |= (GIMME_V & (~(G_LIST|G_SCALAR|G_VOID)));
}
/* Create thread */
@@ -1167,6 +1194,7 @@ ithread_create(...)
if (! thread) {
XSRETURN_UNDEF; /* Mutex already unlocked */
}
+ PERL_SRAND_OVERRIDE_NEXT_PARENT();
ST(0) = sv_2mortal(S_ithread_to_SV(aTHX_ Nullsv, thread, classname, FALSE));
/* Let thread run. */
@@ -1175,7 +1203,6 @@ ithread_create(...)
/* warning: releasing mutex 'thread->mutex' that was not held [-Wthread-safety-analysis] */
MUTEX_UNLOCK(&thread->mutex);
CLANG_DIAG_RESTORE_STMT;
-
/* XSRETURN(1); - implied */
@@ -1197,7 +1224,7 @@ ithread_list(...)
classname = (char *)SvPV_nolen(ST(0));
/* Calling context */
- list_context = (GIMME_V == G_ARRAY);
+ list_context = (GIMME_V == G_LIST);
/* Running or joinable parameter */
if (items > 1) {
@@ -1335,7 +1362,7 @@ ithread_join(...)
/* Get the return value from the call_sv */
/* Objects do not survive this process - FIXME */
if ((thread->gimme & G_WANT) != G_VOID) {
-#if (PERL_VERSION < 13) || (PERL_VERSION == 13 && PERL_SUBVERSION <= 1)
+#if PERL_VERSION_LT(5,13,2)
AV *params_copy;
PerlInterpreter *other_perl;
CLONE_PARAMS clone_params;
@@ -1722,9 +1749,9 @@ ithread_wantarray(...)
CODE:
PERL_UNUSED_VAR(items);
thread = S_SV_to_ithread(aTHX_ ST(0));
- ST(0) = ((thread->gimme & G_WANT) == G_ARRAY) ? &PL_sv_yes :
- ((thread->gimme & G_WANT) == G_VOID) ? &PL_sv_undef
- /* G_SCALAR */ : &PL_sv_no;
+ ST(0) = ((thread->gimme & G_WANT) == G_LIST) ? &PL_sv_yes :
+ ((thread->gimme & G_WANT) == G_VOID) ? &PL_sv_undef
+ /* G_SCALAR */ : &PL_sv_no;
/* XSRETURN(1); - implied */
@@ -1762,7 +1789,7 @@ ithread_error(...)
/* If thread died, then clone the error into the calling thread */
if (thread->state & PERL_ITHR_DIED) {
-#if (PERL_VERSION < 13) || (PERL_VERSION == 13 && PERL_SUBVERSION <= 1)
+#if PERL_VERSION_LT(5,13,2)
PerlInterpreter *other_perl;
CLONE_PARAMS clone_params;
ithread *current_thread;
--
2.33.0

32
perl-threads.spec
View File

@ -1,16 +1,11 @@
%global base_version 2.21 Name: perl-threads
%define mod_name threads
Name: perl-%{mod_name}
Epoch: 2 Epoch: 2
Version: 2.36 Version: 2.21
Release: 2 Release: 3
Summary: Perl interpreter-based threads Summary: Perl interpreter-based threads
License: GPL+ or Artistic License: GPL+ or Artistic
URL: https://metacpan.org/release/%{mod_name} URL: https://metacpan.org/release/threads
Source0: https://cpan.metacpan.org/authors/id/J/JD/JDHEDDEN/%{mod_name}-%{version}.tar.gz#/%{mod_name}-2.21.tar.gz Source0: https://cpan.metacpan.org/authors/id/J/JD/JDHEDDEN/threads-%{version}.tar.gz#/threads-2.21.tar.gz
Patch6000: backport-threads-2.21-upgradeto-2.36.patch
BuildRequires: perl-devel perl-generators perl-interpreter gcc BuildRequires: perl-devel perl-generators perl-interpreter gcc
BuildRequires: perl(ExtUtils::MakeMaker) >= 6.76 perl(ExtUtils::testlib) perl(Test::More) BuildRequires: perl(ExtUtils::MakeMaker) >= 6.76 perl(ExtUtils::testlib) perl(Test::More)
Requires: perl(:MODULE_COMPAT_%(eval "`perl -V:version`"; echo $version)) Requires: perl(:MODULE_COMPAT_%(eval "`perl -V:version`"; echo $version))
@ -34,8 +29,7 @@ Requires: man
The %{name}-help package contains doc files for %{name}. The %{name}-help package contains doc files for %{name}.
%prep %prep
%autosetup -n %{mod_name}-%{base_version} -p1 %autosetup -n threads-%{version}
chmod -x examples/* chmod -x examples/*
%build %build
@ -59,18 +53,6 @@ make test
%{_mandir}/man3/* %{_mandir}/man3/*
%changelog %changelog
* Mon Apr 8 2024 zhangyao <zhangyao108@huawei.com> - 2:2.36-2
- DESC: fix make check failed
* Fri Jan 26 2024 zhangyao <zhangyao108@huawei.com> - 2:2.36-1
- DESC: Upgrade version to 2.36, test code modify, build optimization, avoid the use of magic numbers, deal compilation warning
* Mon Oct 24 2022 yangmingtai <yangmingtai@huawei.com> - 2:2.26-2
- define mod_name to opitomize the specfile
* Sun Dec 26 2021 guozhaorui <guozhaorui1@huawei.com> - 2:2.26-1
- update version to 2.26
* Mon Jun 28 2021 yuanxin<yuanxin24@huawei.com> - 2:2.21-3 * Mon Jun 28 2021 yuanxin<yuanxin24@huawei.com> - 2:2.21-3
- add buildrequires gcc - add buildrequires gcc
@ -86,7 +68,7 @@ make test
- SUG: NA - SUG: NA
- DESC: downgrade to stable version - DESC: downgrade to stable version
* Fri Sep 27 2019 luhuaxin <luhuaxin@huawei.com> - 1:2.22-419 * Tue Sep 27 2019 luhuaxin <luhuaxin@huawei.com> - 1:2.22-419
- Type: enhancement - Type: enhancement
- ID: NA - ID: NA
- SUG: NA - SUG: NA