aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMichael Albinus2018-07-12 10:49:06 +0200
committerMichael Albinus2018-07-12 10:49:06 +0200
commit3744fda5fa92ed058a1eb636a7836759ae5ab06f (patch)
treef83d7a0ade7f138da5f4e03f1cccd2a23662bcc7
parentef9025f5bcfb996fbabf5869584e9143bbc81af4 (diff)
downloademacs-3744fda5fa92ed058a1eb636a7836759ae5ab06f.tar.gz
emacs-3744fda5fa92ed058a1eb636a7836759ae5ab06f.zip
Provide feature 'threads
* src/thread.c (syms_of_threads): Provide feature "threads". * test/src/thread-tests.el (top): Declare the functions. (all): Use (featurep 'threads) check.
-rw-r--r--src/thread.c2
-rw-r--r--test/src/thread-tests.el76
2 files changed, 50 insertions, 28 deletions
diff --git a/src/thread.c b/src/thread.c
index 60902b252b4..04c2808e5c4 100644
--- a/src/thread.c
+++ b/src/thread.c
@@ -1068,6 +1068,8 @@ syms_of_threads (void)
1068 1068
1069 staticpro (&last_thread_error); 1069 staticpro (&last_thread_error);
1070 last_thread_error = Qnil; 1070 last_thread_error = Qnil;
1071
1072 Fprovide (intern_c_string ("threads"), Qnil);
1071 } 1073 }
1072 1074
1073 DEFSYM (Qthreadp, "threadp"); 1075 DEFSYM (Qthreadp, "threadp");
diff --git a/test/src/thread-tests.el b/test/src/thread-tests.el
index 0e909d3e511..3c7fde33d8f 100644
--- a/test/src/thread-tests.el
+++ b/test/src/thread-tests.el
@@ -19,36 +19,56 @@
19 19
20;;; Code: 20;;; Code:
21 21
22;; Declare the functions in case Emacs has been configured --without-threads.
23(declare-function all-threads "thread.c" ())
24(declare-function condition-mutex "thread.c" (cond))
25(declare-function condition-name "thread.c" (cond))
26(declare-function condition-notify "thread.c" (cond &optional all))
27(declare-function condition-wait "thread.c" (cond))
28(declare-function current-thread "thread.c" ())
29(declare-function make-condition-variable "thread.c" (mutex &optional name))
30(declare-function make-mutex "thread.c" (&optional name))
31(declare-function make-thread "thread.c" (function &optional name))
32(declare-function mutex-lock "thread.c" (mutex))
33(declare-function mutex-unlock "thread.c" (mutex))
34(declare-function thread--blocker "thread.c" (thread))
35(declare-function thread-alive-p "thread.c" (thread))
36(declare-function thread-join "thread.c" (thread))
37(declare-function thread-last-error "thread.c" ())
38(declare-function thread-name "thread.c" (thread))
39(declare-function thread-signal "thread.c" (thread error-symbol data))
40(declare-function thread-yield "thread.c" ())
41
22(ert-deftest threads-is-one () 42(ert-deftest threads-is-one ()
23 "Test for existence of a thread." 43 "Test for existence of a thread."
24 (skip-unless (fboundp 'make-thread)) 44 (skip-unless (featurep 'threads))
25 (should (current-thread))) 45 (should (current-thread)))
26 46
27(ert-deftest threads-threadp () 47(ert-deftest threads-threadp ()
28 "Test of threadp." 48 "Test of threadp."
29 (skip-unless (fboundp 'make-thread)) 49 (skip-unless (featurep 'threads))
30 (should (threadp (current-thread)))) 50 (should (threadp (current-thread))))
31 51
32(ert-deftest threads-type () 52(ert-deftest threads-type ()
33 "Test of thread type." 53 "Test of thread type."
34 (skip-unless (fboundp 'make-thread)) 54 (skip-unless (featurep 'threads))
35 (should (eq (type-of (current-thread)) 'thread))) 55 (should (eq (type-of (current-thread)) 'thread)))
36 56
37(ert-deftest threads-name () 57(ert-deftest threads-name ()
38 "Test for name of a thread." 58 "Test for name of a thread."
39 (skip-unless (fboundp 'make-thread)) 59 (skip-unless (featurep 'threads))
40 (should 60 (should
41 (string= "hi bob" (thread-name (make-thread #'ignore "hi bob"))))) 61 (string= "hi bob" (thread-name (make-thread #'ignore "hi bob")))))
42 62
43(ert-deftest threads-alive () 63(ert-deftest threads-alive ()
44 "Test for thread liveness." 64 "Test for thread liveness."
45 (skip-unless (fboundp 'make-thread)) 65 (skip-unless (featurep 'threads))
46 (should 66 (should
47 (thread-alive-p (make-thread #'ignore)))) 67 (thread-alive-p (make-thread #'ignore))))
48 68
49(ert-deftest threads-all-threads () 69(ert-deftest threads-all-threads ()
50 "Simple test for all-threads." 70 "Simple test for all-threads."
51 (skip-unless (fboundp 'make-thread)) 71 (skip-unless (featurep 'threads))
52 (should (listp (all-threads)))) 72 (should (listp (all-threads))))
53 73
54(defvar threads-test-global nil) 74(defvar threads-test-global nil)
@@ -58,7 +78,7 @@
58 78
59(ert-deftest threads-basic () 79(ert-deftest threads-basic ()
60 "Basic thread test." 80 "Basic thread test."
61 (skip-unless (fboundp 'make-thread)) 81 (skip-unless (featurep 'threads))
62 (should 82 (should
63 (progn 83 (progn
64 (setq threads-test-global nil) 84 (setq threads-test-global nil)
@@ -69,7 +89,7 @@
69 89
70(ert-deftest threads-join () 90(ert-deftest threads-join ()
71 "Test of `thread-join'." 91 "Test of `thread-join'."
72 (skip-unless (fboundp 'make-thread)) 92 (skip-unless (featurep 'threads))
73 (should 93 (should
74 (progn 94 (progn
75 (setq threads-test-global nil) 95 (setq threads-test-global nil)
@@ -80,7 +100,7 @@
80 100
81(ert-deftest threads-join-self () 101(ert-deftest threads-join-self ()
82 "Cannot `thread-join' the current thread." 102 "Cannot `thread-join' the current thread."
83 (skip-unless (fboundp 'make-thread)) 103 (skip-unless (featurep 'threads))
84 (should-error (thread-join (current-thread)))) 104 (should-error (thread-join (current-thread))))
85 105
86(defvar threads-test-binding nil) 106(defvar threads-test-binding nil)
@@ -92,7 +112,7 @@
92 112
93(ert-deftest threads-let-binding () 113(ert-deftest threads-let-binding ()
94 "Simple test of threads and let bindings." 114 "Simple test of threads and let bindings."
95 (skip-unless (fboundp 'make-thread)) 115 (skip-unless (featurep 'threads))
96 (should 116 (should
97 (progn 117 (progn
98 (setq threads-test-global nil) 118 (setq threads-test-global nil)
@@ -104,22 +124,22 @@
104 124
105(ert-deftest threads-mutexp () 125(ert-deftest threads-mutexp ()
106 "Simple test of `mutexp'." 126 "Simple test of `mutexp'."
107 (skip-unless (fboundp 'make-thread)) 127 (skip-unless (featurep 'threads))
108 (should-not (mutexp 'hi))) 128 (should-not (mutexp 'hi)))
109 129
110(ert-deftest threads-mutexp-2 () 130(ert-deftest threads-mutexp-2 ()
111 "Another simple test of `mutexp'." 131 "Another simple test of `mutexp'."
112 (skip-unless (fboundp 'make-thread)) 132 (skip-unless (featurep 'threads))
113 (should (mutexp (make-mutex)))) 133 (should (mutexp (make-mutex))))
114 134
115(ert-deftest threads-mutex-type () 135(ert-deftest threads-mutex-type ()
116 "type-of mutex." 136 "type-of mutex."
117 (skip-unless (fboundp 'make-thread)) 137 (skip-unless (featurep 'threads))
118 (should (eq (type-of (make-mutex)) 'mutex))) 138 (should (eq (type-of (make-mutex)) 'mutex)))
119 139
120(ert-deftest threads-mutex-lock-unlock () 140(ert-deftest threads-mutex-lock-unlock ()
121 "Test mutex-lock and unlock." 141 "Test mutex-lock and unlock."
122 (skip-unless (fboundp 'make-thread)) 142 (skip-unless (featurep 'threads))
123 (should 143 (should
124 (let ((mx (make-mutex))) 144 (let ((mx (make-mutex)))
125 (mutex-lock mx) 145 (mutex-lock mx)
@@ -128,7 +148,7 @@
128 148
129(ert-deftest threads-mutex-recursive () 149(ert-deftest threads-mutex-recursive ()
130 "Test mutex recursion." 150 "Test mutex recursion."
131 (skip-unless (fboundp 'make-thread)) 151 (skip-unless (featurep 'threads))
132 (should 152 (should
133 (let ((mx (make-mutex))) 153 (let ((mx (make-mutex)))
134 (mutex-lock mx) 154 (mutex-lock mx)
@@ -149,7 +169,7 @@
149 169
150(ert-deftest threads-mutex-contention () 170(ert-deftest threads-mutex-contention ()
151 "Test of mutex contention." 171 "Test of mutex contention."
152 (skip-unless (fboundp 'make-thread)) 172 (skip-unless (featurep 'threads))
153 (should 173 (should
154 (progn 174 (progn
155 (setq threads-mutex (make-mutex)) 175 (setq threads-mutex (make-mutex))
@@ -170,7 +190,7 @@
170 190
171(ert-deftest threads-mutex-signal () 191(ert-deftest threads-mutex-signal ()
172 "Test signaling a blocked thread." 192 "Test signaling a blocked thread."
173 (skip-unless (fboundp 'make-thread)) 193 (skip-unless (featurep 'threads))
174 (should 194 (should
175 (progn 195 (progn
176 (setq threads-mutex (make-mutex)) 196 (setq threads-mutex (make-mutex))
@@ -188,7 +208,7 @@
188 208
189(ert-deftest threads-io-switch () 209(ert-deftest threads-io-switch ()
190 "Test that `accept-process-output' causes thread switch." 210 "Test that `accept-process-output' causes thread switch."
191 (skip-unless (fboundp 'make-thread)) 211 (skip-unless (featurep 'threads))
192 (should 212 (should
193 (progn 213 (progn
194 (setq threads-test-global nil) 214 (setq threads-test-global nil)
@@ -199,36 +219,36 @@
199 219
200(ert-deftest threads-condvarp () 220(ert-deftest threads-condvarp ()
201 "Simple test of `condition-variable-p'." 221 "Simple test of `condition-variable-p'."
202 (skip-unless (fboundp 'make-thread)) 222 (skip-unless (featurep 'threads))
203 (should-not (condition-variable-p 'hi))) 223 (should-not (condition-variable-p 'hi)))
204 224
205(ert-deftest threads-condvarp-2 () 225(ert-deftest threads-condvarp-2 ()
206 "Another simple test of `condition-variable-p'." 226 "Another simple test of `condition-variable-p'."
207 (skip-unless (fboundp 'make-thread)) 227 (skip-unless (featurep 'threads))
208 (should (condition-variable-p (make-condition-variable (make-mutex))))) 228 (should (condition-variable-p (make-condition-variable (make-mutex)))))
209 229
210(ert-deftest threads-condvar-type () 230(ert-deftest threads-condvar-type ()
211 "type-of condvar" 231 "type-of condvar"
212 (skip-unless (fboundp 'make-thread)) 232 (skip-unless (featurep 'threads))
213 (should (eq (type-of (make-condition-variable (make-mutex))) 233 (should (eq (type-of (make-condition-variable (make-mutex)))
214 'condition-variable))) 234 'condition-variable)))
215 235
216(ert-deftest threads-condvar-mutex () 236(ert-deftest threads-condvar-mutex ()
217 "Simple test of `condition-mutex'." 237 "Simple test of `condition-mutex'."
218 (skip-unless (fboundp 'make-thread)) 238 (skip-unless (featurep 'threads))
219 (should 239 (should
220 (let ((m (make-mutex))) 240 (let ((m (make-mutex)))
221 (eq m (condition-mutex (make-condition-variable m)))))) 241 (eq m (condition-mutex (make-condition-variable m))))))
222 242
223(ert-deftest threads-condvar-name () 243(ert-deftest threads-condvar-name ()
224 "Simple test of `condition-name'." 244 "Simple test of `condition-name'."
225 (skip-unless (fboundp 'make-thread)) 245 (skip-unless (featurep 'threads))
226 (should 246 (should
227 (eq nil (condition-name (make-condition-variable (make-mutex)))))) 247 (eq nil (condition-name (make-condition-variable (make-mutex))))))
228 248
229(ert-deftest threads-condvar-name-2 () 249(ert-deftest threads-condvar-name-2 ()
230 "Another simple test of `condition-name'." 250 "Another simple test of `condition-name'."
231 (skip-unless (fboundp 'make-thread)) 251 (skip-unless (featurep 'threads))
232 (should 252 (should
233 (string= "hi bob" 253 (string= "hi bob"
234 (condition-name (make-condition-variable (make-mutex) 254 (condition-name (make-condition-variable (make-mutex)
@@ -246,7 +266,7 @@
246 266
247(ert-deftest thread-errors () 267(ert-deftest thread-errors ()
248 "Test what happens when a thread signals an error." 268 "Test what happens when a thread signals an error."
249 (skip-unless (fboundp 'make-thread)) 269 (skip-unless (featurep 'threads))
250 (let (th1 th2) 270 (let (th1 th2)
251 (setq th1 (make-thread #'call-error "call-error")) 271 (setq th1 (make-thread #'call-error "call-error"))
252 (should (threadp th1)) 272 (should (threadp th1))
@@ -259,7 +279,7 @@
259 279
260(ert-deftest thread-sticky-point () 280(ert-deftest thread-sticky-point ()
261 "Test bug #25165 with point movement in cloned buffer." 281 "Test bug #25165 with point movement in cloned buffer."
262 (skip-unless (fboundp 'make-thread)) 282 (skip-unless (featurep 'threads))
263 (with-temp-buffer 283 (with-temp-buffer
264 (insert "Lorem ipsum dolor sit amet, consectetur adipiscing elit.") 284 (insert "Lorem ipsum dolor sit amet, consectetur adipiscing elit.")
265 (goto-char (point-min)) 285 (goto-char (point-min))
@@ -270,7 +290,7 @@
270 290
271(ert-deftest thread-signal-early () 291(ert-deftest thread-signal-early ()
272 "Test signaling a thread as soon as it is started by the OS." 292 "Test signaling a thread as soon as it is started by the OS."
273 (skip-unless (fboundp 'make-thread)) 293 (skip-unless (featurep 'threads))
274 (let ((thread 294 (let ((thread
275 (make-thread #'(lambda () 295 (make-thread #'(lambda ()
276 (while t (thread-yield)))))) 296 (while t (thread-yield))))))
@@ -291,7 +311,7 @@
291 311
292(ert-deftest threads-condvar-wait () 312(ert-deftest threads-condvar-wait ()
293 "Test waiting on conditional variable." 313 "Test waiting on conditional variable."
294 (skip-unless (fboundp 'make-thread)) 314 (skip-unless (featurep 'threads))
295 (let ((cv-mutex (make-mutex)) 315 (let ((cv-mutex (make-mutex))
296 new-thread) 316 new-thread)
297 ;; We could have spurious threads from the previous tests still 317 ;; We could have spurious threads from the previous tests still