X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=t%2F41-clone.t;h=1bfe6b5b3f5f53add4816fbf4aae2a131e6b936e;hb=75e0226fc114601c5e10d253d55e94e201249151;hp=30d300bb521e3491786125b02da5d6d2af1f5d53;hpb=8e2184e72b9ec7b9d7bddd4bf5be516f2b561db9;p=perl%2Fmodules%2FVariable-Magic.git diff --git a/t/41-clone.t b/t/41-clone.t index 30d300b..1bfe6b5 100644 --- a/t/41-clone.t +++ b/t/41-clone.t @@ -3,38 +3,15 @@ use strict; use warnings; -sub skipall { - my ($msg) = @_; - require Test::More; - Test::More::plan(skip_all => $msg); -} - -use Config qw/%Config/; - -BEGIN { - my $t_v = '1.67'; - my $ts_v = '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 $] >= 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/; - -BEGIN { - skipall 'This Variable::Magic isn\'t thread safe' unless VMG_THREADSAFE; - plan tests => 2 * 3 + 2 * (2 * 10 + 2) + 2 * (2 * 7 + 2); - my $v = $threads::VERSION; - diag "Using threads $v" if defined $v; - $v = $threads::shared::VERSION; - diag "Using threads::shared $v" if defined $v; -} +use Variable::Magic qw< + wizard cast dispell getdata + VMG_OP_INFO_NAME VMG_OP_INFO_OBJECT +>; my $destroyed : shared = 0; my $c : shared = 0; @@ -107,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; @@ -120,3 +97,45 @@ for my $dispell (1, 0) { } } } + +{ + my @threads; + my $flag : shared = 0; + my $destroyed; + + { + my $wiz = wizard( + set => sub { + my $tid = threads->tid; + pass "set callback called in thread $tid" + }, + free => sub { ++$destroyed }, + ); + + my $var = 123; + cast $var, $wiz; + + @threads = map spawn( + sub { + my $tid = threads->tid; + my $exp = 456 + $tid; + { + lock $flag; + threads::shared::cond_wait($flag) until $flag; + } + $var = $exp; + is $var, $exp, "\$var could be assigned to in thread $tid"; + } + ), 1 .. 5; + } + + is $destroyed, 1, 'wizard is destroyed'; + + { + lock $flag; + $flag = 1; + threads::shared::cond_broadcast($flag); + } + + $_->join for @threads; +}