ext/threads/t/free2.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 use threads;
  19
  20 BEGIN {
  21     eval {
  22         require threads::shared;
  23         import threads::shared;
  24     };
  25     if ($@ || ! $threads::shared::threads_shared) {
  26         print("1..0 # Skip: threads::shared not available\n");
  27         exit(0);
  28     }
  29
  30     if (($] < 5.008002) && ($threads::shared::VERSION < 0.92)) {
  31         print("1..0 # Skip: Needs threads::shared 0.92 or later\n");
  32         exit(0);
  33     }
  34
  35     $| = 1;
  36     print("1..74\n");   ### Number of tests that will be run ###
  37 };
  38
  39 my $TEST = 1;
  40 share($TEST);
  41
  42 ok(1, 'Loaded');
  43
  44 sub ok {
  45     my ($ok, $name) = @_;
  46
  47     lock($TEST);
  48     my $id = $TEST++;
  49
  50     # You have to do it this way or VMS will get confused.
  51     if ($ok) {
  52         print("ok $id - $name\n");
  53     } else {
  54         print("not ok $id - $name\n");
  55         printf("# Failed test at line %d\n", (caller)[2]);
  56     }
  57
  58     return ($ok);
  59 }
  60
  61
  62 ### Start of Testing ###
  63
  64 # Tests freeing the Perl interperter for each thread
  65 # See http://www.nntp.perl.org/group/perl.perl5.porters/110772 for details
  66
  67 my $COUNT;
  68 share($COUNT);
  69 my %READY;
  70 share(%READY);
  71
  72 # Init a thread
  73 sub th_start {
  74     my $tid = threads->tid();
  75     ok($tid, "Thread $tid started");
  76
  77     # Create next thread
  78     if ($tid < 17) {
  79         my $next = 'th' . ($tid+1);
  80         my $th = threads->create($next);
  81     } else {
  82         # Last thread signals first
  83         th_signal(1);
  84     }
  85     th_wait();
  86 }
  87
  88 # Thread terminating
  89 sub th_done {
  90     my $tid = threads->tid();
  91
  92     lock($COUNT);
  93     $COUNT++;
  94     cond_signal($COUNT);
  95
  96     ok($tid, "Thread $tid done");
  97 }
  98
  99 # Wait until signalled by another thread
 100 sub th_wait
 101 {
 102     my $tid = threads->tid();
 103
 104     lock(%READY);
 105     while (! exists($READY{$tid})) {
 106         cond_wait(%READY);
 107     }
 108     my $other = delete($READY{$tid});
 109     ok($tid, "Thread $tid received signal from $other");
 110 }
 111
 112 # Signal another thread to go
 113 sub th_signal
 114 {
 115     my $other = shift;
 116     my $tid = threads->tid();
 117
 118     ok($tid, "Thread $tid signalling $other");
 119
 120     lock(%READY);
 121     $READY{$other} = $tid;
 122     cond_broadcast(%READY);
 123 }
 124
 125 #####
 126
 127 sub th1 {
 128     th_start();
 129
 130     threads->detach();
 131
 132     th_signal(2);
 133     th_signal(6);
 134     th_signal(10);
 135     th_signal(14);
 136
 137     th_done();
 138 }
 139
 140 sub th2 {
 141     th_start();
 142     threads->detach();
 143     th_signal(4);
 144     th_done();
 145 }
 146
 147 sub th6 {
 148     th_start();
 149     threads->detach();
 150     th_signal(8);
 151     th_done();
 152 }
 153
 154 sub th10 {
 155     th_start();
 156     threads->detach();
 157     th_signal(12);
 158     th_done();
 159 }
 160
 161 sub th14 {
 162     th_start();
 163     threads->detach();
 164     th_signal(16);
 165     th_done();
 166 }
 167
 168 sub th4 {
 169     th_start();
 170     threads->detach();
 171     th_signal(3);
 172     th_done();
 173 }
 174
 175 sub th8 {
 176     th_start();
 177     threads->detach();
 178     th_signal(7);
 179     th_done();
 180 }
 181
 182 sub th12 {
 183     th_start();
 184     threads->detach();
 185     th_signal(13);
 186     th_done();
 187 }
 188
 189 sub th16 {
 190     th_start();
 191     threads->detach();
 192     th_signal(17);
 193     th_done();
 194 }
 195
 196 sub th3 {
 197     my $other = 5;
 198
 199     th_start();
 200     threads->detach();
 201     th_signal($other);
 202     threads->yield();
 203     sleep(1);
 204     my $ret = threads->object($other)->join();
 205     ok($ret == $other, "Thread $other returned $ret");
 206     th_done();
 207 }
 208
 209 sub th5 {
 210     th_start();
 211     th_done();
 212     return (threads->tid());
 213 }
 214
 215
 216 sub th7 {
 217     my $other = 9;
 218
 219     th_start();
 220     threads->detach();
 221     th_signal($other);
 222     my $ret = threads->object($other)->join();
 223     ok($ret == $other, "Thread $other returned $ret");
 224     th_done();
 225 }
 226
 227 sub th9 {
 228     th_start();
 229     threads->yield();
 230     sleep(1);
 231     th_done();
 232     return (threads->tid());
 233 }
 234
 235
 236 sub th13 {
 237     my $other = 11;
 238
 239     th_start();
 240     threads->detach();
 241     th_signal($other);
 242     threads->yield();
 243     sleep(1);
 244     my $ret = threads->object($other)->join();
 245     ok($ret == $other, "Thread $other returned $ret");
 246     th_done();
 247 }
 248
 249 sub th11 {
 250     th_start();
 251     th_done();
 252     return (threads->tid());
 253 }
 254
 255
 256 sub th17 {
 257     my $other = 15;
 258
 259     th_start();
 260     threads->detach();
 261     th_signal($other);
 262     my $ret = threads->object($other)->join();
 263     ok($ret == $other, "Thread $other returned $ret");
 264     th_done();
 265 }
 266
 267 sub th15 {
 268     th_start();
 269     threads->yield();
 270     sleep(1);
 271     th_done();
 272     return (threads->tid());
 273 }
 274
 275
 276
 277
 278
 279
 280 TEST_STARTS_HERE:
 281 {
 282     $COUNT = 0;
 283     threads->create('th1');
 284     {
 285         lock($COUNT);
 286         while ($COUNT < 17) {
 287             cond_wait($COUNT);
 288         }
 289     }
 290     threads->yield();
 291     sleep(1);
 292 }
 293 ok($COUNT == 17, "Done - $COUNT threads");
 294
 295 # EOF