dist/threads/t/free.t

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