contrib/perl5/ext/Thread/sync2.t

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