mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2025-01-02 11:21:42 +00:00
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.
This commit is contained in:
Michael Albinus
parent
ef9025f5bc
commit
3744fda5fa
@ -1068,6 +1068,8 @@ syms_of_threads (void)
|
||||
|
||||
staticpro (&last_thread_error);
|
||||
last_thread_error = Qnil;
|
||||
|
||||
Fprovide (intern_c_string ("threads"), Qnil);
|
||||
}
|
||||
|
||||
DEFSYM (Qthreadp, "threadp");
|
||||
|
||||
@ -19,36 +19,56 @@
|
||||
|
||||
;;; Code:
|
||||
|
||||
;; Declare the functions in case Emacs has been configured --without-threads.
|
||||
(declare-function all-threads "thread.c" ())
|
||||
(declare-function condition-mutex "thread.c" (cond))
|
||||
(declare-function condition-name "thread.c" (cond))
|
||||
(declare-function condition-notify "thread.c" (cond &optional all))
|
||||
(declare-function condition-wait "thread.c" (cond))
|
||||
(declare-function current-thread "thread.c" ())
|
||||
(declare-function make-condition-variable "thread.c" (mutex &optional name))
|
||||
(declare-function make-mutex "thread.c" (&optional name))
|
||||
(declare-function make-thread "thread.c" (function &optional name))
|
||||
(declare-function mutex-lock "thread.c" (mutex))
|
||||
(declare-function mutex-unlock "thread.c" (mutex))
|
||||
(declare-function thread--blocker "thread.c" (thread))
|
||||
(declare-function thread-alive-p "thread.c" (thread))
|
||||
(declare-function thread-join "thread.c" (thread))
|
||||
(declare-function thread-last-error "thread.c" ())
|
||||
(declare-function thread-name "thread.c" (thread))
|
||||
(declare-function thread-signal "thread.c" (thread error-symbol data))
|
||||
(declare-function thread-yield "thread.c" ())
|
||||
|
||||
(ert-deftest threads-is-one ()
|
||||
"Test for existence of a thread."
|
||||
(skip-unless (fboundp 'make-thread))
|
||||
(skip-unless (featurep 'threads))
|
||||
(should (current-thread)))
|
||||
|
||||
(ert-deftest threads-threadp ()
|
||||
"Test of threadp."
|
||||
(skip-unless (fboundp 'make-thread))
|
||||
(skip-unless (featurep 'threads))
|
||||
(should (threadp (current-thread))))
|
||||
|
||||
(ert-deftest threads-type ()
|
||||
"Test of thread type."
|
||||
(skip-unless (fboundp 'make-thread))
|
||||
(skip-unless (featurep 'threads))
|
||||
(should (eq (type-of (current-thread)) 'thread)))
|
||||
|
||||
(ert-deftest threads-name ()
|
||||
"Test for name of a thread."
|
||||
(skip-unless (fboundp 'make-thread))
|
||||
(skip-unless (featurep 'threads))
|
||||
(should
|
||||
(string= "hi bob" (thread-name (make-thread #'ignore "hi bob")))))
|
||||
|
||||
(ert-deftest threads-alive ()
|
||||
"Test for thread liveness."
|
||||
(skip-unless (fboundp 'make-thread))
|
||||
(skip-unless (featurep 'threads))
|
||||
(should
|
||||
(thread-alive-p (make-thread #'ignore))))
|
||||
|
||||
(ert-deftest threads-all-threads ()
|
||||
"Simple test for all-threads."
|
||||
(skip-unless (fboundp 'make-thread))
|
||||
(skip-unless (featurep 'threads))
|
||||
(should (listp (all-threads))))
|
||||
|
||||
(defvar threads-test-global nil)
|
||||
@ -58,7 +78,7 @@
|
||||
|
||||
(ert-deftest threads-basic ()
|
||||
"Basic thread test."
|
||||
(skip-unless (fboundp 'make-thread))
|
||||
(skip-unless (featurep 'threads))
|
||||
(should
|
||||
(progn
|
||||
(setq threads-test-global nil)
|
||||
@ -69,7 +89,7 @@
|
||||
|
||||
(ert-deftest threads-join ()
|
||||
"Test of `thread-join'."
|
||||
(skip-unless (fboundp 'make-thread))
|
||||
(skip-unless (featurep 'threads))
|
||||
(should
|
||||
(progn
|
||||
(setq threads-test-global nil)
|
||||
@ -80,7 +100,7 @@
|
||||
|
||||
(ert-deftest threads-join-self ()
|
||||
"Cannot `thread-join' the current thread."
|
||||
(skip-unless (fboundp 'make-thread))
|
||||
(skip-unless (featurep 'threads))
|
||||
(should-error (thread-join (current-thread))))
|
||||
|
||||
(defvar threads-test-binding nil)
|
||||
@ -92,7 +112,7 @@
|
||||
|
||||
(ert-deftest threads-let-binding ()
|
||||
"Simple test of threads and let bindings."
|
||||
(skip-unless (fboundp 'make-thread))
|
||||
(skip-unless (featurep 'threads))
|
||||
(should
|
||||
(progn
|
||||
(setq threads-test-global nil)
|
||||
@ -104,22 +124,22 @@
|
||||
|
||||
(ert-deftest threads-mutexp ()
|
||||
"Simple test of `mutexp'."
|
||||
(skip-unless (fboundp 'make-thread))
|
||||
(skip-unless (featurep 'threads))
|
||||
(should-not (mutexp 'hi)))
|
||||
|
||||
(ert-deftest threads-mutexp-2 ()
|
||||
"Another simple test of `mutexp'."
|
||||
(skip-unless (fboundp 'make-thread))
|
||||
(skip-unless (featurep 'threads))
|
||||
(should (mutexp (make-mutex))))
|
||||
|
||||
(ert-deftest threads-mutex-type ()
|
||||
"type-of mutex."
|
||||
(skip-unless (fboundp 'make-thread))
|
||||
(skip-unless (featurep 'threads))
|
||||
(should (eq (type-of (make-mutex)) 'mutex)))
|
||||
|
||||
(ert-deftest threads-mutex-lock-unlock ()
|
||||
"Test mutex-lock and unlock."
|
||||
(skip-unless (fboundp 'make-thread))
|
||||
(skip-unless (featurep 'threads))
|
||||
(should
|
||||
(let ((mx (make-mutex)))
|
||||
(mutex-lock mx)
|
||||
@ -128,7 +148,7 @@
|
||||
|
||||
(ert-deftest threads-mutex-recursive ()
|
||||
"Test mutex recursion."
|
||||
(skip-unless (fboundp 'make-thread))
|
||||
(skip-unless (featurep 'threads))
|
||||
(should
|
||||
(let ((mx (make-mutex)))
|
||||
(mutex-lock mx)
|
||||
@ -149,7 +169,7 @@
|
||||
|
||||
(ert-deftest threads-mutex-contention ()
|
||||
"Test of mutex contention."
|
||||
(skip-unless (fboundp 'make-thread))
|
||||
(skip-unless (featurep 'threads))
|
||||
(should
|
||||
(progn
|
||||
(setq threads-mutex (make-mutex))
|
||||
@ -170,7 +190,7 @@
|
||||
|
||||
(ert-deftest threads-mutex-signal ()
|
||||
"Test signaling a blocked thread."
|
||||
(skip-unless (fboundp 'make-thread))
|
||||
(skip-unless (featurep 'threads))
|
||||
(should
|
||||
(progn
|
||||
(setq threads-mutex (make-mutex))
|
||||
@ -188,7 +208,7 @@
|
||||
|
||||
(ert-deftest threads-io-switch ()
|
||||
"Test that `accept-process-output' causes thread switch."
|
||||
(skip-unless (fboundp 'make-thread))
|
||||
(skip-unless (featurep 'threads))
|
||||
(should
|
||||
(progn
|
||||
(setq threads-test-global nil)
|
||||
@ -199,36 +219,36 @@
|
||||
|
||||
(ert-deftest threads-condvarp ()
|
||||
"Simple test of `condition-variable-p'."
|
||||
(skip-unless (fboundp 'make-thread))
|
||||
(skip-unless (featurep 'threads))
|
||||
(should-not (condition-variable-p 'hi)))
|
||||
|
||||
(ert-deftest threads-condvarp-2 ()
|
||||
"Another simple test of `condition-variable-p'."
|
||||
(skip-unless (fboundp 'make-thread))
|
||||
(skip-unless (featurep 'threads))
|
||||
(should (condition-variable-p (make-condition-variable (make-mutex)))))
|
||||
|
||||
(ert-deftest threads-condvar-type ()
|
||||
"type-of condvar"
|
||||
(skip-unless (fboundp 'make-thread))
|
||||
(skip-unless (featurep 'threads))
|
||||
(should (eq (type-of (make-condition-variable (make-mutex)))
|
||||
'condition-variable)))
|
||||
|
||||
(ert-deftest threads-condvar-mutex ()
|
||||
"Simple test of `condition-mutex'."
|
||||
(skip-unless (fboundp 'make-thread))
|
||||
(skip-unless (featurep 'threads))
|
||||
(should
|
||||
(let ((m (make-mutex)))
|
||||
(eq m (condition-mutex (make-condition-variable m))))))
|
||||
|
||||
(ert-deftest threads-condvar-name ()
|
||||
"Simple test of `condition-name'."
|
||||
(skip-unless (fboundp 'make-thread))
|
||||
(skip-unless (featurep 'threads))
|
||||
(should
|
||||
(eq nil (condition-name (make-condition-variable (make-mutex))))))
|
||||
|
||||
(ert-deftest threads-condvar-name-2 ()
|
||||
"Another simple test of `condition-name'."
|
||||
(skip-unless (fboundp 'make-thread))
|
||||
(skip-unless (featurep 'threads))
|
||||
(should
|
||||
(string= "hi bob"
|
||||
(condition-name (make-condition-variable (make-mutex)
|
||||
@ -246,7 +266,7 @@
|
||||
|
||||
(ert-deftest thread-errors ()
|
||||
"Test what happens when a thread signals an error."
|
||||
(skip-unless (fboundp 'make-thread))
|
||||
(skip-unless (featurep 'threads))
|
||||
(let (th1 th2)
|
||||
(setq th1 (make-thread #'call-error "call-error"))
|
||||
(should (threadp th1))
|
||||
@ -259,7 +279,7 @@
|
||||
|
||||
(ert-deftest thread-sticky-point ()
|
||||
"Test bug #25165 with point movement in cloned buffer."
|
||||
(skip-unless (fboundp 'make-thread))
|
||||
(skip-unless (featurep 'threads))
|
||||
(with-temp-buffer
|
||||
(insert "Lorem ipsum dolor sit amet, consectetur adipiscing elit.")
|
||||
(goto-char (point-min))
|
||||
@ -270,7 +290,7 @@
|
||||
|
||||
(ert-deftest thread-signal-early ()
|
||||
"Test signaling a thread as soon as it is started by the OS."
|
||||
(skip-unless (fboundp 'make-thread))
|
||||
(skip-unless (featurep 'threads))
|
||||
(let ((thread
|
||||
(make-thread #'(lambda ()
|
||||
(while t (thread-yield))))))
|
||||
@ -291,7 +311,7 @@
|
||||
|
||||
(ert-deftest threads-condvar-wait ()
|
||||
"Test waiting on conditional variable."
|
||||
(skip-unless (fboundp 'make-thread))
|
||||
(skip-unless (featurep 'threads))
|
||||
(let ((cv-mutex (make-mutex))
|
||||
new-thread)
|
||||
;; We could have spurious threads from the previous tests still
|
||||
|
||||
Loading…
Reference in New Issue
Block a user