ext/threads/t/state.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     $| = 1;
  31     print("1..59\n");   ### Number of tests that will be run ###
  32 };
  33
  34 my $TEST;
  35 BEGIN {
  36     share($TEST);
  37     $TEST = 1;
  38 }
  39
  40 ok(1, 'Loaded');
  41
  42 sub ok {
  43     my ($ok, $name) = @_;
  44
  45     lock($TEST);
  46     my $id = $TEST++;
  47
  48     # You have to do it this way or VMS will get confused.
  49     if ($ok) {
  50         print("ok $id - $name\n");
  51     } else {
  52         print("not ok $id - $name\n");
  53         printf("# Failed test at line %d\n", (caller)[2]);
  54     }
  55
  56     return ($ok);
  57 }
  58
  59
  60 ### Start of Testing ###
  61
  62 my ($READY, $GO, $DONE) :shared = (0, 0, 0);
  63
  64 sub do_thread
  65 {
  66     {
  67         lock($DONE);
  68         $DONE = 0;
  69         lock($READY);
  70         $READY = 1;
  71         cond_signal($READY);
  72     }
  73
  74     lock($GO);
  75     while (! $GO) {
  76         cond_wait($GO);
  77     }
  78     $GO = 0;
  79
  80     lock($READY);
  81     $READY = 0;
  82     lock($DONE);
  83     $DONE = 1;
  84     cond_signal($DONE);
  85 }
  86
  87 sub wait_until_ready
  88 {
  89     lock($READY);
  90     while (! $READY) {
  91         cond_wait($READY);
  92     }
  93 }
  94
  95 sub thread_go
  96 {
  97     {
  98         lock($GO);
  99         $GO = 1;
 100         cond_signal($GO);
 101     }
 102
 103     {
 104         lock($DONE);
 105         while (! $DONE) {
 106             cond_wait($DONE);
 107         }
 108     }
 109     threads->yield();
 110     sleep(1);
 111 }
 112
 113
 114 my $thr = threads->create('do_thread');
 115 wait_until_ready();
 116 ok($thr->is_running(),    'thread running');
 117 ok(threads->list(threads::running) == 1,  'thread running list');
 118 ok(! $thr->is_detached(), 'thread not detached');
 119 ok(! $thr->is_joinable(), 'thread not joinable');
 120 ok(threads->list(threads::joinable) == 0, 'thread joinable list');
 121 ok(threads->list(threads::all) == 1, 'thread list');
 122
 123 thread_go();
 124 ok(! $thr->is_running(),  'thread not running');
 125 ok(threads->list(threads::running) == 0,  'thread running list');
 126 ok(! $thr->is_detached(), 'thread not detached');
 127 ok($thr->is_joinable(),   'thread joinable');
 128 ok(threads->list(threads::joinable) == 1, 'thread joinable list');
 129 ok(threads->list(threads::all) == 1, 'thread list');
 130
 131 $thr->join();
 132 ok(! $thr->is_running(),  'thread not running');
 133 ok(threads->list(threads::running) == 0,  'thread running list');
 134 ok(! $thr->is_detached(), 'thread not detached');
 135 ok(! $thr->is_joinable(), 'thread not joinable');
 136 ok(threads->list(threads::joinable) == 0, 'thread joinable list');
 137 ok(threads->list(threads::all) == 0, 'thread list');
 138
 139 $thr = threads->create('do_thread');
 140 $thr->detach();
 141 ok($thr->is_running(),    'thread running');
 142 ok(threads->list(threads::running) == 0,  'thread running list');
 143 ok($thr->is_detached(),   'thread detached');
 144 ok(! $thr->is_joinable(), 'thread not joinable');
 145 ok(threads->list(threads::joinable) == 0, 'thread joinable list');
 146 ok(threads->list(threads::all) == 0, 'thread list');
 147
 148 thread_go();
 149 ok(! $thr->is_running(),  'thread not running');
 150 ok(threads->list(threads::running) == 0,  'thread running list');
 151 ok($thr->is_detached(),   'thread detached');
 152 ok(! $thr->is_joinable(), 'thread not joinable');
 153 ok(threads->list(threads::joinable) == 0, 'thread joinable list');
 154
 155 $thr = threads->create(sub {
 156     ok(! threads->is_detached(), 'thread not detached');
 157     ok(threads->list(threads::running) == 1, 'thread running list');
 158     ok(threads->list(threads::joinable) == 0, 'thread joinable list');
 159     ok(threads->list(threads::all) == 1, 'thread list');
 160     threads->detach();
 161     do_thread();
 162     ok(threads->is_detached(),   'thread detached');
 163     ok(threads->list(threads::running) == 0, 'thread running list');
 164     ok(threads->list(threads::joinable) == 0, 'thread joinable list');
 165     ok(threads->list(threads::all) == 0, 'thread list');
 166 });
 167
 168 wait_until_ready();
 169 ok($thr->is_running(),    'thread running');
 170 ok(threads->list(threads::running) == 0,  'thread running list');
 171 ok($thr->is_detached(),   'thread detached');
 172 ok(! $thr->is_joinable(), 'thread not joinable');
 173 ok(threads->list(threads::joinable) == 0, 'thread joinable list');
 174 ok(threads->list(threads::all) == 0, 'thread list');
 175
 176 thread_go();
 177 ok(! $thr->is_running(),  'thread not running');
 178 ok(threads->list(threads::running) == 0,  'thread running list');
 179 ok($thr->is_detached(),   'thread detached');
 180 ok(! $thr->is_joinable(), 'thread not joinable');
 181 ok(threads->list(threads::joinable) == 0, 'thread joinable list');
 182
 183 {
 184     my $go : shared = 0;
 185     my $t = threads->create( sub {
 186         ok(! threads->is_detached(), 'thread not detached');
 187         ok(threads->list(threads::running) == 1, 'thread running list');
 188         ok(threads->list(threads::joinable) == 0, 'thread joinable list');
 189         ok(threads->list(threads::all) == 1, 'thread list');
 190         lock($go); $go = 1; cond_signal($go);
 191     });
 192
 193     { lock ($go); cond_wait($go) until $go; }
 194     $t->join;
 195 }
 196
 197 {
 198     my $rdy :shared = 0;
 199     sub thr_ready
 200     {
 201         lock($rdy);
 202         $rdy++;
 203         cond_signal($rdy);
 204     }
 205
 206     my $go :shared = 0;
 207     sub thr_wait
 208     {
 209         lock($go);
 210         cond_wait($go) until $go;
 211     }
 212
 213     my $done :shared = 0;
 214     sub thr_done
 215     {
 216         lock($done);
 217         $done++;
 218         cond_signal($done);
 219     }
 220
 221     my $thr_routine = sub { thr_ready(); thr_wait(); thr_done(); };
 222
 223     # Create 8 threads:
 224     #  3 running, blocking on $go
 225     #  2 running, blocking on $go, join pending
 226     #  2 running, blocking on join of above
 227     #  1 finished, unjoined
 228
 229     for (1..3) { threads->create($thr_routine); }
 230
 231     foreach my $t (map {threads->create($thr_routine)} 1..2) {
 232         threads->create(sub { thr_ready(); $_[0]->join; thr_done(); }, $t);
 233     }
 234     threads->create(sub { thr_ready(); thr_done(); });
 235     {
 236         lock($done);
 237         cond_wait($done) until ($done == 1);
 238     }
 239     {
 240         lock($rdy);
 241         cond_wait($rdy) until ($rdy == 8);
 242     }
 243     threads->yield();
 244     sleep(1);
 245
 246     ok(threads->list(threads::running) == 5, 'thread running list');
 247     ok(threads->list(threads::joinable) == 1, 'thread joinable list');
 248     ok(threads->list(threads::all) == 6, 'thread all list');
 249
 250     { lock($go); $go = 1; cond_broadcast($go); }
 251     {
 252         lock($done);
 253         cond_wait($done) until ($done == 8);
 254     }
 255     threads->yield();
 256     sleep(1);
 257
 258     ok(threads->list(threads::running) == 0, 'thread running list');
 259     # Two awaiting join() have completed
 260     ok(threads->list(threads::joinable) == 6, 'thread joinable list');
 261     ok(threads->list(threads::all) == 6, 'thread all list');
 262
 263     for (threads->list) { $_->join; }
 264 }
 265
 266 # EOF