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.
14 #-sb-thread (quit :unix-status 104)
16 (in-package "SB-THREAD") ; this is white-box testing, really
18 ;;; elementary "can we get a lock and release it again"
19 (let ((l (make-mutex :name "foo"))
20 (p (current-thread-id)))
21 (assert (eql (mutex-value l) nil))
22 (assert (eql (mutex-lock l) 0))
23 (sb-thread:get-mutex l)
24 (assert (eql (mutex-value l) p))
25 (assert (eql (mutex-lock l) 0))
26 (sb-thread:release-mutex l)
27 (assert (eql (mutex-value l) nil))
28 (assert (eql (mutex-lock l) 0)))
30 (let ((queue (make-waitqueue :name "queue"))
31 (lock (make-mutex :name "lock")))
32 (labels ((in-new-thread ()
34 (assert (eql (mutex-value lock) (current-thread-id)))
35 (format t "~A got mutex~%" (current-thread-id))
36 ;; now drop it and sleep
37 (condition-wait queue lock)
38 ;; after waking we should have the lock again
39 (assert (eql (mutex-value lock) (current-thread-id))))))
40 (make-thread #'in-new-thread)
41 (sleep 2) ; give it a chance to start
42 ;; check the lock is free while it's asleep
43 (format t "parent thread ~A~%" (current-thread-id))
44 (assert (eql (mutex-value lock) nil))
45 (assert (eql (mutex-lock lock) 0))
47 (condition-notify queue))
50 (let ((queue (make-waitqueue :name "queue"))
51 (lock (make-mutex :name "lock")))
52 (labels ((ours-p (value)
53 (sb-vm:control-stack-pointer-valid-p
54 (sb-sys:int-sap (sb-kernel:get-lisp-obj-address value))))
56 (with-recursive-lock (lock)
57 (assert (ours-p (mutex-value lock)))
58 (format t "~A got mutex~%" (mutex-value lock))
59 ;; now drop it and sleep
60 (condition-wait queue lock)
61 ;; after waking we should have the lock again
62 (format t "woken, ~A got mutex~%" (mutex-value lock))
63 (assert (ours-p (mutex-value lock))))))
64 (make-thread #'in-new-thread)
65 (sleep 2) ; give it a chance to start
66 ;; check the lock is free while it's asleep
67 (format t "parent thread ~A~%" (current-thread-id))
68 (assert (eql (mutex-value lock) nil))
69 (assert (eql (mutex-lock lock) 0))
70 (with-recursive-lock (lock)
71 (condition-notify queue))
75 (sb-ext:quit :unix-status 104)