X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FScope-Upper.git;a=blobdiff_plain;f=t%2F79-uid-threads.t;h=817a144973440f8102f5161a2b7ef93d626ef28f;hp=4818c0351c3eff2b666cf622b6f512f36313685f;hb=ba6783aa6d08cd998143a4b4cb0d7516597dfc51;hpb=0f7334e9f0acbdac38c362be678bd6ecb658cb0b diff --git a/t/79-uid-threads.t b/t/79-uid-threads.t index 4818c03..817a144 100644 --- a/t/79-uid-threads.t +++ b/t/79-uid-threads.t @@ -1,48 +1,17 @@ -#!perl -T +#!perl 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 VPIT::TestHelpers ( + threads => [ 'Scope::Upper' => 'Scope::Upper::SU_THREADSAFE()' ], + 'usleep', +); -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; @@ -58,7 +27,7 @@ sub cb { is uid(UP), $top, "uid(UP) == \$top (in thread $tid)"; - usleep rand(1e6); + usleep rand(2.5e5); ok validate_uid($here), "\$here is valid (in thread $tid)"; ok !validate_uid($up), "\$up is no longer valid (in thread $tid)"; @@ -67,12 +36,17 @@ sub cb { } my %uids; - -for my $thread (map threads->create(\&cb), 1 .. $num) { +my $threads = 0; +for my $thread (map spawn(\&cb), 1 .. 30) { my $tid = $thread->tid; my $uid = $thread->join; - ++$uids{$uid}; - ok !validate_uid($uid), "\$here is no longer valid (out of thread $tid)"; + if (defined $uid) { + ++$threads; + ++$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;