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         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..29\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 # 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 $tid = threads->tid();
  69     ok($tid, "Thread $tid started");
  70
  71     my $id;
  72     {
  73         lock($STARTED);
  74         $STARTED++;
  75         $id = $STARTED;
  76     }
  77     if ($STARTED < 5) {
  78         sleep(1);
  79         threads->create('threading_1')->detach();
  80     }
  81
  82     if ($id == 1) {
  83         sleep(2);
  84     } elsif ($id == 2) {
  85         sleep(6);
  86     } elsif ($id == 3) {
  87         sleep(3);
  88     } elsif ($id == 4) {
  89         sleep(1);
  90     } else {
  91         sleep(2);
  92     }
  93
  94     lock($COUNT);
  95     $COUNT++;
  96     cond_signal($COUNT);
  97     ok($tid, "Thread $tid done");
  98 }
  99
 100 {
 101     $STARTED = 0;
 102     $COUNT = 0;
 103     threads->create('threading_1')->detach();
 104     {
 105         my $cnt = 0;
 106         while ($cnt < 5) {
 107             {
 108                 lock($COUNT);
 109                 cond_wait($COUNT) if ($COUNT < 5);
 110                 $cnt = $COUNT;
 111             }
 112             threads->create(sub {
 113                 threads->create(sub { })->join();
 114             })->join();
 115         }
 116     }
 117     sleep(1);
 118 }
 119 ok($COUNT == 5, "Done - $COUNT threads");
 120
 121
 122 sub threading_2 {
 123     my $tid = threads->tid();
 124     ok($tid, "Thread $tid started");
 125
 126     {
 127         lock($STARTED);
 128         $STARTED++;
 129     }
 130     if ($STARTED < 5) {
 131         threads->create('threading_2')->detach();
 132     }
 133     threads->yield();
 134
 135     lock($COUNT);
 136     $COUNT++;
 137     cond_signal($COUNT);
 138
 139     ok($tid, "Thread $tid done");
 140 }
 141
 142 {
 143     $STARTED = 0;
 144     $COUNT = 0;
 145     threads->create('threading_2')->detach();
 146     threads->create(sub {
 147         threads->create(sub { })->join();
 148     })->join();
 149     {
 150         lock($COUNT);
 151         while ($COUNT < 5) {
 152             cond_wait($COUNT);
 153         }
 154     }
 155     sleep(1);
 156 }
 157 ok($COUNT == 5, "Done - $COUNT threads");
 158
 159
 160 {
 161     threads->create(sub { })->join();
 162 }
 163 ok(1, 'Join');
 164
 165
 166 sub threading_3 {
 167     my $tid = threads->tid();
 168     ok($tid, "Thread $tid started");
 169
 170     {
 171         threads->create(sub {
 172             my $tid = threads->tid();
 173             ok($tid, "Thread $tid started");
 174
 175             sleep(1);
 176
 177             lock($COUNT);
 178             $COUNT++;
 179             cond_signal($COUNT);
 180
 181             ok($tid, "Thread $tid done");
 182         })->detach();
 183     }
 184
 185     lock($COUNT);
 186     $COUNT++;
 187     cond_signal($COUNT);
 188
 189     ok($tid, "Thread $tid done");
 190 }
 191
 192 {
 193     $COUNT = 0;
 194     threads->create(sub {
 195         threads->create('threading_3')->detach();
 196         {
 197             lock($COUNT);
 198             while ($COUNT < 2) {
 199                 cond_wait($COUNT);
 200             }
 201         }
 202     })->join();
 203     sleep(1);
 204 }
 205 ok($COUNT == 2, "Done - $COUNT threads");
 206
 207 # EOF