]> git.vpit.fr Git - perl/modules/Scope-Upper.git/blob - t/79-uid-threads.t
Threads tests may not be able to spawn all the threads
[perl/modules/Scope-Upper.git] / t / 79-uid-threads.t
1 #!perl -T
2
3 use strict;
4 use warnings;
5
6 use lib 't/lib';
7 use Scope::Upper::TestThreads;
8
9 use Test::Leaner;
10
11 use Scope::Upper qw<uid validate_uid UP HERE>;
12
13 my $top = uid;
14
15 sub cb {
16  my $tid  = threads->tid();
17
18  my $here = uid;
19  my $up;
20  {
21   $up = uid HERE;
22   is uid(UP), $here, "uid(UP) == \$here in block (in thread $tid)";
23  }
24
25  is uid(UP), $top, "uid(UP) == \$top (in thread $tid)";
26
27  usleep rand(1e6);
28
29  ok validate_uid($here), "\$here is valid (in thread $tid)";
30  ok !validate_uid($up),  "\$up is no longer valid (in thread $tid)";
31
32  return $here;
33 }
34
35 my %uids;
36 my $threads = 0;
37 for my $thread (map threads->create(\&cb), 1 .. 30) {
38  ++$threads;
39  my $tid = $thread->tid;
40  my $uid = $thread->join;
41  ++$uids{$uid};
42  ok !validate_uid($uid), "\$here is no longer valid (out of thread $tid)";
43 }
44
45 is scalar(keys %uids), $threads, 'all the UIDs were different';
46
47 done_testing($threads * 5 + 1);