Upgrade to 2.40 as provided in perl-5.40.0-RC1

This commit is contained in:
Jitka Plesnikova 2024-07-18 11:09:03 +02:00
parent 58dacfe587
commit d63d586347
2 changed files with 178 additions and 90 deletions

View File

@ -1,14 +1,14 @@
%global base_version 2.21
Name: perl-threads
Epoch: 1
Version: 2.36
Version: 2.40
Release: 504%{?dist}
Summary: Perl interpreter-based threads
License: GPL-1.0-or-later OR Artistic-1.0-Perl
URL: https://metacpan.org/release/threads
Source0: https://cpan.metacpan.org/authors/id/J/JD/JDHEDDEN/threads-%{base_version}.tar.gz
# Unbundled from perl 5.37.11
Patch0: threads-2.21-Upgrade-to-2.36.patch
# Unbundled from perl 5.40.0-RC1
Patch0: threads-2.21-Upgrade-to-2.40.patch
BuildRequires: coreutils
BuildRequires: findutils
BuildRequires: gcc
@ -17,6 +17,7 @@ BuildRequires: perl-devel
BuildRequires: perl-generators
BuildRequires: perl-interpreter
BuildRequires: perl(Config)
BuildRequires: perl(Devel::PPPort)
BuildRequires: perl(ExtUtils::MakeMaker) >= 6.76
BuildRequires: perl(File::Spec)
BuildRequires: perl(strict)
@ -71,6 +72,10 @@ with "%{_libexecdir}/%{name}/test".
%patch -P0 -p1
chmod -x examples/*
# Generate ppport.h
perl -MDevel::PPPort \
-e "Devel::PPPort::WriteFile() or die 'Could not generate ppport.h: $!'"
# Help generators to recognize Perl scripts
for F in t/*.t; do
perl -i -MConfig -ple 'print $Config{startperl} if $. == 1 && !s{\A#!.*perl\b}{$Config{startperl}}' "$F"
@ -122,6 +127,9 @@ make test
%{_libexecdir}/%{name}
%changelog
* Thu Jul 18 2024 Jitka Plesnikova <jplesnik@redhat.com> - 1:2.40-504
- Upgrade to 2.40 as provided in perl-5.40.0-RC1
* Mon Jun 24 2024 Troy Dawson <tdawson@redhat.com> - 1:2.36-504
- Bump release for June 2024 mass rebuild

View File

@ -1,64 +1,45 @@
From 4b88fd5215fcd370de11c1bb448229e8f6643b27 Mon Sep 17 00:00:00 2001
From eccb4c8b9d51bca62104bf80839572c2b5a31caa Mon Sep 17 00:00:00 2001
From: Jitka Plesnikova <jplesnik@redhat.com>
Date: Fri, 19 May 2023 08:55:51 +0200
Subject: [PATCH] Upgrade to 2.36
Date: Fri, 3 May 2024 12:09:37 +0200
Subject: [PATCH] Upgrade to 2.40
---
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 ++-
11 files changed, 235 insertions(+), 1939 deletions(-)
delete mode 100644 t/pod.t
delete mode 100644 t/test.pl
lib/threads.pm | 53 +-
t/libc.t | 3 +
t/pod.t | 87 ---
t/stack.t | 82 ++-
t/stack_env.t | 46 +-
t/test.pl | 1749 ---------------------------------------------
t/thread.t | 4 +-
t/version.t | 31 +
threads.h | 31 -
threads.xs | 142 ++--
29 files changed, 265 insertions(+), 214 deletions(-)
delete mode 100755 t/pod.t
create mode 100644 t/version.t
diff --git a/MANIFEST b/MANIFEST
index 8c069bc..dd0d8ce 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
META.yml Module YAML meta-data (added by MakeMaker)
diff --git a/lib/threads.pm b/lib/threads.pm
index 2eb926a..ecf025d 100644
index 2eb926a..471ceec 100644
--- a/lib/threads.pm
+++ b/lib/threads.pm
@@ -5,7 +5,7 @@ use 5.008;
@@ -5,9 +5,9 @@ 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!
+our $VERSION = '2.40'; # remember to update version in POD!
my $XS_VERSION = $VERSION;
$VERSION = eval $VERSION;
-$VERSION = eval $VERSION;
+#$VERSION = eval $VERSION;
# Verify this Perl supports threads
require Config;
@@ -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
+This document describes threads version 2.40
=head1 WARNING
@ -161,7 +142,7 @@ index 2eb926a..ecf025d 100644
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
index 4f6f6ed..592b8d3
--- a/t/libc.t
+++ b/t/libc.t
@@ -9,6 +9,9 @@ BEGIN {
@ -175,7 +156,7 @@ index 4f6f6ed..592b8d3 100644
}
diff --git a/t/pod.t b/t/pod.t
deleted file mode 100644
deleted file mode 100755
index 390f7e2..0000000
--- a/t/pod.t
+++ /dev/null
@ -268,7 +249,7 @@ index 390f7e2..0000000
-MetaCPAN
-__END__
diff --git a/t/stack.t b/t/stack.t
index cfd6cf7..0dcc947 100644
index cfd6cf7..0dcc947
--- a/t/stack.t
+++ b/t/stack.t
@@ -9,6 +9,20 @@ BEGIN {
@ -417,7 +398,7 @@ index cfd6cf7..0dcc947 100644
exit(0);
diff --git a/t/stack_env.t b/t/stack_env.t
index e36812f..fdb38cc 100644
index e36812f..fdb38cc
--- a/t/stack_env.t
+++ b/t/stack_env.t
@@ -25,11 +25,36 @@ sub ok {
@ -486,7 +467,7 @@ index e36812f..fdb38cc 100644
exit(0);
diff --git a/t/thread.t b/t/thread.t
index 4dc1a29..8a56bb6 100644
index 4dc1a29..8a56bb6
--- a/t/thread.t
+++ b/t/thread.t
@@ -11,6 +11,7 @@ BEGIN {
@ -581,23 +562,41 @@ index bdfab49..e69de29 100644
-
-#endif
diff --git a/threads.xs b/threads.xs
index 4e9e31f..25fec16 100644
index 4e9e31f..b128f53 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
@@ -1,32 +1,22 @@
#define PERL_NO_GET_CONTEXT
-/* Workaround for mingw 32-bit compiler by mingw-w64.sf.net - has to come before any #include.
- * It also defines USE_NO_MINGW_SETJMP_TWO_ARGS for the mingw.org 32-bit compilers ... but
- * that's ok as that compiler makes no use of that symbol anyway */
-#if defined(WIN32) && defined(__MINGW32__) && !defined(__MINGW64__)
-# define USE_NO_MINGW_SETJMP_TWO_ARGS 1
-#endif
+/* Tell XSUB.h not to redefine common functions. Its setjmp() override has a
+ * circular definition in Perls < 5.40. */
+#define NO_XSLOCKS
+
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
-/* Workaround for XSUB.h bug under WIN32 */
-#ifdef WIN32
-# undef setjmp
-# if defined(USE_NO_MINGW_SETJMP_TWO_ARGS) || (!defined(__BORLANDC__) && !defined(__MINGW64__))
-# define setjmp(x) _setjmp(x)
-# endif
-# if defined(__MINGW64__)
-# 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"
@ -611,7 +610,7 @@ index 4e9e31f..25fec16 100644
#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;
@@ -91,8 +81,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 */
@ -622,17 +621,7 @@ index 4e9e31f..25fec16 100644
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)
@@ -241,18 +231,31 @@ S_ithread_clear(pTHX_ ithread *thread)
S_block_most_signals(&origmask);
#endif
@ -665,7 +654,7 @@ index 4e9e31f..25fec16 100644
thread->err = Nullsv;
}
@@ -262,6 +280,10 @@ S_ithread_clear(pTHX_ ithread *thread)
@@ -262,6 +265,10 @@ S_ithread_clear(pTHX_ ithread *thread)
}
PERL_SET_CONTEXT(aTHX);
@ -676,7 +665,7 @@ index 4e9e31f..25fec16 100644
#ifdef THREAD_SIGNAL_BLOCKING
S_set_sigmask(&origmask);
#endif
@@ -421,7 +443,7 @@ STATIC const MGVTBL ithread_vtbl = {
@@ -421,7 +428,7 @@ STATIC const MGVTBL ithread_vtbl = {
ithread_mg_free, /* free */
0, /* copy */
ithread_mg_dup, /* dup */
@ -685,7 +674,20 @@ index 4e9e31f..25fec16 100644
0 /* local */
#endif
};
@@ -580,6 +602,8 @@ S_ithread_run(void * arg)
@@ -525,11 +532,11 @@ S_jmpenv_run(pTHX_ int action, ithread *thread,
return jmp_rc;
}
-
/* Starts executing the thread.
* Passed as the C level function to run in the new thread.
*/
#ifdef WIN32
+PERL_STACK_REALIGN
STATIC THREAD_RET_TYPE
S_ithread_run(LPVOID arg)
#else
@@ -580,6 +587,8 @@ S_ithread_run(void * arg)
S_set_sigmask(&thread->initial_sigmask);
#endif
@ -694,6 +696,57 @@ index 4e9e31f..25fec16 100644
PL_perl_destruct_level = 2;
{
@@ -588,16 +597,26 @@ S_ithread_run(void * arg)
int ii;
int jmp_rc;
- dSP;
+#ifdef PERL_RC_STACK
+ assert(rpp_stack_is_rc());
+#endif
+
ENTER;
SAVETMPS;
/* Put args on the stack */
- PUSHMARK(SP);
+ PUSHMARK(PL_stack_sp);
for (ii=0; ii < len; ii++) {
- XPUSHs(av_shift(params));
+ SV *sv = av_shift(params);
+#ifdef PERL_RC_STACK
+ rpp_xpush_1(sv);
+#else
+ /* temporary workaround until rpp_* are in ppport.h */
+ dSP;
+ XPUSHs(sv);
+ PUTBACK;
+#endif
}
- PUTBACK;
jmp_rc = S_jmpenv_run(aTHX_ 0, thread, &len, &exit_app, &exit_code);
@@ -610,12 +629,17 @@ S_ithread_run(void * arg)
#endif
/* Remove args from stack and put back in params array */
- SPAGAIN;
for (ii=len-1; ii >= 0; ii--) {
- SV *sv = POPs;
+ SV *sv = *PL_stack_sp;
if (jmp_rc == 0 && (thread->gimme & G_WANT) != G_VOID) {
av_store(params, ii, SvREFCNT_inc(sv));
}
+#ifdef PERL_RC_STACK
+ rpp_popfree_1();
+#else
+ /* temporary workaround until rpp_* are in ppport.h */
+ PL_stack_sp--;
+#endif
}
FREETMPS;
@@ -665,6 +689,8 @@ S_ithread_run(void * arg)
MUTEX_UNLOCK(&thread->mutex);
MUTEX_UNLOCK(&MY_POOL.create_destruct_mutex);
@ -721,7 +774,17 @@ index 4e9e31f..25fec16 100644
SV **tmps_tmp = PL_tmps_stack;
IV tmps_ix = PL_tmps_ix;
#endif
@@ -803,6 +829,7 @@ S_ithread_create(
@@ -770,7 +796,8 @@ S_ithread_create(
int fd = PerlIO_fileno(Perl_error_log);
if (fd >= 0) {
/* If there's no error_log, we cannot scream about it missing. */
- PERL_UNUSED_RESULT(PerlLIO_write(fd, PL_no_mem, strlen(PL_no_mem)));
+ static const char oomp[] = "Out of memory in perl:threads:ithread_create\n";
+ PERL_UNUSED_RESULT(PerlLIO_write(fd, oomp, sizeof oomp - 1));
}
}
my_exit(1);
@@ -803,6 +830,7 @@ S_ithread_create(
thread->gimme = gimme;
thread->state = exit_opt;
@ -729,7 +792,7 @@ index 4e9e31f..25fec16 100644
/* "Clone" our interpreter into the thread's interpreter.
* This gives thread access to "static data" and code.
*/
@@ -845,7 +872,7 @@ S_ithread_create(
@@ -845,7 +873,7 @@ S_ithread_create(
* context for the duration of our work for new interpreter.
*/
{
@ -738,7 +801,7 @@ index 4e9e31f..25fec16 100644
CLONE_PARAMS *clone_param = Perl_clone_params_new(aTHX, thread->interp);
#else
CLONE_PARAMS clone_param_s;
@@ -855,7 +882,7 @@ S_ithread_create(
@@ -855,7 +883,7 @@ S_ithread_create(
MY_CXT_CLONE;
@ -747,7 +810,7 @@ index 4e9e31f..25fec16 100644
clone_param->flags = 0;
#endif
@@ -882,7 +909,7 @@ S_ithread_create(
@@ -882,7 +910,7 @@ S_ithread_create(
perl_clone() and sv_dup_inc(). Hence copy the parameters
somewhere under our control first, before duplicating. */
if (num_params) {
@ -756,7 +819,7 @@ index 4e9e31f..25fec16 100644
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(
@@ -893,11 +921,11 @@ S_ithread_create(
}
}
@ -770,7 +833,7 @@ index 4e9e31f..25fec16 100644
/* 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(
@@ -1030,10 +1058,10 @@ S_ithread_create(
MUTEX_UNLOCK(&my_pool->create_destruct_mutex);
return (thread);
@ -783,7 +846,7 @@ index 4e9e31f..25fec16 100644
#endif /* USE_ITHREADS */
@@ -1111,7 +1138,7 @@ ithread_create(...)
@@ -1111,7 +1139,7 @@ ithread_create(...)
case 'A':
case 'l':
case 'L':
@ -792,7 +855,7 @@ index 4e9e31f..25fec16 100644
break;
case 's':
case 'S':
@@ -1126,11 +1153,11 @@ ithread_create(...)
@@ -1126,11 +1154,11 @@ ithread_create(...)
}
} else if ((svp = hv_fetchs(specs, "array", 0))) {
if (SvTRUE(*svp)) {
@ -806,7 +869,7 @@ index 4e9e31f..25fec16 100644
}
} else if ((svp = hv_fetchs(specs, "scalar", 0))) {
if (SvTRUE(*svp)) {
@@ -1152,7 +1179,7 @@ ithread_create(...)
@@ -1152,7 +1180,7 @@ ithread_create(...)
if (context == -1) {
context = GIMME_V; /* Implicit context */
} else {
@ -815,7 +878,7 @@ index 4e9e31f..25fec16 100644
}
/* Create thread */
@@ -1167,6 +1194,7 @@ ithread_create(...)
@@ -1167,6 +1195,7 @@ ithread_create(...)
if (! thread) {
XSRETURN_UNDEF; /* Mutex already unlocked */
}
@ -823,7 +886,7 @@ index 4e9e31f..25fec16 100644
ST(0) = sv_2mortal(S_ithread_to_SV(aTHX_ Nullsv, thread, classname, FALSE));
/* Let thread run. */
@@ -1175,7 +1203,6 @@ ithread_create(...)
@@ -1175,7 +1204,6 @@ ithread_create(...)
/* warning: releasing mutex 'thread->mutex' that was not held [-Wthread-safety-analysis] */
MUTEX_UNLOCK(&thread->mutex);
CLANG_DIAG_RESTORE_STMT;
@ -831,7 +894,7 @@ index 4e9e31f..25fec16 100644
/* XSRETURN(1); - implied */
@@ -1197,7 +1224,7 @@ ithread_list(...)
@@ -1197,7 +1225,7 @@ ithread_list(...)
classname = (char *)SvPV_nolen(ST(0));
/* Calling context */
@ -840,7 +903,7 @@ index 4e9e31f..25fec16 100644
/* Running or joinable parameter */
if (items > 1) {
@@ -1335,7 +1362,7 @@ ithread_join(...)
@@ -1335,7 +1363,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) {
@ -849,7 +912,24 @@ index 4e9e31f..25fec16 100644
AV *params_copy;
PerlInterpreter *other_perl;
CLONE_PARAMS clone_params;
@@ -1722,9 +1749,9 @@ ithread_wantarray(...)
@@ -1562,11 +1590,15 @@ ithread_object(...)
}
classname = (char *)SvPV_nolen(ST(0));
+ if (items < 2) {
+ XSRETURN_UNDEF;
+ }
+
/* Turn $tid from PVLV to SV if needed (bug #73330) */
arg = ST(1);
SvGETMAGIC(arg);
- if ((items < 2) || ! SvOK(arg)) {
+ if (! SvOK(arg)) {
XSRETURN_UNDEF;
}
@@ -1722,9 +1754,9 @@ ithread_wantarray(...)
CODE:
PERL_UNUSED_VAR(items);
thread = S_SV_to_ithread(aTHX_ ST(0));
@ -862,7 +942,7 @@ index 4e9e31f..25fec16 100644
/* XSRETURN(1); - implied */
@@ -1762,7 +1789,7 @@ ithread_error(...)
@@ -1762,7 +1794,7 @@ ithread_error(...)
/* If thread died, then clone the error into the calling thread */
if (thread->state & PERL_ITHR_DIED) {
@ -872,5 +952,5 @@ index 4e9e31f..25fec16 100644
CLONE_PARAMS clone_params;
ithread *current_thread;
--
2.40.1
2.44.0