blob: 917237cfe687e57535232c833ce5a15087a313f0 (
plain)
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
|
#-sb-thread (invoke-restart 'run-tests::skip-file)
(use-package "SB-THREAD")
;;; This test takes at least 6 seconds because each thread wants to
;;; grab and hold the mutex for a total of 3 seconds.
(with-test (:name (:mutex :contention))
(let ((mutex (make-mutex :name "contended")))
(labels ((run ()
(let ((me *current-thread*))
(dotimes (i 100)
(with-mutex (mutex)
(sleep .03)
(assert (eql (mutex-owner mutex) me)))
(assert (not (eql (mutex-owner mutex) me))))
(format t "done ~A~%" *current-thread*))))
(let ((kid1 (make-thread #'run))
(kid2 (make-thread #'run)))
(format t "contention ~A ~A~%" kid1 kid2)
(wait-for-threads (list kid1 kid2))))))
(with-test (:name (interrupt-thread :interrupt-mutex-acquisition)
:broken-on :win32)
(let ((lock (make-mutex :name "loctite"))
child)
(with-mutex (lock)
(setf child (test-interrupt
(lambda ()
(with-mutex (lock)
(assert (eql (mutex-owner lock) *current-thread*)))
(assert (not (eql (mutex-owner lock) *current-thread*)))
(sleep 10))))
;;hold onto lock for long enough that child can't get it immediately
(sleep 5)
(interrupt-thread child (lambda () (format t "l ~A~%" (mutex-owner lock))))
(format t "parent releasing lock~%"))
(process-all-interrupts child)
(terminate-thread child)
(wait-for-threads (list child))))
|
