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 { |
58a3a76c |
21 | eval { |
22 | require threads::shared; |
f3086ff0 |
23 | threads::shared->import(); |
58a3a76c |
24 | }; |
25 | if ($@ || ! $threads::shared::threads_shared) { |
561ee912 |
26 | print("1..0 # SKIP threads::shared not available\n"); |
58a3a76c |
27 | exit(0); |
28 | } |
29 | |
404aaa48 |
30 | local $SIG{'HUP'} = sub {}; |
31 | my $thr = threads->create(sub {}); |
32 | eval { $thr->kill('HUP') }; |
33 | $thr->join(); |
34 | if ($@ && $@ =~ /safe signals/) { |
561ee912 |
35 | print("1..0 # SKIP Not using safe signals\n"); |
404aaa48 |
36 | exit(0); |
37 | } |
c0003851 |
38 | |
18b9e6f5 |
39 | require Thread::Queue; |
40 | require Thread::Semaphore; |
c0003851 |
41 | |
c0003851 |
42 | $| = 1; |
18b9e6f5 |
43 | print("1..18\n"); ### Number of tests that will be run ### |
c0003851 |
44 | }; |
45 | |
c0003851 |
46 | |
18b9e6f5 |
47 | my $q = Thread::Queue->new(); |
48 | my $TEST = 1; |
c0003851 |
49 | |
18b9e6f5 |
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 | } |
c0003851 |
65 | } |
c0003851 |
66 | } |
67 | |
68 | |
69 | ### Start of Testing ### |
18b9e6f5 |
70 | ok(1, 'Loaded'); |
c0003851 |
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 | |
c0003851 |
78 | sub thr_func { |
18b9e6f5 |
79 | my $q = shift; |
80 | |
c0003851 |
81 | # Thread 'cancellation' signal handler |
82 | $SIG{'KILL'} = sub { |
18b9e6f5 |
83 | $q->enqueue(1, 'Thread received signal'); |
c0003851 |
84 | die("Thread killed\n"); |
85 | }; |
86 | |
87 | # Thread sleeps until signalled |
18b9e6f5 |
88 | $q->enqueue(1, 'Thread sleeping'); |
89 | sleep(1) for (1..10); |
c0003851 |
90 | # Should not go past here |
18b9e6f5 |
91 | $q->enqueue(0, 'Thread terminated normally'); |
c0003851 |
92 | return ('ERROR'); |
93 | } |
94 | |
c0003851 |
95 | # Create thread |
18b9e6f5 |
96 | my $thr = threads->create('thr_func', $q); |
404aaa48 |
97 | ok($thr && $thr->tid() == 2, 'Created thread'); |
c0003851 |
98 | threads->yield(); |
99 | sleep(1); |
100 | |
101 | # Signal thread |
18b9e6f5 |
102 | ok($thr->kill('KILL') == $thr, 'Signalled thread'); |
c0003851 |
103 | threads->yield(); |
104 | |
c0003851 |
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 | { |
18b9e6f5 |
117 | my $q = shift; |
118 | |
c0003851 |
119 | my $sema = shift; |
18b9e6f5 |
120 | $q->enqueue($sema, 'Thread received semaphore'); |
c0003851 |
121 | |
122 | # Set up the signal handler for suspension/resumption |
123 | $SIG{'STOP'} = sub { |
18b9e6f5 |
124 | $q->enqueue(1, 'Thread suspending'); |
c0003851 |
125 | $sema->down(); |
18b9e6f5 |
126 | $q->enqueue(1, 'Thread resuming'); |
c0003851 |
127 | $sema->up(); |
128 | }; |
129 | |
130 | # Set up the signal handler for graceful termination |
131 | my $term = 0; |
132 | $SIG{'TERM'} = sub { |
18b9e6f5 |
133 | $q->enqueue(1, 'Thread caught termination signal'); |
c0003851 |
134 | $term = 1; |
135 | }; |
136 | |
137 | # Do work until signalled to terminate |
138 | while (! $term) { |
139 | sleep(1); |
140 | } |
141 | |
18b9e6f5 |
142 | $q->enqueue(1, 'Thread done'); |
c0003851 |
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 |
18b9e6f5 |
152 | $thr = threads->create('thr_func2', $q, $sema); |
404aaa48 |
153 | ok($thr && $thr->tid() == 3, 'Created thread'); |
c0003851 |
154 | threads->yield(); |
155 | sleep(1); |
156 | |
157 | # Suspend the thread |
158 | $sema->down(); |
18b9e6f5 |
159 | ok($thr->kill('STOP') == $thr, 'Suspended thread'); |
c0003851 |
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 |
3ceb02cd |
171 | ok($thr->kill('TERM') == $thr, 'Signalled thread to terminate'); |
c0003851 |
172 | |
173 | $rc = $thr->join(); |
174 | ok($rc eq 'OKAY', 'Thread return value'); |
175 | |
18b9e6f5 |
176 | ok($thr->kill('TERM') == $thr, 'Ignore signal to terminated thread'); |
3ceb02cd |
177 | |
561ee912 |
178 | exit(0); |
179 | |
c0003851 |
180 | # EOF |