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
  10     # Import test.pl into its own package
  11     {
  12         package Test;
  13         require($ENV{PERL_CORE} ? './test.pl' : './t/test.pl');
  14     }
  15
  16     use Config;
  17     if (! $Config{'useithreads'}) {
  18         Test::skip_all(q/Perl not compiled with 'useithreads'/);
  19     }
  20 }
  21
  22 use ExtUtils::testlib;
  23
  24 use threads;
  25
  26 BEGIN {
  27     if (! eval 'use threads::shared; 1') {
  28         Test::skip_all(q/threads::shared not available/);
  29     }
  30
  31     require Thread::Queue;
  32
  33     $| = 1;
  34     print("1..29\n");   ### Number of tests that will be run ###
  35 }
  36
  37 Test::watchdog(120);   # In case we get stuck
  38
  39 my $q = Thread::Queue->new();
  40 my $TEST = 1;
  41
  42 sub ok
  43 {
  44     $q->enqueue(@_);
  45
  46     while ($q->pending()) {
  47         my $ok   = $q->dequeue();
  48         my $name = $q->dequeue();
  49         my $id   = $TEST++;
  50
  51         if ($ok) {
  52             print("ok $id - $name\n");
  53         } else {
  54             print("not ok $id - $name\n");
  55             printf("# Failed test at line %d\n", (caller)[2]);
  56         }
  57     }
  58 }
  59
  60
  61 ### Start of Testing ###
  62 ok(1, 'Loaded');
  63
  64 # Tests freeing the Perl interperter for each thread
  65 # See http://www.nntp.perl.org/group/perl.perl5.porters/110772 for details
  66
  67 my ($COUNT, $STARTED) :shared;
  68
  69 sub threading_1 {
  70     my $q = shift;
  71
  72     my $tid = threads->tid();
  73     $q->enqueue($tid, "Thread $tid started");
  74
  75     my $id;
  76     {
  77         lock($STARTED);
  78         $STARTED++;
  79         $id = $STARTED;
  80     }
  81     if ($STARTED < 5) {
  82         sleep(1);
  83         threads->create('threading_1', $q)->detach();
  84     }
  85
  86     if ($id == 1) {
  87         sleep(2);
  88     } elsif ($id == 2) {
  89         sleep(6);
  90     } elsif ($id == 3) {
  91         sleep(3);
  92     } elsif ($id == 4) {
  93         sleep(1);
  94     } else {
  95         sleep(2);
  96     }
  97
  98     lock($COUNT);
  99     $COUNT++;
 100     cond_signal($COUNT);
 101     $q->enqueue($tid, "Thread $tid done");
 102 }
 103
 104 {
 105     $STARTED = 0;
 106     $COUNT = 0;
 107     threads->create('threading_1', $q)->detach();
 108     {
 109         my $cnt = 0;
 110         while ($cnt < 5) {
 111             {
 112                 lock($COUNT);
 113                 cond_wait($COUNT) if ($COUNT < 5);
 114                 $cnt = $COUNT;
 115             }
 116             threads->create(sub {
 117                 threads->create(sub { })->join();
 118             })->join();
 119         }
 120     }
 121     sleep(1);
 122 }
 123 ok($COUNT == 5, "Done - $COUNT threads");
 124
 125
 126 sub threading_2 {
 127     my $q = shift;
 128
 129     my $tid = threads->tid();
 130     $q->enqueue($tid, "Thread $tid started");
 131
 132     {
 133         lock($STARTED);
 134         $STARTED++;
 135     }
 136     if ($STARTED < 5) {
 137         threads->create('threading_2', $q)->detach();
 138     }
 139     threads->yield();
 140
 141     lock($COUNT);
 142     $COUNT++;
 143     cond_signal($COUNT);
 144
 145     $q->enqueue($tid, "Thread $tid done");
 146 }
 147
 148 {
 149     $STARTED = 0;
 150     $COUNT = 0;
 151     threads->create('threading_2', $q)->detach();
 152     threads->create(sub {
 153         threads->create(sub { })->join();
 154     })->join();
 155     {
 156         lock($COUNT);
 157         while ($COUNT < 5) {
 158             cond_wait($COUNT);
 159         }
 160     }
 161     sleep(1);
 162 }
 163 ok($COUNT == 5, "Done - $COUNT threads");
 164
 165
 166 {
 167     threads->create(sub { })->join();
 168 }
 169 ok(1, 'Join');
 170
 171
 172 sub threading_3 {
 173     my $q = shift;
 174
 175     my $tid = threads->tid();
 176     $q->enqueue($tid, "Thread $tid started");
 177
 178     {
 179         threads->create(sub {
 180             my $q = shift;
 181
 182             my $tid = threads->tid();
 183             $q->enqueue($tid, "Thread $tid started");
 184
 185             sleep(1);
 186
 187             lock($COUNT);
 188             $COUNT++;
 189             cond_signal($COUNT);
 190
 191             $q->enqueue($tid, "Thread $tid done");
 192         }, $q)->detach();
 193     }
 194
 195     lock($COUNT);
 196     $COUNT++;
 197     cond_signal($COUNT);
 198
 199     $q->enqueue($tid, "Thread $tid done");
 200 }
 201
 202 {
 203     $COUNT = 0;
 204     threads->create(sub {
 205         threads->create('threading_3', $q)->detach();
 206         {
 207             lock($COUNT);
 208             while ($COUNT < 2) {
 209                 cond_wait($COUNT);
 210             }
 211         }
 212     })->join();
 213     sleep(1);
 214 }
 215 ok($COUNT == 2, "Done - $COUNT threads");
 216
 217 exit(0);
 218
 219 # EOF