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..53\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 $thr = threads->create(sub {
 184     ok(! threads->is_detached(), 'thread not detached');
 185     ok(threads->list(threads::running) == 1, 'thread running list');
 186     ok(threads->list(threads::joinable) == 0, 'thread joinable list');
 187     ok(threads->list(threads::all) == 1, 'thread list');
 188 })->join();
 189
 190 # EOF