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
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
| | ;;; threads.el --- tests for threads.
;; Copyright (C) 2012 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Code:
(ert-deftest threads-is-one ()
"test for existence of a thread"
(should (current-thread)))
(ert-deftest threads-threadp ()
"test of threadp"
(should (threadp (current-thread))))
(ert-deftest threads-type ()
"test of thread type"
(should (eq (type-of (current-thread)) 'thread)))
(ert-deftest threads-name ()
"test for name of a thread"
(should
(string= "hi bob" (thread-name (make-thread #'ignore "hi bob")))))
(ert-deftest threads-alive ()
"test for thread liveness"
(should
(thread-alive-p (make-thread #'ignore))))
(ert-deftest threads-all-threads ()
"simple test for all-threads"
(should (listp (all-threads))))
(defvar threads-test-global nil)
(defun threads-test-thread1 ()
(setq threads-test-global 23))
(ert-deftest threads-basic ()
"basic thread test"
(should
(progn
(setq threads-test-global nil)
(make-thread #'threads-test-thread1)
(while (not threads-test-global)
(thread-yield))
threads-test-global)))
(ert-deftest threads-join ()
"test of thread-join"
(should
(progn
(setq threads-test-global nil)
(let ((thread (make-thread #'threads-test-thread1)))
(thread-join thread)
(and threads-test-global
(not (thread-alive-p thread)))))))
(defvar threads-test-binding nil)
(defun threads-test-thread2 ()
(let ((threads-test-binding 23))
(thread-yield))
(setq threads-test-global 23))
(ert-deftest threads-let-binding ()
"simple test of threads and let bindings"
(should
(progn
(setq threads-test-binding nil)
(make-thread #'threads-test-thread2)
(while (not threads-test-global)
(thread-yield))
(and (not threads-test-binding)
threads-test-global))))
(ert-deftest threads-mutexp ()
"simple test of mutexp"
(should-not (mutexp 'hi)))
(ert-deftest threads-mutexp-2 ()
"another simple test of mutexp"
(should (mutexp (make-mutex))))
(ert-deftest threads-mutex-type ()
"type-of mutex"
(should (eq (type-of (make-mutex)) 'mutex)))
(ert-deftest threads-mutex-lock-unlock ()
"test mutex-lock and unlock"
(should
(let ((mx (make-mutex)))
(mutex-lock mx)
(mutex-unlock mx)
t)))
(ert-deftest threads-mutex-recursive ()
"test mutex-lock and unlock"
(should
(let ((mx (make-mutex)))
(mutex-lock mx)
(mutex-lock mx)
(mutex-unlock mx)
(mutex-unlock mx)
t)))
(defvar threads-mutex nil)
(defvar threads-mutex-key nil)
(defun threads-test-mlock ()
(mutex-lock threads-mutex)
(setq threads-mutex-key 23)
(while threads-mutex-key
(thread-yield))
(mutex-unlock threads-mutex))
(ert-deftest threads-mutex-contention ()
"test of mutex contention"
(should
(progn
(setq threads-mutex (make-mutex))
(setq threads-mutex-key nil)
(make-thread #'threads-test-mlock)
;; Wait for other thread to get the lock.
(while (not threads-mutex-key)
(thread-yield))
;; Try now.
(setq threads-mutex-key nil)
(mutex-lock threads-mutex)
(mutex-unlock threads-mutex)
t)))
(defun threads-test-mlock2 ()
(setq threads-mutex-key 23)
(mutex-lock threads-mutex))
(ert-deftest threads-mutex-signal ()
"test signalling a blocked thread"
(should
(progn
(setq threads-mutex (make-mutex))
(setq threads-mutex-key nil)
(mutex-lock threads-mutex)
(let ((thr (make-thread #'threads-test-mlock2)))
(while (not threads-mutex-key)
(thread-yield))
(thread-signal thr 'quit nil)
(thread-join thr))
t)))
;;; threads.el ends here
|