From: Vincent Pit Date: Mon, 24 Oct 2011 19:57:55 +0000 (+0200) Subject: Threads tests may not be able to spawn all the threads X-Git-Tag: v0.47~19 X-Git-Url: http://git.vpit.fr/?a=commitdiff_plain;h=dee682e232db910b1e38e162ac51b0d98725e40e;p=perl%2Fmodules%2FVariable-Magic.git 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 ; - don't set a plan in threads tests. --- diff --git a/MANIFEST b/MANIFEST index 86c0de2..894b32b 100644 --- a/MANIFEST +++ b/MANIFEST @@ -45,5 +45,6 @@ t/95-portability-files.t t/99-kwalitee.t t/lib/Variable/Magic/TestDestroyRequired.pm t/lib/Variable/Magic/TestScopeEnd.pm +t/lib/Variable/Magic/TestThreads.pm t/lib/Variable/Magic/TestValue.pm t/lib/Variable/Magic/TestWatcher.pm diff --git a/t/40-threads.t b/t/40-threads.t index f67dfc3..3b850e3 100644 --- a/t/40-threads.t +++ b/t/40-threads.t @@ -3,42 +3,16 @@ 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_VARIABLE_MAGIC_TEST_THREADS} ? 1 : !1; - my $t_v = $force ? '0' : '1.67'; - my $ts_v = $force ? '0' : '1.14'; - 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"; - skipall "threads::shared $ts_v required to test thread safety" - unless eval "use threads::shared $ts_v; 1"; -} +use lib 't/lib'; +use Variable::Magic::TestThreads; -use Test::More; # after threads +use Test::More 'no_plan'; use Variable::Magic qw< wizard cast dispell getdata - VMG_THREADSAFE VMG_OP_INFO_NAME VMG_OP_INFO_OBJECT + VMG_OP_INFO_NAME VMG_OP_INFO_OBJECT >; -BEGIN { - skipall 'This Variable::Magic isn\'t thread safe' unless VMG_THREADSAFE; - plan tests => (4 * 18 + 1) + (4 * 13 + 1); - defined and diag "Using threads $_" for $threads::VERSION; - defined and diag "Using threads::shared $_" for $threads::shared::VERSION; -} - my $destroyed : shared = 0; sub try { @@ -99,9 +73,9 @@ for my $dispell (1, 0) { $destroyed = 0; } - my @t = map { threads->create(\&try, $dispell, $_) } + my @threads = map spawn(\&try, $dispell, $_), (VMG_OP_INFO_NAME) x 2, (VMG_OP_INFO_OBJECT) x 2; - $_->join for @t; + $_->join for @threads; { lock $destroyed; diff --git a/t/41-clone.t b/t/41-clone.t index d0f9bfe..0e47d36 100644 --- a/t/41-clone.t +++ b/t/41-clone.t @@ -3,42 +3,16 @@ 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_VARIABLE_MAGIC_TEST_THREADS} ? 1 : !1; - my $t_v = $force ? '0' : '1.67'; - my $ts_v = $force ? '0' : '1.14'; - 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"; - skipall "threads::shared $ts_v required to test thread safety" - unless eval "use threads::shared $ts_v; 1"; -} +use lib 't/lib'; +use Variable::Magic::TestThreads; -use Test::More; # after threads +use Test::More 'no_plan'; use Variable::Magic qw< wizard cast dispell getdata - VMG_THREADSAFE VMG_OP_INFO_NAME VMG_OP_INFO_OBJECT + VMG_OP_INFO_NAME VMG_OP_INFO_OBJECT >; -BEGIN { - skipall 'This Variable::Magic isn\'t thread safe' unless VMG_THREADSAFE; - plan tests => 2 * 3 + 2 * (2 * 10 + 2) + 2 * (2 * 7 + 2); - defined and diag "Using threads $_" for $threads::VERSION; - defined and diag "Using threads::shared $_" for $threads::shared::VERSION; -} - my $destroyed : shared = 0; my $c : shared = 0; @@ -110,8 +84,8 @@ for my $dispell (1, 0) { $destroyed = 0; } - my @t = map { threads->create(\&try, $dispell, $wiz) } 1 .. 2; - $_->join for @t; + my @threads = map spawn(\&try, $dispell, $wiz), 1 .. 2; + $_->join for @threads; { lock $c; diff --git a/t/lib/Variable/Magic/TestThreads.pm b/t/lib/Variable/Magic/TestThreads.pm new file mode 100644 index 0000000..a846a5a --- /dev/null +++ b/t/lib/Variable/Magic/TestThreads.pm @@ -0,0 +1,76 @@ +package Variable::Magic::TestThreads; + +use strict; +use warnings; + +use Config qw<%Config>; + +use Variable::Magic qw; + +sub skipall { + my ($msg) = @_; + require Test::More; + Test::More::plan(skip_all => $msg); +} + +sub diag { + require Test::More; + Test::More::diag(@_); +} + +sub import { + shift; + + skipall 'This Variable::Magic isn\'t thread safe' unless VMG_THREADSAFE; + + my $force = $ENV{PERL_VARIABLE_MAGIC_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; + + my $ts_v = $force ? '0' : '1.14'; + my $has_threads_shared = do { + local $@; + eval "use threads::shared $ts_v; 1"; + }; + skipall "threads::shared $ts_v required to test thread safety" + unless $has_threads_shared; + + defined and diag "Using threads $_" for $threads::VERSION; + defined and diag "Using threads::shared $_" for $threads::shared::VERSION; + + my %exports = ( + spawn => \&spawn, + ); + + 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::More; + Test::More::diag($_) for @diag; + } + return $thread ? $thread : (); +} + +1;