1 ;;; threads.el --- tests for threads.
3 ;; Copyright (C) 2012-2016 Free Software Foundation, Inc.
5 ;; This file is part of GNU Emacs.
7 ;; GNU Emacs is free software: you can redistribute it and/or modify
8 ;; it under the terms of the GNU General Public License as published by
9 ;; the Free Software Foundation, either version 3 of the License, or
10 ;; (at your option) any later version.
12 ;; GNU Emacs is distributed in the hope that it will be useful,
13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 ;; GNU General Public License for more details.
17 ;; You should have received a copy of the GNU General Public License
18 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
22 (ert-deftest threads-is-one
()
23 "test for existence of a thread"
24 (should (current-thread)))
26 (ert-deftest threads-threadp
()
28 (should (threadp (current-thread))))
30 (ert-deftest threads-type
()
32 (should (eq (type-of (current-thread)) 'thread
)))
34 (ert-deftest threads-name
()
35 "test for name of a thread"
37 (string= "hi bob" (thread-name (make-thread #'ignore
"hi bob")))))
39 (ert-deftest threads-alive
()
40 "test for thread liveness"
42 (thread-alive-p (make-thread #'ignore
))))
44 (ert-deftest threads-all-threads
()
45 "simple test for all-threads"
46 (should (listp (all-threads))))
48 (defvar threads-test-global nil
)
50 (defun threads-test-thread1 ()
51 (setq threads-test-global
23))
53 (ert-deftest threads-basic
()
57 (setq threads-test-global nil
)
58 (make-thread #'threads-test-thread1
)
59 (while (not threads-test-global
)
61 threads-test-global
)))
63 (ert-deftest threads-join
()
67 (setq threads-test-global nil
)
68 (let ((thread (make-thread #'threads-test-thread1
)))
70 (and threads-test-global
71 (not (thread-alive-p thread
)))))))
73 (ert-deftest threads-join-self
()
74 "cannot thread-join the current thread"
75 (should-error (thread-join (current-thread))))
77 (defvar threads-test-binding nil
)
79 (defun threads-test-thread2 ()
80 (let ((threads-test-binding 23))
82 (setq threads-test-global
23))
84 (ert-deftest threads-let-binding
()
85 "simple test of threads and let bindings"
88 (setq threads-test-global nil
)
89 (make-thread #'threads-test-thread2
)
90 (while (not threads-test-global
)
92 (and (not threads-test-binding
)
93 threads-test-global
))))
95 (ert-deftest threads-mutexp
()
96 "simple test of mutexp"
97 (should-not (mutexp 'hi
)))
99 (ert-deftest threads-mutexp-2
()
100 "another simple test of mutexp"
101 (should (mutexp (make-mutex))))
103 (ert-deftest threads-mutex-type
()
105 (should (eq (type-of (make-mutex)) 'mutex
)))
107 (ert-deftest threads-mutex-lock-unlock
()
108 "test mutex-lock and unlock"
110 (let ((mx (make-mutex)))
115 (ert-deftest threads-mutex-recursive
()
116 "test mutex-lock and unlock"
118 (let ((mx (make-mutex)))
125 (defvar threads-mutex nil
)
126 (defvar threads-mutex-key nil
)
128 (defun threads-test-mlock ()
129 (mutex-lock threads-mutex
)
130 (setq threads-mutex-key
23)
131 (while threads-mutex-key
133 (mutex-unlock threads-mutex
))
135 (ert-deftest threads-mutex-contention
()
136 "test of mutex contention"
139 (setq threads-mutex
(make-mutex))
140 (setq threads-mutex-key nil
)
141 (make-thread #'threads-test-mlock
)
142 ;; Wait for other thread to get the lock.
143 (while (not threads-mutex-key
)
146 (setq threads-mutex-key nil
)
147 (mutex-lock threads-mutex
)
148 (mutex-unlock threads-mutex
)
151 (defun threads-test-mlock2 ()
152 (setq threads-mutex-key
23)
153 (mutex-lock threads-mutex
))
155 (ert-deftest threads-mutex-signal
()
156 "test signaling a blocked thread"
159 (setq threads-mutex
(make-mutex))
160 (setq threads-mutex-key nil
)
161 (mutex-lock threads-mutex
)
162 (let ((thr (make-thread #'threads-test-mlock2
)))
163 (while (not threads-mutex-key
)
165 (thread-signal thr
'quit nil
)
169 (defun threads-test-io-switch ()
170 (setq threads-test-global
23))
172 (ert-deftest threads-io-switch
()
173 "test that accept-process-output causes thread switch"
176 (setq threads-test-global nil
)
177 (make-thread #'threads-test-io-switch
)
178 (while (not threads-test-global
)
179 (accept-process-output nil
1))
180 threads-test-global
)))
182 (ert-deftest threads-condvarp
()
183 "simple test of condition-variable-p"
184 (should-not (condition-variable-p 'hi
)))
186 (ert-deftest threads-condvarp-2
()
187 "another simple test of condition-variable-p"
188 (should (condition-variable-p (make-condition-variable (make-mutex)))))
190 (ert-deftest threads-condvar-type
()
192 (should (eq (type-of (make-condition-variable (make-mutex)))
193 'condition-variable
)))
195 (ert-deftest threads-condvar-mutex
()
196 "simple test of condition-mutex"
198 (let ((m (make-mutex)))
199 (eq m
(condition-mutex (make-condition-variable m
))))))
201 (ert-deftest threads-condvar-name
()
202 "simple test of condition-name"
204 (eq nil
(condition-name (make-condition-variable (make-mutex))))))
206 (ert-deftest threads-condvar-name-2
()
207 "another simple test of condition-name"
210 (condition-name (make-condition-variable (make-mutex)
214 (error "Error is called"))
216 ;; This signals an error internally; the error should be caught.
217 (defun thread-custom ()
218 (defcustom thread-custom-face
'highlight
219 "Face used for thread customizations."
221 :group
'widget-faces
))
223 (ert-deftest thread-errors
()
224 "Test what happens when a thread signals an error."
225 (should (threadp (make-thread #'call-error
"call-error")))
226 (should (threadp (make-thread #'thread-custom
"thread-custom"))))
228 (ert-deftest thread-sticky-point
()
229 "Test bug #25165 with point movement in cloned buffer."
231 (insert "Lorem ipsum dolor sit amet, consectetur adipiscing elit.")
232 (goto-char (point-min))
233 (clone-indirect-buffer nil nil
)
236 (should (= (point) 21))))
238 (ert-deftest thread-signal-early
()
239 "Test signaling a thread as soon as it is started by the OS."
241 (make-thread #'(lambda ()
242 (while t
(thread-yield))))))
243 (thread-signal thread
'error nil
)
245 (should-not (thread-alive-p thread
))))
247 ;;; threads.el ends here