ext/threads/t/free.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     require Thread::Queue;
  31
  32     $| = 1;
  33     print("1..29\n");   ### Number of tests that will be run ###
  34 }
  35
  36
  37 my $q = Thread::Queue->new();
  38 my $TEST = 1;
  39
  40 sub ok
  41 {
  42     $q->enqueue(@_);
  43
  44     while ($q->pending()) {
  45         my $ok   = $q->dequeue();
  46         my $name = $q->dequeue();
  47         my $id   = $TEST++;
  48
  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 }
  57
  58
  59 ### Start of Testing ###
  60 ok(1, 'Loaded');
  61
  62 # Tests freeing the Perl interperter for each thread
  63 # See http://www.nntp.perl.org/group/perl.perl5.porters/110772 for details
  64
  65 my ($COUNT, $STARTED) :shared;
  66
  67 sub threading_1 {
  68     my $q = shift;
  69
  70     my $tid = threads->tid();
  71     $q->enqueue($tid, "Thread $tid started");
  72
  73     my $id;
  74     {
  75         lock($STARTED);
  76         $STARTED++;
  77         $id = $STARTED;
  78     }
  79     if ($STARTED < 5) {
  80         sleep(1);
  81         threads->create('threading_1', $q)->detach();
  82     }
  83
  84     if ($id == 1) {
  85         sleep(2);
  86     } elsif ($id == 2) {
  87         sleep(6);
  88     } elsif ($id == 3) {
  89         sleep(3);
  90     } elsif ($id == 4) {
  91         sleep(1);
  92     } else {
  93         sleep(2);
  94     }
  95
  96     lock($COUNT);
  97     $COUNT++;
  98     cond_signal($COUNT);
  99     $q->enqueue($tid, "Thread $tid done");
 100 }
 101
 102 {
 103     $STARTED = 0;
 104     $COUNT = 0;
 105     threads->create('threading_1', $q)->detach();
 106     {
 107         my $cnt = 0;
 108         while ($cnt < 5) {
 109             {
 110                 lock($COUNT);
 111                 cond_wait($COUNT) if ($COUNT < 5);
 112                 $cnt = $COUNT;
 113             }
 114             threads->create(sub {
 115                 threads->create(sub { })->join();
 116             })->join();
 117         }
 118     }
 119     sleep(1);
 120 }
 121 ok($COUNT == 5, "Done - $COUNT threads");
 122
 123
 124 sub threading_2 {
 125     my $q = shift;
 126
 127     my $tid = threads->tid();
 128     $q->enqueue($tid, "Thread $tid started");
 129
 130     {
 131         lock($STARTED);
 132         $STARTED++;
 133     }
 134     if ($STARTED < 5) {
 135         threads->create('threading_2', $q)->detach();
 136     }
 137     threads->yield();
 138
 139     lock($COUNT);
 140     $COUNT++;
 141     cond_signal($COUNT);
 142
 143     $q->enqueue($tid, "Thread $tid done");
 144 }
 145
 146 {
 147     $STARTED = 0;
 148     $COUNT = 0;
 149     threads->create('threading_2', $q)->detach();
 150     threads->create(sub {
 151         threads->create(sub { })->join();
 152     })->join();
 153     {
 154         lock($COUNT);
 155         while ($COUNT < 5) {
 156             cond_wait($COUNT);
 157         }
 158     }
 159     sleep(1);
 160 }
 161 ok($COUNT == 5, "Done - $COUNT threads");
 162
 163
 164 {
 165     threads->create(sub { })->join();
 166 }
 167 ok(1, 'Join');
 168
 169
 170 sub threading_3 {
 171     my $q = shift;
 172
 173     my $tid = threads->tid();
 174     $q->enqueue($tid, "Thread $tid started");
 175
 176     {
 177         threads->create(sub {
 178             my $q = shift;
 179
 180             my $tid = threads->tid();
 181             $q->enqueue($tid, "Thread $tid started");
 182
 183             sleep(1);
 184
 185             lock($COUNT);
 186             $COUNT++;
 187             cond_signal($COUNT);
 188
 189             $q->enqueue($tid, "Thread $tid done");
 190         }, $q)->detach();
 191     }
 192
 193     lock($COUNT);
 194     $COUNT++;
 195     cond_signal($COUNT);
 196
 197     $q->enqueue($tid, "Thread $tid done");
 198 }
 199
 200 {
 201     $COUNT = 0;
 202     threads->create(sub {
 203         threads->create('threading_3', $q)->detach();
 204         {
 205             lock($COUNT);
 206             while ($COUNT < 2) {
 207                 cond_wait($COUNT);
 208             }
 209         }
 210     })->join();
 211     sleep(1);
 212 }
 213 ok($COUNT == 2, "Done - $COUNT threads");
 214
 215 # EOF