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