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