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