1 ;;;; miscellaneous tests of thread stuff
3 ;;;; This software is part of the SBCL system. See the README file for
6 ;;;; While most of SBCL is derived from the CMU CL system, the test
7 ;;;; files (like this one) were written from scratch after the fork
10 ;;;; This software is in the public domain and is provided with
11 ;;;; absoluely no warranty. See the COPYING and CREDITS files for
12 ;;;; more information.
16 (defpackage :thread-test
17 (:use
:cl
:sb-thread
))
19 (in-package :thread-test
)
21 (use-package :test-util
)
23 ;;; Terminating a thread that's waiting for the terminal.
26 (let ((thread (make-thread (lambda ()
27 (sb-thread::get-foreground
)))))
29 (assert (thread-alive-p thread
))
30 (terminate-thread thread
)
32 (assert (not (thread-alive-p thread
))))
34 ;;; Condition-wait should not be interruptible under WITHOUT-INTERRUPTS
37 (with-test (:name without-interrupts
+condition-wait
39 (let* ((lock (make-mutex))
40 (queue (make-waitqueue))
41 (thread (make-thread (lambda ()
42 (sb-sys:without-interrupts
44 (condition-wait queue lock
)))))))
46 (assert (thread-alive-p thread
))
47 (terminate-thread thread
)
49 (assert (thread-alive-p thread
))
50 (condition-notify queue
)
52 (assert (not (thread-alive-p thread
)))))
54 ;;; GET-MUTEX should not be interruptible under WITHOUT-INTERRUPTS
57 (with-test (:name without-interrupts
+get-mutex
)
58 (let* ((lock (make-mutex))
59 (bar (progn (get-mutex lock
) nil
))
60 (thread (make-thread (lambda ()
61 (sb-sys:without-interrupts
65 (assert (thread-alive-p thread
))
66 (terminate-thread thread
)
68 (assert (thread-alive-p thread
))
71 (assert (not (thread-alive-p thread
)))
72 (assert (eq :aborted
(join-thread thread
:default
:aborted
)))
76 (with-test (:name parallel-find-class
)
78 (threads (loop repeat
10
79 collect
(make-thread (lambda ()
82 do
(find-class (gensym) nil
))
85 (mapcar #'sb-thread
:join-thread threads
)
89 (with-test (:name
:semaphore-multiple-waiters
)
90 (let ((semaphore (make-semaphore :name
"test sem")))
91 (labels ((make-readers (n i
)
93 (loop for r from
0 below n
96 (sb-thread:make-thread
(lambda ()
97 (let ((sem semaphore
))
99 (sb-thread:wait-on-semaphore sem
))))
102 (make-writers (n readers i
)
103 (let ((j (* readers i
)))
104 (multiple-value-bind (k rem
) (truncate j n
)
107 (loop for w from
0 below n
110 (sb-thread:make-thread
(lambda ()
111 (let ((sem semaphore
))
113 (sb-thread:signal-semaphore sem
))))
119 (multiple-value-bind (readers x
) (make-readers r n
)
120 (assert (= (length readers
) r
))
121 (multiple-value-bind (writers y
) (make-writers w r n
)
122 (assert (= (length writers
) w
))
124 (mapc #'sb-thread
:join-thread writers
)
125 (mapc #'sb-thread
:join-thread readers
)
126 (assert (zerop (sb-thread:semaphore-count semaphore
)))
131 (sb-ext:with-timeout
10