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