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