diff options
Diffstat (limited to 'dev-scheme/gauche/files/gauche-0.9.3.3-gauche.threads.diff')
| -rw-r--r-- | dev-scheme/gauche/files/gauche-0.9.3.3-gauche.threads.diff | 120 |
1 files changed, 120 insertions, 0 deletions
diff --git a/dev-scheme/gauche/files/gauche-0.9.3.3-gauche.threads.diff b/dev-scheme/gauche/files/gauche-0.9.3.3-gauche.threads.diff new file mode 100644 index 000000000000..a44ee75b8d1a --- /dev/null +++ b/dev-scheme/gauche/files/gauche-0.9.3.3-gauche.threads.diff @@ -0,0 +1,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) |