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