This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Add socklen_t probe; Configure maintenance.
[perl5.git] / ext / Thread / sync2.t
1 use Thread;
2
3 $global = undef;
4
5 sub single_file : locked {
6     my $who = shift;
7     my $i;
8
9     print "Uh oh: $who entered while locked by $global\n" if $global;
10     $global = $who;
11     print "[";
12     for ($i = 0; $i < int(10 * rand); $i++) {
13         print $who;
14         select(undef, undef, undef, 0.1);
15     }
16     print "]";
17     $global = undef;
18 }
19
20 sub start_a {
21     my ($i, $j);
22     for ($j = 0; $j < 10; $j++) {
23         single_file("A");
24         for ($i = 0; $i < int(10 * rand); $i++) {
25             print "a";
26             select(undef, undef, undef, 0.1);
27         }
28     }
29 }
30
31 sub start_b {
32     my ($i, $j);
33     for ($j = 0; $j < 10; $j++) {
34         single_file("B");
35         for ($i = 0; $i < int(10 * rand); $i++) {
36             print "b";
37             select(undef, undef, undef, 0.1);
38         }
39     }
40 }
41
42 sub start_c {
43     my ($i, $j);
44     for ($j = 0; $j < 10; $j++) {
45         single_file("C");
46         for ($i = 0; $i < int(10 * rand); $i++) {
47             print "c";
48             select(undef, undef, undef, 0.1);
49         }
50     }
51 }
52
53 $| = 1;
54 srand($$^$^T);
55
56 print <<'EOT';
57 Each pair of square brackets [...] should contain a repeated sequence of
58 a unique upper case letter. Lower case letters may appear randomly both
59 in and out of the brackets.
60 EOT
61 $foo = new Thread \&start_a;
62 $bar = new Thread \&start_b;
63 $baz = new Thread \&start_c;
64 print "\nmain: joining...\n";
65 #$foo->join;
66 #$bar->join;
67 #$baz->join;
68 print "\ndone\n";