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