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