!19 [sync] PR-18: fix make check failed

From: @openeuler-sync-bot 
Reviewed-by: @openeuler-basic 
Signed-off-by: @openeuler-basic

backport-threads-2.21-upgradeto-2.36.patch

@@ -0,0 +1,875 @@
+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
+

perl-threads.spec

@@ -1,11 +1,16 @@
-Name:           perl-threads
+%global base_version 2.21
+%define mod_name threads
+Name:           perl-%{mod_name}
 Epoch:          2
-Version:        2.21
-Release:        3
+Version:        2.36
+Release:        2
 Summary:        Perl interpreter-based threads
 License:        GPL+ or Artistic
-URL:            https://metacpan.org/release/threads
-Source0:        https://cpan.metacpan.org/authors/id/J/JD/JDHEDDEN/threads-%{version}.tar.gz#/threads-2.21.tar.gz
+URL:            https://metacpan.org/release/%{mod_name}
+Source0:        https://cpan.metacpan.org/authors/id/J/JD/JDHEDDEN/%{mod_name}-%{version}.tar.gz#/%{mod_name}-2.21.tar.gz
+
+Patch6000:      backport-threads-2.21-upgradeto-2.36.patch
+
 BuildRequires:  perl-devel perl-generators perl-interpreter gcc
 BuildRequires:  perl(ExtUtils::MakeMaker) >= 6.76 perl(ExtUtils::testlib) perl(Test::More)
 Requires:       perl(:MODULE_COMPAT_%(eval "`perl -V:version`"; echo $version))
@@ -29,7 +34,8 @@ Requires:	man
 The %{name}-help package contains doc files for %{name}.
 
 %prep
-%autosetup -n threads-%{version}
+%autosetup -n %{mod_name}-%{base_version} -p1
+
 chmod -x examples/*
 
 %build
@@ -53,6 +59,18 @@ make test
 %{_mandir}/man3/*
 
 %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
 - add buildrequires gcc
 
@@ -68,7 +86,7 @@ make test
 - SUG: NA
 - DESC: downgrade to stable version
 
-* Tue Sep 27 2019 luhuaxin <luhuaxin@huawei.com> - 1:2.22-419
+* Fri Sep 27 2019 luhuaxin <luhuaxin@huawei.com> - 1:2.22-419
 - Type: enhancement
 - ID: NA
 - SUG: NA