X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=t%2F40-threads.t;h=2482e61f6dd0fea1f11111a6cdb10ece9af1dfa3;hb=54a1b1e4382ad55a54cbd874d6ffd87bf58dffbc;hp=2215c592aaa3a72e739e4f1f11d08d3ac573ca4c;hpb=4bd887f284d695d973ce89a5f40e6528561b2d6d;p=perl%2Fmodules%2FVariable-Magic.git diff --git a/t/40-threads.t b/t/40-threads.t index 2215c59..2482e61 100644 --- a/t/40-threads.t +++ b/t/40-threads.t @@ -9,7 +9,7 @@ BEGIN { if (!$Config{useithreads}) { require Test::More; Test::More->import; - plan(skip_all => 'This Perl wasn\'t built to support threads'); + plan(skip_all => 'This perl wasn\'t built to support threads'); } } @@ -21,20 +21,27 @@ use Test::More; use Variable::Magic qw/wizard cast dispell getdata VMG_THREADSAFE/; if (VMG_THREADSAFE) { - plan tests => 2 * 16 + 1; + plan tests => 2 * (2 * 16 + 1) + 2 * (2 * 11 + 1); + my $v = $threads::VERSION; + diag "Using threads $v" if defined $v; + $v = $threads::shared::VERSION; + diag "Using threads::shared $v" if defined $v; } else { plan skip_all => 'This Variable::Magic isn\'t thread safe'; } my $destroyed : shared = 0; +my $sig = undef; sub try { + my ($dispell) = @_; my $tid = threads->tid(); my $c = 0; my $wiz = eval { wizard get => sub { ++$c }, data => sub { $_[1] + $tid }, - free => sub { ++$destroyed }; + free => sub { ++$destroyed }, + sig => $sig; }; is($@, '', "wizard in thread $tid doesn't croak"); isnt($wiz, undef, "wizard in thread $tid is defined"); @@ -52,19 +59,35 @@ sub try { is($@, '', "getdata in thread $tid doesn't croak"); is($d, 5 + $tid, "getdata in thread $tid returns the right thing"); is($c, 1, "getdata in thread $tid doesn't trigger magic"); - $res = eval { dispell $a, $wiz }; - is($@, '', "dispell in thread $tid doesn't croak"); - is($c, 1, "dispell in thread $tid doesn't trigger magic"); - undef $b; - eval { $b = $a }; - is($@, '', "get in thread $tid after dispell doesn't croak"); - is($b, 3, "get in thread $tid after dispell returns the right thing"); - is($c, 1, "get in thread $tid after dispell doesn't trigger magic"); - return; + if ($dispell) { + $res = eval { dispell $a, $wiz }; + is($@, '', "dispell in thread $tid doesn't croak"); + is($c, 1, "dispell in thread $tid doesn't trigger magic"); + undef $b; + eval { $b = $a }; + is($@, '', "get in thread $tid after dispell doesn't croak"); + is($b, 3, "get in thread $tid after dispell returns the right thing"); + is($c, 1, "get in thread $tid after dispell doesn't trigger magic"); + } + return; # Ugly if not here } -my @t = map { threads->create(\&try) } 1 .. 2; -$t[0]->join; -$t[1]->join; +for my $dispell (1, 0) { + $destroyed = 0; + $sig = undef; + + my @t = map { threads->create(\&try, $dispell) } 1 .. 2; + $t[0]->join; + $t[1]->join; + + is($destroyed, (1 - $dispell) * 2, 'destructors'); -is($destroyed, 0, 'destructors didn\'t fired'); + $destroyed = 0; + $sig = Variable::Magic::gensig(); + + @t = map { threads->create(\&try, $dispell) } 1 .. 2; + $t[0]->join; + $t[1]->join; + + is($destroyed, (1 - $dispell) * 2, 'destructors'); +}