From: Vincent Pit Date: Sat, 22 Oct 2011 16:55:36 +0000 (+0200) Subject: Threads tests may not be able to spawn all the threads X-Git-Tag: v0.19~15 X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FScope-Upper.git;a=commitdiff_plain;h=a26097967f907b721862e434af302d0bfb6b3e97 Threads tests may not be able to spawn all the threads To work around this : - move all the threads boilerplate to a new helper test module ; - capture the warnings/errors that threads->create may throw and reprint them properly as diagnostics ; - use Test::Leaner instead of Test::More, as older Test::More sometimes cause out of sequence bugs ; - last but not least, do not hardcode the plan and use done_testing with the actual number of spawned threads instead. --- diff --git a/MANIFEST b/MANIFEST index 79d90df..e3088a6 100644 --- a/MANIFEST +++ b/MANIFEST @@ -60,4 +60,5 @@ t/92-pod-coverage.t t/95-portability-files.t t/99-kwalitee.t t/lib/Scope/Upper/TestGenerator.pm +t/lib/Scope/Upper/TestThreads.pm t/lib/Test/Leaner.pm diff --git a/t/59-unwind-threads.t b/t/59-unwind-threads.t index 65ef827..5780fb0 100644 --- a/t/59-unwind-threads.t +++ b/t/59-unwind-threads.t @@ -3,46 +3,12 @@ use strict; use warnings; -sub skipall { - my ($msg) = @_; - require Test::More; - Test::More::plan(skip_all => $msg); -} - -use Config qw<%Config>; - -BEGIN { - my $force = $ENV{PERL_SCOPE_UPPER_TEST_THREADS} ? 1 : !1; - my $t_v = $force ? '0' : '1.67'; - skipall 'This perl wasn\'t built to support threads' - unless $Config{useithreads}; - skipall 'perl 5.13.4 required to test thread safety' - unless $force or "$]" >= 5.013004; - skipall "threads $t_v required to test thread safety" - unless eval "use threads $t_v; 1"; -} - -use Test::More; +use lib 't/lib'; +use Scope::Upper::TestThreads; -use Scope::Upper qw; +use Test::Leaner; -my $num; - -BEGIN { - skipall 'This Scope::Upper isn\'t thread safe' unless SU_THREADSAFE; - plan tests => ($num = 30); - defined and diag "Using threads $_" for $threads::VERSION; - if (eval "use Time::HiRes; 1") { - defined and diag "Using Time::HiRes $_" for $Time::HiRes::VERSION; - *usleep = \&Time::HiRes::usleep; - } else { - diag 'Using fallback usleep'; - *usleep = sub { - my $s = int($_[0] / 2.5e5); - sleep $s if $s; - }; - } -} +use Scope::Upper qw; our $z; @@ -71,4 +37,8 @@ sub up1 { is_deeply \@res, [ -1, $tid .. $tid + 2, -2 ], "$p: unwinded correctly"; } -$_->join for map threads->create(\&up1), 1 .. $num; +my @threads = map spawn(\&up1), 1 .. 30; + +$_->join for @threads; + +done_testing(scalar @threads); diff --git a/t/69-uplevel-threads.t b/t/69-uplevel-threads.t index 6ea386a..9af7b30 100644 --- a/t/69-uplevel-threads.t +++ b/t/69-uplevel-threads.t @@ -3,46 +3,12 @@ use strict; use warnings; -sub skipall { - my ($msg) = @_; - require Test::More; - Test::More::plan(skip_all => $msg); -} - -use Config qw<%Config>; - -BEGIN { - my $force = $ENV{PERL_SCOPE_UPPER_TEST_THREADS} ? 1 : !1; - my $t_v = $force ? '0' : '1.67'; - skipall 'This perl wasn\'t built to support threads' - unless $Config{useithreads}; - skipall 'perl 5.13.4 required to test thread safety' - unless $force or "$]" >= 5.013004; - skipall "threads $t_v required to test thread safety" - unless eval "use threads $t_v; 1"; -} - -use Test::More; +use lib 't/lib'; +use Scope::Upper::TestThreads; -use Scope::Upper qw; +use Test::Leaner; -my $num; - -BEGIN { - skipall 'This Scope::Upper isn\'t thread safe' unless SU_THREADSAFE; - plan tests => 3 + ($num = 30) * 3; - defined and diag "Using threads $_" for $threads::VERSION; - if (eval "use Time::HiRes; 1") { - defined and diag "Using Time::HiRes $_" for $Time::HiRes::VERSION; - *usleep = \&Time::HiRes::usleep; - } else { - diag 'Using fallback usleep'; - *usleep = sub { - my $s = int($_[0] / 2.5e5); - sleep $s if $s; - }; - } -} +use Scope::Upper qw; sub depth { my $depth = 0; @@ -95,4 +61,8 @@ sub up1 { is_deeply \@res, [ -2, -1, $tid .. $tid + 2, 1, 2 ], "$p: returns correctly"; } -$_->join for map threads->create(\&up1), 1 .. $num; +my @threads = map spawn(\&up1), 1 .. 30; + +$_->join for @threads; + +done_testing(3 + scalar(@threads) * 3); diff --git a/t/79-uid-threads.t b/t/79-uid-threads.t index 4818c03..6f2b06d 100644 --- a/t/79-uid-threads.t +++ b/t/79-uid-threads.t @@ -3,46 +3,12 @@ use strict; use warnings; -sub skipall { - my ($msg) = @_; - require Test::More; - Test::More::plan(skip_all => $msg); -} - -use Config qw<%Config>; - -BEGIN { - my $force = $ENV{PERL_SCOPE_UPPER_TEST_THREADS} ? 1 : !1; - my $t_v = $force ? '0' : '1.67'; - skipall 'This perl wasn\'t built to support threads' - unless $Config{useithreads}; - skipall 'perl 5.13.4 required to test thread safety' - unless $force or "$]" >= 5.013004; - skipall "threads $t_v required to test thread safety" - unless eval "use threads $t_v; 1"; -} - -use Test::More; +use lib 't/lib'; +use Scope::Upper::TestThreads; -use Scope::Upper qw; +use Test::Leaner; -my $num; - -BEGIN { - skipall 'This Scope::Upper isn\'t thread safe' unless SU_THREADSAFE; - plan tests => ($num = 30) * 5 + 1; - defined and diag "Using threads $_" for $threads::VERSION; - if (eval "use Time::HiRes; 1") { - defined and diag "Using Time::HiRes $_" for $Time::HiRes::VERSION; - *usleep = \&Time::HiRes::usleep; - } else { - diag 'Using fallback usleep'; - *usleep = sub { - my $s = int($_[0] / 2.5e5); - sleep $s if $s; - }; - } -} +use Scope::Upper qw; my $top = uid; @@ -67,12 +33,15 @@ sub cb { } my %uids; - -for my $thread (map threads->create(\&cb), 1 .. $num) { +my $threads = 0; +for my $thread (map threads->create(\&cb), 1 .. 30) { + ++$threads; my $tid = $thread->tid; my $uid = $thread->join; ++$uids{$uid}; ok !validate_uid($uid), "\$here is no longer valid (out of thread $tid)"; } -is scalar(keys %uids), $num, 'all the UIDs were different'; +is scalar(keys %uids), $threads, 'all the UIDs were different'; + +done_testing($threads * 5 + 1); diff --git a/t/lib/Scope/Upper/TestThreads.pm b/t/lib/Scope/Upper/TestThreads.pm new file mode 100644 index 0000000..eed76e7 --- /dev/null +++ b/t/lib/Scope/Upper/TestThreads.pm @@ -0,0 +1,84 @@ +package Scope::Upper::TestThreads; + +use strict; +use warnings; + +use Config qw<%Config>; + +use Scope::Upper qw; + +sub skipall { + my ($msg) = @_; + require Test::Leaner; + Test::Leaner::plan(skip_all => $msg); +} + +sub diag { + require Test::Leaner; + Test::Leaner::diag(@_); +} + +sub import { + shift; + + skipall 'This Scope::Upper isn\'t thread safe' unless SU_THREADSAFE; + + my $force = $ENV{PERL_SCOPE_UPPER_TEST_THREADS} ? 1 : !1; + skipall 'This perl wasn\'t built to support threads' + unless $Config{useithreads}; + skipall 'perl 5.13.4 required to test thread safety' + unless $force or "$]" >= 5.013004; + + my $t_v = $force ? '0' : '1.67'; + my $has_threads = do { + local $@; + eval "use threads $t_v; 1"; + }; + skipall "threads $t_v required to test thread safety" unless $has_threads; + + defined and diag "Using threads $_" for $threads::VERSION; + + my $has_time_hires = do { + local $@; + eval { require Time::HiRes; 1 }; + }; + + my %exports = ( + spawn => \&spawn, + ); + + my $usleep; + if ($has_time_hires) { + defined and diag "Using Time::HiRes $_" for $Time::HiRes::VERSION; + $exports{usleep} = \&Time::HiRes::usleep; + } else { + diag 'Using fallback usleep'; + $exports{usleep} = sub { + my $s = int($_[0] / 2.5e5); + sleep $s if $s; + }; + } + + my $pkg = caller; + while (my ($name, $code) = each %exports) { + no strict 'refs'; + *{$pkg.'::'.$name} = $code; + } +} + +sub spawn { + local $@; + my @diag; + my $thread = eval { + local $SIG{__WARN__} = sub { push @diag, "Thread creation warning: @_" }; + threads->create(@_); + }; + push @diag, "Thread creation error: $@" if $@; + if (@diag) { + require Test::Leaner; + Test::Leaner::diag($_) for @diag; + } + return $thread ? $thread : (); +} + +1;