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