[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[PATCH 08/10] add some tests
From: |
Tom Tromey |
Subject: |
[PATCH 08/10] add some tests |
Date: |
Thu, 09 Aug 2012 13:42:57 -0600 |
User-agent: |
Gnus/5.13 (Gnus v5.13) Emacs/24.1 (gnu/linux) |
This adds some tests of the threading code.
---
test/automated/threads.el | 165 +++++++++++++++++++++++++++++++++++++++++++++
1 files changed, 165 insertions(+), 0 deletions(-)
create mode 100644 test/automated/threads.el
diff --git a/test/automated/threads.el b/test/automated/threads.el
new file mode 100644
index 0000000..b09e269
--- /dev/null
+++ b/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
--
1.7.7.6
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [PATCH 08/10] add some tests,
Tom Tromey <=