diff options
Diffstat (limited to 'test/src')
| -rw-r--r-- | test/src/editfns-tests.el | 8 | ||||
| -rw-r--r-- | test/src/fns-tests.el | 11 | ||||
| -rw-r--r-- | test/src/regex-emacs-tests.el (renamed from test/src/regex-tests.el) | 6 | ||||
| -rw-r--r-- | test/src/thread-tests.el | 125 |
4 files changed, 104 insertions, 46 deletions
diff --git a/test/src/editfns-tests.el b/test/src/editfns-tests.el index 501e0d87818..8dee4bdc0fd 100644 --- a/test/src/editfns-tests.el +++ b/test/src/editfns-tests.el @@ -169,7 +169,13 @@ (should (eq (type-of (read (format "#o%o" most-negative-fixnum))) 'integer)) (should (eq (type-of (read (format "#32rG%x" most-positive-fixnum))) - 'integer))) + 'integer)) + (let ((binary-as-unsigned nil)) + (dolist (fmt '("%d" "%s" "#o%o" "#x%x")) + (dolist (val (list most-negative-fixnum (1+ most-negative-fixnum) + -1 0 1 + (1- most-positive-fixnum) most-positive-fixnum)) + (should (eq val (read (format fmt val)))))))) (ert-deftest format-%o-invalid-float () (should-error (format "%o" -1e-37) diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el index d560f0bb0d9..f722ed6333e 100644 --- a/test/src/fns-tests.el +++ b/test/src/fns-tests.el @@ -23,6 +23,17 @@ (require 'cl-lib) +;; Test that equality predicates work correctly on NaNs when combined +;; with hash tables based on those predicates. This was not the case +;; for eql in Emacs 26. +(ert-deftest fns-tests-equality-nan () + (dolist (test (list #'eq #'eql #'equal)) + (let* ((h (make-hash-table :test test)) + (nan 0.0e+NaN) + (-nan (- nan))) + (puthash nan t h) + (should (eq (funcall test nan -nan) (gethash -nan h)))))) + (ert-deftest fns-tests-reverse () (should-error (reverse)) (should-error (reverse 1)) diff --git a/test/src/regex-tests.el b/test/src/regex-emacs-tests.el index 083ed5c4c8c..7a075908a6b 100644 --- a/test/src/regex-tests.el +++ b/test/src/regex-emacs-tests.el @@ -1,4 +1,4 @@ -;;; regex-tests.el --- tests for regex.c functions -*- lexical-binding: t -*- +;;; regex-emacs-tests.el --- tests for regex-emacs.c -*- lexical-binding: t -*- ;; Copyright (C) 2015-2018 Free Software Foundation, Inc. @@ -24,7 +24,7 @@ (defvar regex-tests--resources-dir (concat (concat (file-name-directory (or load-file-name buffer-file-name)) "/regex-resources/")) - "Path to regex-resources directory next to the \"regex-tests.el\" file.") + "Path to regex-resources directory next to the \"regex-emacs-tests.el\" file.") (ert-deftest regex-word-cc-fallback-test () "Test that \"[[:cc:]]*x\" matches \"x\" (bug#24020). @@ -683,4 +683,4 @@ This evaluates the TESTS test cases from glibc." (should-not (string-match "\\`x\\{65535\\}" (make-string 65534 ?x))) (should-error (string-match "\\`x\\{65536\\}" "X") :type 'invalid-regexp)) -;;; regex-tests.el ends here +;;; regex-emacs-tests.el ends here diff --git a/test/src/thread-tests.el b/test/src/thread-tests.el index 0e909d3e511..364f6d61f05 100644 --- a/test/src/thread-tests.el +++ b/test/src/thread-tests.el @@ -19,38 +19,64 @@ ;;; 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" (&optional cleanup)) +(declare-function thread-name "thread.c" (thread)) +(declare-function thread-signal "thread.c" (thread error-symbol data)) +(declare-function thread-yield "thread.c" ()) +(defvar main-thread) + (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)))) +(ert-deftest threads-main-thread () + "Simple test for all-threads." + (skip-unless (featurep 'threads)) + (should (eq main-thread (car (all-threads))))) + (defvar threads-test-global nil) (defun threads-test-thread1 () @@ -58,7 +84,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,20 +95,29 @@ (ert-deftest threads-join () "Test of `thread-join'." - (skip-unless (fboundp 'make-thread)) + (skip-unless (featurep 'threads)) (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))))))) + (and (= (thread-join thread) 23) + (= threads-test-global 23) + (not (thread-alive-p thread))))))) (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)))) +(ert-deftest threads-join-error () + "Test of error signalling from `thread-join'." + :tags '(:unstable) + (skip-unless (featurep 'threads)) + (let ((thread (make-thread #'threads-call-error))) + (while (thread-alive-p thread) + (thread-yield)) + (should-error (thread-join thread)))) + (defvar threads-test-binding nil) (defun threads-test-thread2 () @@ -92,7 +127,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 +139,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 +163,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 +184,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,8 +205,8 @@ (ert-deftest threads-mutex-signal () "Test signaling a blocked thread." - (skip-unless (fboundp 'make-thread)) - (should + (skip-unless (featurep 'threads)) + (should-error (progn (setq threads-mutex (make-mutex)) (setq threads-mutex-key nil) @@ -180,15 +215,17 @@ (while (not threads-mutex-key) (thread-yield)) (thread-signal thr 'quit nil) - (thread-join thr)) - t))) + ;; `quit' is not catched by `should-error'. We must indicate it. + (condition-case nil + (thread-join thr) + (quit (signal 'error nil))))))) (defun threads-test-io-switch () (setq threads-test-global 23)) (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,67 +236,71 @@ (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) "hi bob"))))) -(defun call-error () + +(defun threads-call-error () "Call `error'." (error "Error is called")) ;; This signals an error internally; the error should be caught. -(defun thread-custom () - (defcustom thread-custom-face 'highlight +(defun threads-custom () + (defcustom threads-custom-face 'highlight "Face used for thread customizations." :type 'face :group 'widget-faces)) -(ert-deftest thread-errors () +(ert-deftest threads-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")) + (setq th1 (make-thread #'threads-call-error "call-error")) (should (threadp th1)) (while (thread-alive-p th1) (thread-yield)) (should (equal (thread-last-error) '(error "Error is called"))) - (setq th2 (make-thread #'thread-custom "thread-custom")) + (should (equal (thread-last-error 'cleanup) + '(error "Error is called"))) + (should-not (thread-last-error)) + (setq th2 (make-thread #'threads-custom "threads-custom")) (should (threadp th2)))) -(ert-deftest thread-sticky-point () +(ert-deftest threads-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)) @@ -268,9 +309,9 @@ (sit-for 1) (should (= (point) 21)))) -(ert-deftest thread-signal-early () +(ert-deftest threads-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 +332,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 |