dist/threads/t/kill.t

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