This adds some tests of the threading code.

test/automated/threads.el

@@ -0,0 +1,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