From: Tom Tromey <tromey@redhat.com>
To: Emacs discussions <emacs-devel@gnu.org>
Subject: [PATCH 08/10] add some tests
Date: Thu, 09 Aug 2012 13:42:57 -0600 [thread overview]
Message-ID: <871ujfetry.fsf@fleche.redhat.com> (raw)
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
reply other threads:[~2012-08-09 19:42 UTC|newest]
Thread overview: [no followups] expand[flat|nested] mbox.gz Atom feed
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=871ujfetry.fsf@fleche.redhat.com \
--to=tromey@redhat.com \
--cc=emacs-devel@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.