diff options
| author | Michael Albinus | 2018-07-12 10:49:06 +0200 |
|---|---|---|
| committer | Michael Albinus | 2018-07-12 10:49:06 +0200 |
| commit | 3744fda5fa92ed058a1eb636a7836759ae5ab06f (patch) | |
| tree | f83d7a0ade7f138da5f4e03f1cccd2a23662bcc7 | |
| parent | ef9025f5bcfb996fbabf5869584e9143bbc81af4 (diff) | |
| download | emacs-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.c | 2 | ||||
| -rw-r--r-- | test/src/thread-tests.el | 76 |
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 |