ext/Thread/sync2.tx

   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";