rpms/perl-threads
7
0
Fork 0
Code Issues Pull Requests Releases Activity

Upgrade to 2.27 as provided in perl-5.35.11

Browse Source
This commit is contained in:
Jitka Plesnikova 2022-05-30 13:59:58 +02:00
parent 5ef1749a6a
commit 31b730290b
2 changed files with 417 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
perl-threads.spec
View File

@ -1,8 +1,8 @@
%global base_version 2.21
Name: perl-threads
Epoch: 1
Version: 2.26
Release: 449%{?dist}
Version: 2.27
Release: 488%{?dist}
Summary: Perl interpreter-based threads
License: GPL+ or Artistic
URL: https://metacpan.org/release/threads
@ -13,6 +13,8 @@ Patch0: threads-2.21-Upgrade-to-2.22.patch
Patch1: threads-2.21-Upgrade-to-2.25.patch
# Unbundled from perl 5.34.0
Patch2: threads-2.25-Upgrade-to-2.26.patch
# Unbundled from perl 5.35.11
Patch3: threads-2.26-Upgrade-to-2.27.patch
BuildRequires: coreutils
BuildRequires: findutils
BuildRequires: gcc
@ -39,6 +41,7 @@ BuildRequires: perl(IO::File)
BuildRequires: perl(POSIX)
BuildRequires: perl(Test::More)
# Optional tests:
BuildRequires: procps-ng
BuildRequires: perl(Thread::Queue)
BuildRequires: perl(Thread::Semaphore)
BuildRequires: perl(threads::shared)
@ -61,6 +64,7 @@ This threading model has been deprecated, and was removed as of Perl 5.10.0.)
%patch0 -p1
%patch1 -p1
%patch2 -p1
%patch3 -p1
chmod -x examples/*
%build
@ -84,6 +88,9 @@ make test
%{_mandir}/man3/*
%changelog
* Mon May 30 2022 Jitka Plesnikova <jplesnik@redhat.com> - 1:2.27-488
- Upgrade to 2.27 as provided in perl-5.35.11
* Fri Jan 21 2022 Fedora Release Engineering <releng@fedoraproject.org> - 1:2.26-449
- Rebuilt for https://fedoraproject.org/wiki/Fedora_36_Mass_Rebuild

408
threads-2.26-Upgrade-to-2.27.patch Normal file
View File

@ -0,0 +1,408 @@
From 810489fa2cb3fb23580353ddf79916b3e209a88f Mon Sep 17 00:00:00 2001
From: Jitka Plesnikova <jplesnik@redhat.com>
Date: Thu, 12 May 2022 14:19:33 +0200
Subject: [PATCH] Upgrade to 2.27
---
lib/threads.pm | 4 +--
t/pod.t | 87 --------------------------------------------------
t/stack.t | 82 ++++++++++++++++++++++++++++++++++-------------
t/stack_env.t | 46 +++++++++++++++++++++++---
threads.xs | 16 +++++-----
5 files changed, 111 insertions(+), 124 deletions(-)
delete mode 100644 t/pod.t
diff --git a/lib/threads.pm b/lib/threads.pm
index 4453a8d..f84a294 100644
--- a/lib/threads.pm
+++ b/lib/threads.pm
@@ -5,7 +5,7 @@ use 5.008;
use strict;
use warnings;
-our $VERSION = '2.26'; # remember to update version in POD!
+our $VERSION = '2.27'; # remember to update version in POD!
my $XS_VERSION = $VERSION;
$VERSION = eval $VERSION;
@@ -134,7 +134,7 @@ threads - Perl interpreter-based threads
=head1 VERSION
-This document describes threads version 2.26
+This document describes threads version 2.27
=head1 WARNING
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/threads.xs b/threads.xs
index e544eba..9c8072d 100644
--- a/threads.xs
+++ b/threads.xs
@@ -1115,7 +1115,7 @@ ithread_create(...)
case 'A':
case 'l':
case 'L':
- context = G_ARRAY;
+ context = G_LIST;
break;
case 's':
case 'S':
@@ -1130,11 +1130,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)) {
@@ -1156,7 +1156,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 */
@@ -1201,7 +1201,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) {
@@ -1726,9 +1726,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 */
--
2.34.3