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