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 use threads::shared;
  20
  21 BEGIN {
  22     $| = 1;
  23     print("1..29\n");   ### Number of tests that will be run ###
  24 };
  25
  26 my $TEST = 1;
  27 share($TEST);
  28
  29 ok(1, 'Loaded');
  30
  31 sub ok {
  32     my ($ok, $name) = @_;
  33
  34     lock($TEST);
  35     my $id = $TEST++;
  36
  37     # You have to do it this way or VMS will get confused.
  38     if ($ok) {
  39         print("ok $id - $name\n");
  40     } else {
  41         print("not ok $id - $name\n");
  42         printf("# Failed test at line %d\n", (caller)[2]);
  43     }
  44
  45     return ($ok);
  46 }
  47
  48
  49 ### Start of Testing ###
  50
  51 # Tests freeing the Perl interperter for each thread
  52 # See http://www.nntp.perl.org/group/perl.perl5.porters/110772 for details
  53
  54 my $COUNT;
  55 share($COUNT);
  56
  57 sub threading_1 {
  58     my $tid = threads->tid();
  59     ok($tid, "Thread $tid started");
  60
  61     if ($tid < 5) {
  62         sleep(1);
  63         threads->create('threading_1')->detach();
  64     }
  65
  66     threads->yield();
  67
  68     if ($tid == 1) {
  69         sleep(2);
  70     } elsif ($tid == 2) {
  71         sleep(6);
  72     } elsif ($tid == 3) {
  73         sleep(3);
  74     } elsif ($tid == 4) {
  75         sleep(1);
  76     } else {
  77         sleep(2);
  78     }
  79
  80     lock($COUNT);
  81     $COUNT++;
  82     cond_signal($COUNT);
  83     ok($tid, "Thread $tid done");
  84 }
  85
  86 {
  87     $COUNT = 0;
  88     threads->create('threading_1')->detach();
  89     {
  90         lock($COUNT);
  91         while ($COUNT < 3) {
  92             cond_wait($COUNT);
  93         }
  94     }
  95 }
  96 {
  97     {
  98         lock($COUNT);
  99         while ($COUNT < 5) {
 100             cond_wait($COUNT);
 101         }
 102     }
 103     threads->yield();
 104     sleep(1);
 105 }
 106 ok($COUNT == 5, "Done - $COUNT threads");
 107
 108
 109 sub threading_2 {
 110     my $tid = threads->tid();
 111     ok($tid, "Thread $tid started");
 112
 113     if ($tid < 10) {
 114         threads->create('threading_2')->detach();
 115     }
 116
 117     threads->yield();
 118
 119     lock($COUNT);
 120     $COUNT++;
 121     cond_signal($COUNT);
 122
 123     ok($tid, "Thread $tid done");
 124 }
 125
 126 {
 127     $COUNT = 0;
 128     threads->create('threading_2')->detach();
 129     {
 130         lock($COUNT);
 131         while ($COUNT < 3) {
 132             cond_wait($COUNT);
 133         }
 134     }
 135     threads->yield();
 136     sleep(1);
 137 }
 138 ok($COUNT == 5, "Done - $COUNT threads");
 139
 140
 141 {
 142     threads->create(sub { })->join();
 143 }
 144 ok(1, 'Join');
 145
 146
 147 sub threading_3 {
 148     my $tid = threads->tid();
 149     ok($tid, "Thread $tid started");
 150
 151     {
 152         threads->create(sub {
 153             my $tid = threads->tid();
 154             ok($tid, "Thread $tid started");
 155
 156             threads->yield();
 157             sleep(1);
 158
 159             lock($COUNT);
 160             $COUNT++;
 161             cond_signal($COUNT);
 162
 163             ok($tid, "Thread $tid done");
 164         })->join();
 165     }
 166
 167     lock($COUNT);
 168     $COUNT++;
 169     cond_signal($COUNT);
 170
 171     ok($tid, "Thread $tid done");
 172 }
 173
 174 {
 175     $COUNT = 0;
 176     threads->create(sub {
 177         threads->create('threading_3')->detach();
 178         {
 179             lock($COUNT);
 180             while ($COUNT < 2) {
 181                 cond_wait($COUNT);
 182             }
 183         }
 184     })->join();
 185     threads->yield();
 186     sleep(1);
 187 }
 188 ok($COUNT == 2, "Done - $COUNT threads");
 189
 190 # EOF