1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
|
commit 60d82dd56c15a533562cf28111af5d3365d5d354
Author: Shiro Kawai <shiro@acm.org>
Date: Thu May 31 15:23:22 2012 -1000
Fixed thread-terminate! bug that SEGVs when applied on non-running threads
--- a/ext/threads/test.scm
+++ b/ext/threads/test.scm
@@ -100,6 +100,18 @@
(thread-terminate! t1)
(thread-join! t1))))
+;; this SEGVs on 0.9.3.3. test code from @cryks.
+(test* "thread termination before running" 'terminated
+ (let1 t1 (make-thread (^[] #f))
+ (thread-terminate! t1)
+ (thread-state t1)))
+
+(test* "thread termination while being stopped" 'terminated
+ (let1 t1 (thread-start! (make-thread (^[] (let loop () (loop)))))
+ (thread-stop! t1)
+ (thread-terminate! t1)
+ (thread-state t1)))
+
;;---------------------------------------------------------------------
(test-section "thread and error")
--- a/ext/threads/threads.c
+++ b/ext/threads/threads.c
@@ -432,36 +432,41 @@ ScmObj Scm_ThreadTerminate(ScmVM *target)
}
(void)SCM_INTERNAL_MUTEX_LOCK(target->vmlock);
- do {
- /* This ensures only the first call of thread-terminate! on a thread
- is in effect. */
- if (target->canceller == NULL) {
- target->canceller = vm;
-
- /* First try */
- target->stopRequest = SCM_VM_REQUEST_TERMINATE;
- target->attentionRequest = TRUE;
- if (wait_for_termination(target)) break;
-
- /* Second try */
+ if (target->state == SCM_VM_RUNNABLE || target->state == SCM_VM_STOPPED) {
+ do {
+ /* This ensures only the first call of thread-terminate! on a
+ thread is in effect. */
+ if (target->canceller == NULL) {
+ target->canceller = vm;
+
+ /* First try */
+ target->stopRequest = SCM_VM_REQUEST_TERMINATE;
+ target->attentionRequest = TRUE;
+ if (wait_for_termination(target)) break;
+
+ /* Second try */
+ SCM_ASSERT(target->thread);
#if defined(GAUCHE_USE_PTHREADS)
# if defined(GAUCHE_PTHREAD_SIGNAL)
- pthread_kill(target->thread, GAUCHE_PTHREAD_SIGNAL);
+ pthread_kill(target->thread, GAUCHE_PTHREAD_SIGNAL);
# endif /*defined(GAUCHE_PTHREAD_SIGNAL)*/
#elif defined(GAUCHE_USE_WTHREADS)
- /* TODO: implement signal mechanism using an event */
+ /* TODO: implement signal mechanism using an event */
#endif /* defined(GAUCHE_USE_WTHREADS) */
- if (wait_for_termination(target)) break;
+ if (wait_for_termination(target)) break;
- /* Last resort */
- thread_cleanup_inner(target);
+ /* Last resort */
+ thread_cleanup_inner(target);
#if defined(GAUCHE_USE_PTHREADS)
- pthread_cancel(target->thread);
+ pthread_cancel(target->thread);
#elif defined(GAUCHE_USE_WTHREADS)
- TerminateThread(target->thread, 0);
+ TerminateThread(target->thread, 0);
#endif
- }
- } while (0);
+ }
+ } while (0);
+ }
+ /* target either is terminated or hasn't been run */
+ target->state = SCM_VM_TERMINATED;
(void)SCM_INTERNAL_MUTEX_UNLOCK(target->vmlock);
return SCM_UNDEFINED;
}
--- a/test/control.scm
+++ b/test/control.scm
@@ -72,7 +72,7 @@
;;
(cond-expand
- [gauche.sys.pthreads
+ [gauche.sys.threads
(test-section "control.thread-pool")
(use control.thread-pool)
(test-module 'control.thread-pool)
@@ -173,7 +173,15 @@
(let1 xjob (add-job! pool work)
(terminate-all! pool :force-timeout 0.05)
(job-status xjob))))
- ]
+
+ ;; This SEGVs on 0.9.3.3 (test code by @cryks)
+ (test* "thread pool termination" 'terminated
+ (let ([t (thread-start! (make-thread (cut undefined)))]
+ [pool (make-thread-pool 10)])
+ (terminate-all! pool)
+ (thread-terminate! t)
+ (thread-state t)))
+ ] ; gauche.sys.pthreads
[else])
(test-end)
|
GitWeb