From: Eli Zaretskii Date: Tue, 6 Dec 2016 18:23:37 +0000 (+0200) Subject: Fix the test suite X-Git-Tag: emacs-26.0.90~1144^2~13 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=8ad92413b9349613f9815bd0aaf523896a84b479;p=emacs.git Fix the test suite * test/automated/bindings.el: Contents moved to test/src/data-tests.el. * test/automated/threads.el: Moved to test/src/thread-tests.el. --- diff --git a/test/automated/bindings.el b/test/automated/bindings.el deleted file mode 100644 index 4b88baeef40..00000000000 --- a/test/automated/bindings.el +++ /dev/null @@ -1,99 +0,0 @@ -;;; bindings.el --- tests for variable bindings - -;; 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 . - -;;; Code: - -(defvar binding-test-buffer-A (get-buffer-create "A")) -(defvar binding-test-buffer-B (get-buffer-create "B")) - -(defvar binding-test-always-local 'always) -(make-variable-buffer-local 'binding-test-always-local) - -(defvar binding-test-some-local 'some) -(with-current-buffer binding-test-buffer-A - (set (make-local-variable 'binding-test-some-local) 'local)) - -(ert-deftest binding-test-manual () - "A test case from the elisp manual." - (save-excursion - (set-buffer binding-test-buffer-A) - (let ((binding-test-some-local 'something-else)) - (should (eq binding-test-some-local 'something-else)) - (set-buffer binding-test-buffer-B) - (should (eq binding-test-some-local 'some))) - (should (eq binding-test-some-local 'some)) - (set-buffer binding-test-buffer-A) - (should (eq binding-test-some-local 'local)))) - -(ert-deftest binding-test-setq-default () - "Test that a setq-default has no effect when there is a local binding." - (save-excursion - (set-buffer binding-test-buffer-B) - ;; This variable is not local in this buffer. - (let ((binding-test-some-local 'something-else)) - (setq-default binding-test-some-local 'new-default)) - (should (eq binding-test-some-local 'some)))) - -(ert-deftest binding-test-makunbound () - "Tests of makunbound, from the manual." - (save-excursion - (set-buffer binding-test-buffer-B) - (should (boundp 'binding-test-some-local)) - (let ((binding-test-some-local 'outer)) - (let ((binding-test-some-local 'inner)) - (makunbound 'binding-test-some-local) - (should (not (boundp 'binding-test-some-local)))) - (should (and (boundp 'binding-test-some-local) - (eq binding-test-some-local 'outer)))))) - -(ert-deftest binding-test-defvar-bool () - "Test DEFVAR_BOOL" - (let ((display-hourglass 5)) - (should (eq display-hourglass t)))) - -(ert-deftest binding-test-defvar-int () - "Test DEFVAR_INT" - (should-error (setq gc-cons-threshold 5.0) :type 'wrong-type-argument)) - -(ert-deftest binding-test-set-constant-t () - "Test setting the constant t" - (should-error (setq t 'bob) :type 'setting-constant)) - -(ert-deftest binding-test-set-constant-nil () - "Test setting the constant nil" - (should-error (setq nil 'bob) :type 'setting-constant)) - -(ert-deftest binding-test-set-constant-keyword () - "Test setting a keyword constant" - (should-error (setq :keyword 'bob) :type 'setting-constant)) - -(ert-deftest binding-test-set-constant-nil () - "Test setting a keyword to itself" - (should (setq :keyword :keyword))) - -;; More tests to write - -;; kill-local-variable -;; defconst; can modify -;; defvar and defconst modify the local binding [ doesn't matter for us ] -;; various kinds of special internal forwarding objects -;; a couple examples in manual, not enough -;; frame-local vars -;; variable aliases - -;;; bindings.el ends here diff --git a/test/automated/threads.el b/test/automated/threads.el deleted file mode 100644 index c65b6425c3c..00000000000 --- a/test/automated/threads.el +++ /dev/null @@ -1,213 +0,0 @@ -;;; threads.el --- tests for threads. - -;; Copyright (C) 2012, 2013 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 . - -;;; 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))))))) - -(ert-deftest threads-join-self () - "cannot thread-join the current thread" - (should-error (thread-join (current-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-global 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))) - -(defun threads-test-io-switch () - (setq threads-test-global 23)) - -(ert-deftest threads-io-switch () - "test that accept-process-output causes thread switch" - (should - (progn - (setq threads-test-global nil) - (make-thread #'threads-test-io-switch) - (while (not threads-test-global) - (accept-process-output nil 1)) - threads-test-global))) - -(ert-deftest threads-condvarp () - "simple test of condition-variable-p" - (should-not (condition-variable-p 'hi))) - -(ert-deftest threads-condvarp-2 () - "another simple test of condition-variable-p" - (should (condition-variable-p (make-condition-variable (make-mutex))))) - -(ert-deftest threads-condvar-type () - "type-of condvar" - (should (eq (type-of (make-condition-variable (make-mutex))) - 'condition-variable))) - -(ert-deftest threads-condvar-mutex () - "simple test of condition-mutex" - (should - (let ((m (make-mutex))) - (eq m (condition-mutex (make-condition-variable m)))))) - -(ert-deftest threads-condvar-name () - "simple test of condition-name" - (should - (eq nil (condition-name (make-condition-variable (make-mutex)))))) - -(ert-deftest threads-condvar-name-2 () - "another simple test of condition-name" - (should - (string= "hi bob" - (condition-name (make-condition-variable (make-mutex) - "hi bob"))))) - -;;; threads.el ends here diff --git a/test/src/data-tests.el b/test/src/data-tests.el index 4c2ea54862c..de0b8e68321 100644 --- a/test/src/data-tests.el +++ b/test/src/data-tests.el @@ -256,6 +256,87 @@ comparing the subr with a much slower lisp implementation." (v3 (bool-vector-not v1))) (should (equal v2 v3)))) +;; Tests for variable bindings + +(defvar binding-test-buffer-A (get-buffer-create "A")) +(defvar binding-test-buffer-B (get-buffer-create "B")) + +(defvar binding-test-always-local 'always) +(make-variable-buffer-local 'binding-test-always-local) + +(defvar binding-test-some-local 'some) +(with-current-buffer binding-test-buffer-A + (set (make-local-variable 'binding-test-some-local) 'local)) + +(ert-deftest binding-test-manual () + "A test case from the elisp manual." + (save-excursion + (set-buffer binding-test-buffer-A) + (let ((binding-test-some-local 'something-else)) + (should (eq binding-test-some-local 'something-else)) + (set-buffer binding-test-buffer-B) + (should (eq binding-test-some-local 'some))) + (should (eq binding-test-some-local 'some)) + (set-buffer binding-test-buffer-A) + (should (eq binding-test-some-local 'local)))) + +(ert-deftest binding-test-setq-default () + "Test that a setq-default has no effect when there is a local binding." + (save-excursion + (set-buffer binding-test-buffer-B) + ;; This variable is not local in this buffer. + (let ((binding-test-some-local 'something-else)) + (setq-default binding-test-some-local 'new-default)) + (should (eq binding-test-some-local 'some)))) + +(ert-deftest binding-test-makunbound () + "Tests of makunbound, from the manual." + (save-excursion + (set-buffer binding-test-buffer-B) + (should (boundp 'binding-test-some-local)) + (let ((binding-test-some-local 'outer)) + (let ((binding-test-some-local 'inner)) + (makunbound 'binding-test-some-local) + (should (not (boundp 'binding-test-some-local)))) + (should (and (boundp 'binding-test-some-local) + (eq binding-test-some-local 'outer)))))) + +(ert-deftest binding-test-defvar-bool () + "Test DEFVAR_BOOL" + (let ((display-hourglass 5)) + (should (eq display-hourglass t)))) + +(ert-deftest binding-test-defvar-int () + "Test DEFVAR_INT" + (should-error (setq gc-cons-threshold 5.0) :type 'wrong-type-argument)) + +(ert-deftest binding-test-set-constant-t () + "Test setting the constant t" + (should-error (setq t 'bob) :type 'setting-constant)) + +(ert-deftest binding-test-set-constant-nil () + "Test setting the constant nil" + (should-error (setq nil 'bob) :type 'setting-constant)) + +(ert-deftest binding-test-set-constant-keyword () + "Test setting a keyword constant" + (should-error (setq :keyword 'bob) :type 'setting-constant)) + +(ert-deftest binding-test-set-constant-nil () + "Test setting a keyword to itself" + (should (setq :keyword :keyword))) + +;; More tests to write - +;; kill-local-variable +;; defconst; can modify +;; defvar and defconst modify the local binding [ doesn't matter for us ] +;; various kinds of special internal forwarding objects +;; a couple examples in manual, not enough +;; frame-local vars +;; variable aliases + +;; Tests for watchpoints + (ert-deftest data-tests-variable-watchers () (defvar data-tests-var 0) (let* ((watch-data nil) diff --git a/test/src/thread-tests.el b/test/src/thread-tests.el new file mode 100644 index 00000000000..c65b6425c3c --- /dev/null +++ b/test/src/thread-tests.el @@ -0,0 +1,213 @@ +;;; threads.el --- tests for threads. + +;; Copyright (C) 2012, 2013 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 . + +;;; 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))))))) + +(ert-deftest threads-join-self () + "cannot thread-join the current thread" + (should-error (thread-join (current-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-global 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))) + +(defun threads-test-io-switch () + (setq threads-test-global 23)) + +(ert-deftest threads-io-switch () + "test that accept-process-output causes thread switch" + (should + (progn + (setq threads-test-global nil) + (make-thread #'threads-test-io-switch) + (while (not threads-test-global) + (accept-process-output nil 1)) + threads-test-global))) + +(ert-deftest threads-condvarp () + "simple test of condition-variable-p" + (should-not (condition-variable-p 'hi))) + +(ert-deftest threads-condvarp-2 () + "another simple test of condition-variable-p" + (should (condition-variable-p (make-condition-variable (make-mutex))))) + +(ert-deftest threads-condvar-type () + "type-of condvar" + (should (eq (type-of (make-condition-variable (make-mutex))) + 'condition-variable))) + +(ert-deftest threads-condvar-mutex () + "simple test of condition-mutex" + (should + (let ((m (make-mutex))) + (eq m (condition-mutex (make-condition-variable m)))))) + +(ert-deftest threads-condvar-name () + "simple test of condition-name" + (should + (eq nil (condition-name (make-condition-variable (make-mutex)))))) + +(ert-deftest threads-condvar-name-2 () + "another simple test of condition-name" + (should + (string= "hi bob" + (condition-name (make-condition-variable (make-mutex) + "hi bob"))))) + +;;; threads.el ends here