ext/threads/t/free.t

   1 use strict;
   2 use warnings;
   3
   4 BEGIN {
   5     if ($ENV{'PERL_CORE'}){
   6         chdir 't';
   7         unshift @INC, '../lib';
   8     }
   9     use Config;
  10     if (! $Config{'useithreads'}) {
  11         print("1..0 # Skip: Perl not compiled with 'useithreads'\n");
  12         exit(0);
  13     }
  14 }
  15
  16 use ExtUtils::testlib;
  17
  18 sub ok {
  19     my ($id, $ok, $name) = @_;
  20
  21     # You have to do it this way or VMS will get confused.
  22     if ($ok) {
  23         print("ok $id - $name\n");
  24     } else {
  25         print("not ok $id - $name\n");
  26         printf("# Failed test at line %d\n", (caller)[2]);
  27     }
  28
  29     return ($ok);
  30 }
  31
  32 BEGIN {
  33     $| = 1;
  34     print("1..29\n");   ### Number of tests that will be run ###
  35 };
  36
  37 use threads;
  38 use threads::shared;
  39 ok(1, 1, 'Loaded');
  40
  41 ### Start of Testing ###
  42
  43 # Tests freeing the Perl interperter for each thread
  44 # See http://www.nntp.perl.org/group/perl.perl5.porters/110772 for details
  45
  46 my $COUNT;
  47 share($COUNT);
  48 my $TEST = 2;
  49 share($TEST);
  50
  51 sub threading_1 {
  52     my $tid = threads->tid();
  53     ok($TEST++, $tid, "Thread $tid started");
  54
  55     if ($tid < 5) {
  56         sleep(1);
  57         threads->create('threading_1')->detach();
  58     }
  59
  60     threads->yield();
  61
  62     if ($tid == 1) {
  63         sleep(2);
  64     } elsif ($tid == 2) {
  65         sleep(6);
  66     } elsif ($tid == 3) {
  67         sleep(3);
  68     } elsif ($tid == 4) {
  69         sleep(1);
  70     } else {
  71         sleep(2);
  72     }
  73
  74     lock($COUNT);
  75     $COUNT++;
  76     cond_signal($COUNT);
  77     ok($TEST++, $tid, "Thread $tid done");
  78 }
  79
  80 {
  81     $COUNT = 0;
  82     threads->create('threading_1')->detach();
  83     {
  84         lock($COUNT);
  85         while ($COUNT < 3) {
  86             cond_wait($COUNT);
  87         }
  88     }
  89 }
  90 {
  91     {
  92         lock($COUNT);
  93         while ($COUNT < 5) {
  94             cond_wait($COUNT);
  95         }
  96     }
  97     threads->yield();
  98     sleep(1);
  99 }
 100 ok($TEST++, $COUNT == 5, "Done - $COUNT threads");
 101
 102
 103 sub threading_2 {
 104     my $tid = threads->tid();
 105     ok($TEST++, $tid, "Thread $tid started");
 106
 107     if ($tid < 10) {
 108         threads->create('threading_2')->detach();
 109     }
 110
 111     threads->yield();
 112
 113     lock($COUNT);
 114     $COUNT++;
 115     cond_signal($COUNT);
 116
 117     ok($TEST++, $tid, "Thread $tid done");
 118 }
 119
 120 {
 121     $COUNT = 0;
 122     threads->create('threading_2')->detach();
 123     {
 124         lock($COUNT);
 125         while ($COUNT < 3) {
 126             cond_wait($COUNT);
 127         }
 128     }
 129     threads->yield();
 130     sleep(1);
 131 }
 132 ok($TEST++, $COUNT == 5, "Done - $COUNT threads");
 133
 134
 135 {
 136     threads->create(sub { })->join();
 137 }
 138 ok($TEST++, 1, 'Join');
 139
 140
 141 sub threading_3 {
 142     my $tid = threads->tid();
 143     ok($TEST++, $tid, "Thread $tid started");
 144
 145     {
 146         threads->create(sub {
 147             my $tid = threads->tid();
 148             ok($TEST++, $tid, "Thread $tid started");
 149
 150             threads->yield();
 151             sleep(1);
 152
 153             lock($COUNT);
 154             $COUNT++;
 155             cond_signal($COUNT);
 156
 157             ok($TEST++, $tid, "Thread $tid done");
 158         })->join();
 159     }
 160
 161     lock($COUNT);
 162     $COUNT++;
 163     cond_signal($COUNT);
 164
 165     ok($TEST++, $tid, "Thread $tid done");
 166 }
 167
 168 {
 169     $COUNT = 0;
 170     threads->create(sub {
 171         threads->create('threading_3')->detach();
 172         {
 173             lock($COUNT);
 174             while ($COUNT < 2) {
 175                 cond_wait($COUNT);
 176             }
 177         }
 178     })->join();
 179     threads->yield();
 180     sleep(1);
 181 }
 182 ok($TEST++, $COUNT == 2, "Done - $COUNT threads");
 183
 184 # EOF