diff --git a/perl-threads.spec b/perl-threads.spec index 9af3083..72796f6 100644 --- a/perl-threads.spec +++ b/perl-threads.spec @@ -1,20 +1,14 @@ %global base_version 2.21 Name: perl-threads Epoch: 1 -Version: 2.27 -Release: 490%{?dist} +Version: 2.36 +Release: 499%{?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.28.0 -Patch0: threads-2.21-Upgrade-to-2.22.patch -# Unbundled from perl 5.32.0 -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 +# Unbundled from perl 5.37.11 +Patch0: threads-2.21-Upgrade-to-2.36.patch BuildRequires: coreutils BuildRequires: findutils BuildRequires: gcc @@ -34,11 +28,11 @@ BuildRequires: perl(XSLoader) # Tests only: BuildRequires: perl(blib) BuildRequires: perl(Cwd) +BuildRequires: perl(Data::Dumper) BuildRequires: perl(ExtUtils::testlib) BuildRequires: perl(File::Path) BuildRequires: perl(Hash::Util) BuildRequires: perl(IO::File) -BuildRequires: perl(POSIX) BuildRequires: perl(Test::More) # Optional tests: BuildRequires: procps-ng @@ -60,20 +54,17 @@ This threading model has been deprecated, and was removed as of Perl 5.10.0.) %prep %setup -q -n threads-%{base_version} -%patch0 -p1 -%patch1 -p1 -%patch2 -p1 -%patch3 -p1 +%patch -P0 -p1 chmod -x examples/* %build -perl Makefile.PL INSTALLDIRS=vendor NO_PACKLIST=1 NO_PERLLOCAL=1 OPTIMIZE="$RPM_OPT_FLAGS" +perl Makefile.PL INSTALLDIRS=vendor NO_PACKLIST=1 NO_PERLLOCAL=1 OPTIMIZE="%{optflags}" %{make_build} %install %{make_install} -find $RPM_BUILD_ROOT -type f -name '*.bs' -size 0 -delete -%{_fixperms} $RPM_BUILD_ROOT/* +find %{buildroot} -type f -name '*.bs' -size 0 -delete +%{_fixperms} %{buildroot}/* %check unset GIT_DIR PERL_BUILD_PACKAGING PERL_CORE PERL_RUNPERL_DEBUG \ @@ -87,6 +78,9 @@ make test %{_mandir}/man3/* %changelog +* Thu May 18 2023 Jitka Plesnikova - 1:2.36-499 +- Upgrade to 2.36 as provided in perl-5.37.11 + * Fri Jan 20 2023 Fedora Release Engineering - 1:2.27-490 - Rebuilt for https://fedoraproject.org/wiki/Fedora_38_Mass_Rebuild diff --git a/threads-2.21-Upgrade-to-2.22.patch b/threads-2.21-Upgrade-to-2.22.patch deleted file mode 100644 index bc0e53a..0000000 --- a/threads-2.21-Upgrade-to-2.22.patch +++ /dev/null @@ -1,82 +0,0 @@ -From a0eaa97e59b5b2ad8e2a83f8509da3787ff4b4bf Mon Sep 17 00:00:00 2001 -From: Jitka Plesnikova -Date: Thu, 24 May 2018 11:32:01 +0200 -Subject: [PATCH] Upgrade to 2.22 - ---- - lib/threads.pm | 29 ++++++++++++++++++++++++++++- - threads.xs | 4 ++++ - 2 files changed, 32 insertions(+), 1 deletion(-) - -diff --git a/lib/threads.pm b/lib/threads.pm -index 2eb926a..1b99567 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.22'; # remember to update version in POD! - my $XS_VERSION = $VERSION; - $VERSION = eval $VERSION; - -@@ -937,6 +937,33 @@ C) 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. -+ -+Each thread (except the main thread) is started using the C locale. The main -+thread is started like all other Perl programs; see L. -+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 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 calls (e.g., using -diff --git a/threads.xs b/threads.xs -index 4e9e31f..3da9165 100644 ---- a/threads.xs -+++ b/threads.xs -@@ -580,6 +580,8 @@ S_ithread_run(void * arg) - S_set_sigmask(&thread->initial_sigmask); - #endif - -+ thread_locale_init(); -+ - PL_perl_destruct_level = 2; - - { -@@ -665,6 +667,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); --- -2.14.3 - diff --git a/threads-2.21-Upgrade-to-2.25.patch b/threads-2.21-Upgrade-to-2.25.patch deleted file mode 100644 index 02ac54e..0000000 --- a/threads-2.21-Upgrade-to-2.25.patch +++ /dev/null @@ -1,103 +0,0 @@ -From 0bb2d0b00e011f1d77d1766fac4777c6bc376af7 Mon Sep 17 00:00:00 2001 -From: Jitka Plesnikova -Date: Mon, 1 Jun 2020 13:23:16 +0200 -Subject: [PATCH] Upgrade to 2.25 - ---- - lib/threads.pm | 22 +++++++++++----------- - threads.xs | 2 +- - 2 files changed, 12 insertions(+), 12 deletions(-) - -diff --git a/lib/threads.pm b/lib/threads.pm -index 1b99567..ee201a2 100644 ---- a/lib/threads.pm -+++ b/lib/threads.pm -@@ -5,7 +5,7 @@ use 5.008; - use strict; - use warnings; - --our $VERSION = '2.22'; # remember to update version in POD! -+our $VERSION = '2.25'; # 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.25 - - =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<-Eimport()>) 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 against the problematic module. -+a bug report on L against the problematic module. - - =item Memory consumption - -@@ -1090,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 - -@@ -1118,8 +1118,8 @@ unreferenced scalars. However, such warnings are harmless, and may safely be - ignored. - - You can search for L related bug reports at --L. If needed submit any new bugs, problems, --patches, etc. to: L -+L. If needed submit any new bugs, problems, -+patches, etc. to: L - - =back - -@@ -1137,14 +1137,14 @@ L - - L, L - --L and --L -+L and -+L - - Perl threads mailing list: --L -+L - - Stack size discussion: --L -+L - - Sample code in the I directory of this distribution on CPAN. - -diff --git a/threads.xs b/threads.xs -index 3da9165..ab64dc0 100644 ---- a/threads.xs -+++ b/threads.xs -@@ -676,7 +676,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; --- -2.25.4 - diff --git a/threads-2.21-Upgrade-to-2.36.patch b/threads-2.21-Upgrade-to-2.36.patch new file mode 100644 index 0000000..ec59b31 --- /dev/null +++ b/threads-2.21-Upgrade-to-2.36.patch @@ -0,0 +1,876 @@ +From 4b88fd5215fcd370de11c1bb448229e8f6643b27 Mon Sep 17 00:00:00 2001 +From: Jitka Plesnikova +Date: Fri, 19 May 2023 08:55:51 +0200 +Subject: [PATCH] Upgrade to 2.36 + +--- + 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 + 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 +--- 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<-Eimport()>) 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 against the problematic module. ++a bug report on L against the problematic module. + + =item Memory consumption + +@@ -937,6 +937,33 @@ C) 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. ++ ++Each thread (except the main thread) is started using the C locale. The main ++thread is started like all other Perl programs; see L. ++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 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 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 (see C). ++=item * Perl has been built with C (see S>). + + =item * The environment variable C is set to C + (see L). +@@ -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 related bug reports at +-L. If needed submit any new bugs, problems, +-patches, etc. to: L ++L. If needed submit any new bugs, problems, ++patches, etc. to: L + + =back + +@@ -1110,14 +1137,14 @@ L + + L, L + +-L and +-L ++L and ++L + + Perl threads mailing list: +-L ++L + + Stack size discussion: +-L ++L + + Sample code in the I 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(); +- 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 + # 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.40.1 + diff --git a/threads-2.25-Upgrade-to-2.26.patch b/threads-2.25-Upgrade-to-2.26.patch deleted file mode 100644 index 142dea2..0000000 --- a/threads-2.25-Upgrade-to-2.26.patch +++ /dev/null @@ -1,134 +0,0 @@ -From 9334f9fbc3fe291eb1791ff7f2bf93b9e713d4b0 Mon Sep 17 00:00:00 2001 -From: Jitka Plesnikova -Date: Thu, 6 May 2021 10:02:15 +0200 -Subject: [PATCH] Upgrade to 2.26 - ---- - lib/threads.pm | 4 ++-- - t/libc.t | 6 ++++++ - threads.xs | 18 +++++++++--------- - 3 files changed, 17 insertions(+), 11 deletions(-) - -diff --git a/lib/threads.pm b/lib/threads.pm -index ee201a2..4453a8d 100644 ---- a/lib/threads.pm -+++ b/lib/threads.pm -@@ -5,7 +5,7 @@ use 5.008; - use strict; - use warnings; - --our $VERSION = '2.25'; # remember to update version in POD! -+our $VERSION = '2.26'; # 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.25 -+This document describes threads version 2.26 - - =head1 WARNING - -diff --git a/t/libc.t b/t/libc.t -index 4f6f6ed..6595894 100644 ---- a/t/libc.t -+++ b/t/libc.t -@@ -9,6 +9,12 @@ BEGIN { - skip_all(q/Perl not compiled with 'useithreads'/); - } - -+ my $time_out_factor = $ENV{PERL_TEST_TIME_OUT_FACTOR} || 1; -+ $time_out_factor = 1 if $time_out_factor < 1; -+ -+ # Guard against bugs that result in deadlock -+ watchdog(1 * 60 * $time_out_factor); -+ - plan(11); - } - -diff --git a/threads.xs b/threads.xs -index ab64dc0..e544eba 100644 ---- a/threads.xs -+++ b/threads.xs -@@ -421,7 +421,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 - }; -@@ -751,7 +751,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 -@@ -849,7 +849,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; -@@ -859,7 +859,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 - -@@ -886,7 +886,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 *); -@@ -897,11 +897,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. -@@ -1339,7 +1339,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; -@@ -1766,7 +1766,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.30.2 - diff --git a/threads-2.26-Upgrade-to-2.27.patch b/threads-2.26-Upgrade-to-2.27.patch deleted file mode 100644 index 6ca5d35..0000000 --- a/threads-2.26-Upgrade-to-2.27.patch +++ /dev/null @@ -1,408 +0,0 @@ -From 810489fa2cb3fb23580353ddf79916b3e209a88f Mon Sep 17 00:00:00 2001 -From: Jitka Plesnikova -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(); -- 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 -