ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/staticperl/perl/ext/Thread/sync2.tx
Revision: 1.1
Committed: Thu Jun 30 14:27:05 2005 UTC (21 years, 3 months ago) by root
Branch: MAIN
CVS Tags: PERL-5-8-7, HEAD
Branch point for: PERL
Log Message:
*** empty log message ***

File Contents

# User Rev Content
1 root 1.1 BEGIN {
2     eval { require Config; import Config };
3     if ($@) {
4     print "1..0 # Skip: no Config\n";
5     exit(0);
6     }
7     }
8    
9     use Thread;
10    
11     $global = undef;
12    
13     sub single_file : locked {
14     my $who = shift;
15     my $i;
16    
17     print "Uh oh: $who entered while locked by $global\n" if $global;
18     $global = $who;
19     print "[";
20     for ($i = 0; $i < int(10 * rand); $i++) {
21     print $who;
22     select(undef, undef, undef, 0.1);
23     }
24     print "]";
25     $global = undef;
26     }
27    
28     sub start_a {
29     my ($i, $j);
30     for ($j = 0; $j < 10; $j++) {
31     single_file("A");
32     for ($i = 0; $i < int(10 * rand); $i++) {
33     print "a";
34     select(undef, undef, undef, 0.1);
35     }
36     }
37     }
38    
39     sub start_b {
40     my ($i, $j);
41     for ($j = 0; $j < 10; $j++) {
42     single_file("B");
43     for ($i = 0; $i < int(10 * rand); $i++) {
44     print "b";
45     select(undef, undef, undef, 0.1);
46     }
47     }
48     }
49    
50     sub start_c {
51     my ($i, $j);
52     for ($j = 0; $j < 10; $j++) {
53     single_file("C");
54     for ($i = 0; $i < int(10 * rand); $i++) {
55     print "c";
56     select(undef, undef, undef, 0.1);
57     }
58     }
59     }
60    
61     $| = 1;
62     srand($$^$^T);
63    
64     print <<'EOT';
65     Each pair of square brackets [...] should contain a repeated sequence of
66     a unique upper case letter. Lower case letters may appear randomly both
67     in and out of the brackets.
68     EOT
69     $foo = new Thread \&start_a;
70     $bar = new Thread \&start_b;
71     $baz = new Thread \&start_c;
72     print "\nmain: joining...\n";
73     #$foo->join;
74     #$bar->join;
75     #$baz->join;
76     print "\ndone\n";