X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2Findirect.git;a=blobdiff_plain;f=t%2F40-threads.t;h=3f2fe250dd9bd88e4253720d83096263c10513c4;hp=14fb8b25e878b13cfbc87856cac240e524882dd4;hb=b9dca634c59b11dc31a3d2eca413152ac7c92791;hpb=0df47659c67c30deca9fc06d6c7643a886ddb7d8 diff --git a/t/40-threads.t b/t/40-threads.t index 14fb8b2..3f2fe25 100644 --- a/t/40-threads.t +++ b/t/40-threads.t @@ -3,33 +3,14 @@ use strict; use warnings; -use Config qw/%Config/; +use lib 't/lib'; +use indirect::TestThreads; -BEGIN { - if (!$Config{useithreads}) { - require Test::More; - Test::More->import; - plan(skip_all => 'This perl wasn\'t built to support threads'); - } -} - -use threads; - -use Test::More; - -BEGIN { - require indirect; - if (indirect::I_THREADSAFE()) { - plan tests => 10 * 2 * (2 + 3); - defined and diag "Using threads $_" for $threads::VERSION; - } else { - plan skip_all => 'This indirect isn\'t thread safe'; - } -} +use Test::Leaner; sub expect { my ($pkg) = @_; - return qr/^Indirect\s+call\s+of\s+method\s+"new"\s+on\s+object\s+"$pkg"/; + qr/^Indirect call of method "new" on object "$pkg" at \(eval \d+\) line \d+/; } { @@ -43,7 +24,7 @@ sub expect { my $class = "Coconut$tid"; my @warns; { - local $SIG{__WARN__} = sub { push @warns, "@_" }; + local $SIG{__WARN__} = sub { push @warns, @_ }; eval 'die "the code compiled but it shouldn\'t have\n"; no indirect ":fatal"; my $x = new ' . $class . ' 1, 2;'; } @@ -56,14 +37,15 @@ sub expect { SKIP: { skip 'Hints aren\'t propagated into eval STRING below perl 5.10' => 3 - unless $] >= 5.010; + unless "$]" >= 5.010; my $class = "Pineapple$tid"; my @warns; { - local $SIG{__WARN__} = sub { push @warns, "@_" }; - eval 'die "ok\n"; my $y = new ' . $class . ' 1, 2;'; + local $SIG{__WARN__} = sub { push @warns, @_ }; + eval 'return; my $y = new ' . $class . ' 1, 2;'; } - is $@, "ok\n", + is $@, '', + "\"no indirect\" propagated into eval in thread $tid didn't croak"; my $first = shift @warns; like $first || '', expect($class), "\"no indirect\" propagated into eval in thread $tid warned once"; @@ -74,5 +56,10 @@ SKIP: } } -my @t = map threads->create(\&try), 1 .. 10; -$_->join for @t; +my @threads = map spawn(\&try), 1 .. 10; + +$_->join for @threads; + +pass 'done'; + +done_testing(scalar(@threads) * 2 * (2 + 3) + 1);