ext/threads/t/kill.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         threads::shared->import();
  24     };
  25     if ($@ || ! $threads::shared::threads_shared) {
  26         print("1..0 # SKIP threads::shared not available\n");
  27         exit(0);
  28     }
  29
  30     local $SIG{'HUP'} = sub {};
  31     my $thr = threads->create(sub {});
  32     eval { $thr->kill('HUP') };
  33     $thr->join();
  34     if ($@ && $@ =~ /safe signals/) {
  35         print("1..0 # SKIP Not using safe signals\n");
  36         exit(0);
  37     }
  38
  39     require Thread::Queue;
  40     require Thread::Semaphore;
  41
  42     $| = 1;
  43     print("1..18\n");   ### Number of tests that will be run ###
  44 };
  45
  46
  47 my $q = Thread::Queue->new();
  48 my $TEST = 1;
  49
  50 sub ok
  51 {
  52     $q->enqueue(@_);
  53
  54     while ($q->pending()) {
  55         my $ok   = $q->dequeue();
  56         my $name = $q->dequeue();
  57         my $id   = $TEST++;
  58
  59         if ($ok) {
  60             print("ok $id - $name\n");
  61         } else {
  62             print("not ok $id - $name\n");
  63             printf("# Failed test at line %d\n", (caller)[2]);
  64         }
  65     }
  66 }
  67
  68
  69 ### Start of Testing ###
  70 ok(1, 'Loaded');
  71
  72 ### Thread cancel ###
  73
  74 # Set up to capture warning when thread terminates
  75 my @errs :shared;
  76 $SIG{__WARN__} = sub { push(@errs, @_); };
  77
  78 sub thr_func {
  79     my $q = shift;
  80
  81     # Thread 'cancellation' signal handler
  82     $SIG{'KILL'} = sub {
  83         $q->enqueue(1, 'Thread received signal');
  84         die("Thread killed\n");
  85     };
  86
  87     # Thread sleeps until signalled
  88     $q->enqueue(1, 'Thread sleeping');
  89     sleep(1) for (1..10);
  90     # Should not go past here
  91     $q->enqueue(0, 'Thread terminated normally');
  92     return ('ERROR');
  93 }
  94
  95 # Create thread
  96 my $thr = threads->create('thr_func', $q);
  97 ok($thr && $thr->tid() == 2, 'Created thread');
  98 threads->yield();
  99 sleep(1);
 100
 101 # Signal thread
 102 ok($thr->kill('KILL') == $thr, 'Signalled thread');
 103 threads->yield();
 104
 105 # Cleanup
 106 my $rc = $thr->join();
 107 ok(! $rc, 'No thread return value');
 108
 109 # Check for thread termination message
 110 ok(@errs && $errs[0] =~ /Thread killed/, 'Thread termination warning');
 111
 112
 113 ### Thread suspend/resume ###
 114
 115 sub thr_func2
 116 {
 117     my $q = shift;
 118
 119     my $sema = shift;
 120     $q->enqueue($sema, 'Thread received semaphore');
 121
 122     # Set up the signal handler for suspension/resumption
 123     $SIG{'STOP'} = sub {
 124         $q->enqueue(1, 'Thread suspending');
 125         $sema->down();
 126         $q->enqueue(1, 'Thread resuming');
 127         $sema->up();
 128     };
 129
 130     # Set up the signal handler for graceful termination
 131     my $term = 0;
 132     $SIG{'TERM'} = sub {
 133         $q->enqueue(1, 'Thread caught termination signal');
 134         $term = 1;
 135     };
 136
 137     # Do work until signalled to terminate
 138     while (! $term) {
 139         sleep(1);
 140     }
 141
 142     $q->enqueue(1, 'Thread done');
 143     return ('OKAY');
 144 }
 145
 146
 147 # Create a semaphore for use in suspending the thread
 148 my $sema = Thread::Semaphore->new();
 149 ok($sema, 'Semaphore created');
 150
 151 # Create a thread and send it the semaphore
 152 $thr = threads->create('thr_func2', $q, $sema);
 153 ok($thr && $thr->tid() == 3, 'Created thread');
 154 threads->yield();
 155 sleep(1);
 156
 157 # Suspend the thread
 158 $sema->down();
 159 ok($thr->kill('STOP') == $thr, 'Suspended thread');
 160
 161 threads->yield();
 162 sleep(1);
 163
 164 # Allow the thread to continue
 165 $sema->up();
 166
 167 threads->yield();
 168 sleep(1);
 169
 170 # Terminate the thread
 171 ok($thr->kill('TERM') == $thr, 'Signalled thread to terminate');
 172
 173 $rc = $thr->join();
 174 ok($rc eq 'OKAY', 'Thread return value');
 175
 176 ok($thr->kill('TERM') == $thr, 'Ignore signal to terminated thread');
 177
 178 exit(0);
 179
 180 # EOF