summaryrefslogtreecommitdiff
path: root/test/src
diff options
context:
space:
mode:
Diffstat (limited to 'test/src')
-rw-r--r--test/src/alloc-tests.el2
-rw-r--r--test/src/buffer-tests.el195
-rw-r--r--test/src/casefiddle-tests.el16
-rw-r--r--test/src/comp-tests.el100
-rw-r--r--test/src/data-tests.el45
-rw-r--r--test/src/decompress-tests.el2
-rw-r--r--test/src/editfns-tests.el61
-rw-r--r--test/src/emacs-module-tests.el27
-rw-r--r--test/src/emacs-tests.el30
-rw-r--r--test/src/eval-tests.el19
-rw-r--r--test/src/filelock-tests.el49
-rw-r--r--test/src/floatfns-tests.el62
-rw-r--r--test/src/fns-tests.el83
-rw-r--r--test/src/image-tests.el244
-rw-r--r--test/src/inotify-tests.el35
-rw-r--r--test/src/keymap-tests.el119
-rw-r--r--test/src/lcms-tests.el7
-rw-r--r--test/src/lread-tests.el14
-rw-r--r--test/src/process-tests.el54
-rw-r--r--test/src/search-tests.el2
-rw-r--r--test/src/sqlite-tests.el219
-rw-r--r--test/src/thread-tests.el1
-rw-r--r--test/src/timefns-tests.el12
-rw-r--r--test/src/undo-tests.el20
-rw-r--r--test/src/xdisp-tests.el71
-rw-r--r--test/src/xml-tests.el2
26 files changed, 1152 insertions, 339 deletions
diff --git a/test/src/alloc-tests.el b/test/src/alloc-tests.el
index 04c7eea62b1..967833e1903 100644
--- a/test/src/alloc-tests.el
+++ b/test/src/alloc-tests.el
@@ -30,7 +30,7 @@
(require 'cl-lib)
(ert-deftest finalizer-object-type ()
- (should (equal (type-of (make-finalizer nil)) 'finalizer)))
+ (should (equal (type-of (make-finalizer #'ignore)) 'finalizer)))
(ert-deftest record-1 ()
(let ((x (record 'foo 1 2 3)))
diff --git a/test/src/buffer-tests.el b/test/src/buffer-tests.el
index 908bff91a0b..31a4b1ac71b 100644
--- a/test/src/buffer-tests.el
+++ b/test/src/buffer-tests.el
@@ -19,6 +19,8 @@
;;; Code:
+(require 'ert)
+(require 'ert-x)
(require 'cl-lib)
(ert-deftest overlay-modification-hooks-message-other-buf ()
@@ -145,7 +147,7 @@ with parameters from the *Messages* buffer modification."
(defmacro deftest-overlayp-1 (id arg-expr should-expr)
(declare (indent 1))
- `(ert-deftest ,(buffer-tests--make-test-name 'overlay-buffer 1 id) ()
+ `(ert-deftest ,(buffer-tests--make-test-name 'overlayp 1 id) ()
(with-temp-buffer
(should (equal ,should-expr (overlayp ,arg-expr))))))
@@ -434,14 +436,14 @@ with parameters from the *Messages* buffer modification."
(deftest-next-overlay-change-1 I 10 (point-max) (10 10))
(deftest-next-overlay-change-1 J 20 (point-max) (10 10))
;; 2 non-empty, non-intersecting
-(deftest-next-overlay-change-1 D 10 20 (20 30) (40 50))
-(deftest-next-overlay-change-1 E 35 40 (20 30) (40 50))
-(deftest-next-overlay-change-1 F 60 (point-max) (20 30) (40 50))
-(deftest-next-overlay-change-1 G 30 40 (20 30) (40 50))
-(deftest-next-overlay-change-1 H 50 (point-max) (20 30) (40 50))
+(deftest-next-overlay-change-1 D2 10 20 (20 30) (40 50))
+(deftest-next-overlay-change-1 E2 35 40 (20 30) (40 50))
+(deftest-next-overlay-change-1 F2 60 (point-max) (20 30) (40 50))
+(deftest-next-overlay-change-1 G2 30 40 (20 30) (40 50))
+(deftest-next-overlay-change-1 H2 50 (point-max) (20 30) (40 50))
;; 2 non-empty, intersecting
-(deftest-next-overlay-change-1 I 10 20 (20 30) (25 35))
-(deftest-next-overlay-change-1 J 20 25 (20 30) (25 35))
+(deftest-next-overlay-change-1 I2 10 20 (20 30) (25 35))
+(deftest-next-overlay-change-1 J2 20 25 (20 30) (25 35))
(deftest-next-overlay-change-1 K 23 25 (20 30) (25 35))
(deftest-next-overlay-change-1 L 25 30 (20 30) (25 35))
(deftest-next-overlay-change-1 M 28 30 (20 30) (25 35))
@@ -471,11 +473,11 @@ with parameters from the *Messages* buffer modification."
(deftest-next-overlay-change-1 k 30 (point-max) (20 20) (20 30))
(deftest-next-overlay-change-1 l 40 (point-max) (20 20) (20 30))
;; 1 empty, 1 non-empty, intersecting at end
-(deftest-next-overlay-change-1 h 10 20 (30 30) (20 30))
-(deftest-next-overlay-change-1 i 20 30 (30 30) (20 30))
-(deftest-next-overlay-change-1 j 25 30 (30 30) (20 30))
-(deftest-next-overlay-change-1 k 30 (point-max) (20 20) (20 30))
-(deftest-next-overlay-change-1 l 40 (point-max) (20 20) (20 30))
+(deftest-next-overlay-change-1 h2 10 20 (30 30) (20 30))
+(deftest-next-overlay-change-1 i2 20 30 (30 30) (20 30))
+(deftest-next-overlay-change-1 j2 25 30 (30 30) (20 30))
+(deftest-next-overlay-change-1 k2 30 (point-max) (20 20) (20 30))
+(deftest-next-overlay-change-1 l2 40 (point-max) (20 20) (20 30))
;; 1 empty, 1 non-empty, intersecting in the middle
(deftest-next-overlay-change-1 m 10 20 (25 25) (20 30))
(deftest-next-overlay-change-1 n 20 25 (25 25) (20 30))
@@ -522,14 +524,14 @@ with parameters from the *Messages* buffer modification."
(deftest-previous-overlay-change-1 I 10 1 (10 10))
(deftest-previous-overlay-change-1 J 20 10 (10 10))
;; 2 non-empty, non-intersecting
-(deftest-previous-overlay-change-1 D 10 1 (20 30) (40 50))
-(deftest-previous-overlay-change-1 E 35 30 (20 30) (40 50))
-(deftest-previous-overlay-change-1 F 60 50 (20 30) (40 50))
-(deftest-previous-overlay-change-1 G 30 20 (20 30) (40 50))
-(deftest-previous-overlay-change-1 H 50 40 (20 30) (40 50))
+(deftest-previous-overlay-change-1 D2 10 1 (20 30) (40 50))
+(deftest-previous-overlay-change-1 E2 35 30 (20 30) (40 50))
+(deftest-previous-overlay-change-1 F2 60 50 (20 30) (40 50))
+(deftest-previous-overlay-change-1 G2 30 20 (20 30) (40 50))
+(deftest-previous-overlay-change-1 H2 50 40 (20 30) (40 50))
;; 2 non-empty, intersecting
-(deftest-previous-overlay-change-1 I 10 1 (20 30) (25 35))
-(deftest-previous-overlay-change-1 J 20 1 (20 30) (25 35))
+(deftest-previous-overlay-change-1 I2 10 1 (20 30) (25 35))
+(deftest-previous-overlay-change-1 J2 20 1 (20 30) (25 35))
(deftest-previous-overlay-change-1 K 23 20 (20 30) (25 35))
(deftest-previous-overlay-change-1 L 25 20 (20 30) (25 35))
(deftest-previous-overlay-change-1 M 28 25 (20 30) (25 35))
@@ -619,28 +621,28 @@ with parameters from the *Messages* buffer modification."
(deftest-overlays-at-1 P 50 () (a 10 20) (b 30 40))
;; 2 non-empty overlays intersecting
-(deftest-overlays-at-1 G 1 () (a 10 30) (b 20 40))
-(deftest-overlays-at-1 H 10 (a) (a 10 30) (b 20 40))
-(deftest-overlays-at-1 I 15 (a) (a 10 30) (b 20 40))
-(deftest-overlays-at-1 K 20 (a b) (a 10 30) (b 20 40))
-(deftest-overlays-at-1 L 25 (a b) (a 10 30) (b 20 40))
-(deftest-overlays-at-1 M 30 (b) (a 10 30) (b 20 40))
-(deftest-overlays-at-1 N 35 (b) (a 10 30) (b 20 40))
-(deftest-overlays-at-1 O 40 () (a 10 30) (b 20 40))
-(deftest-overlays-at-1 P 50 () (a 10 30) (b 20 40))
+(deftest-overlays-at-1 G2 1 () (a 10 30) (b 20 40))
+(deftest-overlays-at-1 H2 10 (a) (a 10 30) (b 20 40))
+(deftest-overlays-at-1 I2 15 (a) (a 10 30) (b 20 40))
+(deftest-overlays-at-1 K2 20 (a b) (a 10 30) (b 20 40))
+(deftest-overlays-at-1 L2 25 (a b) (a 10 30) (b 20 40))
+(deftest-overlays-at-1 M2 30 (b) (a 10 30) (b 20 40))
+(deftest-overlays-at-1 N2 35 (b) (a 10 30) (b 20 40))
+(deftest-overlays-at-1 O2 40 () (a 10 30) (b 20 40))
+(deftest-overlays-at-1 P2 50 () (a 10 30) (b 20 40))
;; 2 non-empty overlays continuous
-(deftest-overlays-at-1 G 1 () (a 10 20) (b 20 30))
-(deftest-overlays-at-1 H 10 (a) (a 10 20) (b 20 30))
-(deftest-overlays-at-1 I 15 (a) (a 10 20) (b 20 30))
-(deftest-overlays-at-1 K 20 (b) (a 10 20) (b 20 30))
-(deftest-overlays-at-1 L 25 (b) (a 10 20) (b 20 30))
-(deftest-overlays-at-1 M 30 () (a 10 20) (b 20 30))
+(deftest-overlays-at-1 G3 1 () (a 10 20) (b 20 30))
+(deftest-overlays-at-1 H3 10 (a) (a 10 20) (b 20 30))
+(deftest-overlays-at-1 I3 15 (a) (a 10 20) (b 20 30))
+(deftest-overlays-at-1 K3 20 (b) (a 10 20) (b 20 30))
+(deftest-overlays-at-1 L3 25 (b) (a 10 20) (b 20 30))
+(deftest-overlays-at-1 M3 30 () (a 10 20) (b 20 30))
;; overlays-at never returns empty overlays.
-(deftest-overlays-at-1 N 1 (a) (a 1 60) (c 1 1) (b 30 30) (d 50 50))
-(deftest-overlays-at-1 O 20 (a) (a 1 60) (c 1 1) (b 30 30) (d 50 50))
-(deftest-overlays-at-1 P 30 (a) (a 1 60) (c 1 1) (b 30 30) (d 50 50))
+(deftest-overlays-at-1 N3 1 (a) (a 1 60) (c 1 1) (b 30 30) (d 50 50))
+(deftest-overlays-at-1 O3 20 (a) (a 1 60) (c 1 1) (b 30 30) (d 50 50))
+(deftest-overlays-at-1 P3 30 (a) (a 1 60) (c 1 1) (b 30 30) (d 50 50))
(deftest-overlays-at-1 Q 40 (a) (a 1 60) (c 1 1) (b 30 30) (d 50 50))
(deftest-overlays-at-1 R 50 (a) (a 1 60) (c 1 1) (b 30 30) (d 50 50))
(deftest-overlays-at-1 S 60 () (a 1 60) (c 1 1) (b 30 30) (d 50 50))
@@ -1107,7 +1109,7 @@ with parameters from the *Messages* buffer modification."
(should (eq ov (car (overlays-in 1 1)))))))))
;; properties
-(ert-deftest test-buffer-swap-text-1 ()
+(ert-deftest test-buffer-swap-text-2 ()
(buffer-tests--with-temp-buffers (buffer other)
(with-current-buffer other
(overlay-put (make-overlay 1 1) 'buffer 'other))
@@ -1421,66 +1423,63 @@ with parameters from the *Messages* buffer modification."
(should (= (length (overlays-in (point-min) (point-max))) 0))))
(ert-deftest test-kill-buffer-auto-save-default ()
- (let ((file (make-temp-file "ert"))
- auto-save)
- (should (file-exists-p file))
- ;; Always answer yes.
- (cl-letf (((symbol-function #'yes-or-no-p) (lambda (_) t)))
- (unwind-protect
- (progn
- (find-file file)
- (auto-save-mode t)
- (insert "foo\n")
- (should buffer-auto-save-file-name)
- (setq auto-save buffer-auto-save-file-name)
- (do-auto-save)
- (should (file-exists-p auto-save))
- (kill-buffer (current-buffer))
- (should (file-exists-p auto-save)))
- (ignore-errors (delete-file file))
- (when auto-save
- (ignore-errors (delete-file auto-save)))))))
+ (ert-with-temp-file file
+ (let (auto-save)
+ ;; Always answer yes.
+ (cl-letf (((symbol-function #'yes-or-no-p) (lambda (_) t)))
+ (unwind-protect
+ (progn
+ (find-file file)
+ (auto-save-mode t)
+ (insert "foo\n")
+ (should buffer-auto-save-file-name)
+ (setq auto-save buffer-auto-save-file-name)
+ (do-auto-save)
+ (should (file-exists-p auto-save))
+ (kill-buffer (current-buffer))
+ (should (file-exists-p auto-save)))
+ (when auto-save
+ (ignore-errors (delete-file auto-save))))))))
(ert-deftest test-kill-buffer-auto-save-delete ()
- (let ((file (make-temp-file "ert"))
- auto-save)
- (should (file-exists-p file))
- (setq kill-buffer-delete-auto-save-files t)
- ;; Always answer yes.
- (cl-letf (((symbol-function #'yes-or-no-p) (lambda (_) t)))
- (unwind-protect
- (progn
- (find-file file)
- (auto-save-mode t)
- (insert "foo\n")
- (should buffer-auto-save-file-name)
- (setq auto-save buffer-auto-save-file-name)
- (do-auto-save)
- (should (file-exists-p auto-save))
- ;; This should delete the auto-save file.
- (kill-buffer (current-buffer))
- (should-not (file-exists-p auto-save)))
- (ignore-errors (delete-file file))
- (when auto-save
- (ignore-errors (delete-file auto-save)))))
- ;; Answer no to deletion.
- (cl-letf (((symbol-function #'yes-or-no-p)
- (lambda (prompt)
- (not (string-search "Delete auto-save file" prompt)))))
- (unwind-protect
- (progn
- (find-file file)
- (auto-save-mode t)
- (insert "foo\n")
- (should buffer-auto-save-file-name)
- (setq auto-save buffer-auto-save-file-name)
- (do-auto-save)
- (should (file-exists-p auto-save))
- ;; This should not delete the auto-save file.
- (kill-buffer (current-buffer))
- (should (file-exists-p auto-save)))
- (ignore-errors (delete-file file))
- (when auto-save
- (ignore-errors (delete-file auto-save)))))))
+ (ert-with-temp-file file
+ (let (auto-save)
+ (should (file-exists-p file))
+ (setq kill-buffer-delete-auto-save-files t)
+ ;; Always answer yes.
+ (cl-letf (((symbol-function #'yes-or-no-p) (lambda (_) t)))
+ (unwind-protect
+ (progn
+ (find-file file)
+ (auto-save-mode t)
+ (insert "foo\n")
+ (should buffer-auto-save-file-name)
+ (setq auto-save buffer-auto-save-file-name)
+ (do-auto-save)
+ (should (file-exists-p auto-save))
+ ;; This should delete the auto-save file.
+ (kill-buffer (current-buffer))
+ (should-not (file-exists-p auto-save)))
+ (ignore-errors (delete-file file))
+ (when auto-save
+ (ignore-errors (delete-file auto-save)))))
+ ;; Answer no to deletion.
+ (cl-letf (((symbol-function #'yes-or-no-p)
+ (lambda (prompt)
+ (not (string-search "Delete auto-save file" prompt)))))
+ (unwind-protect
+ (progn
+ (find-file file)
+ (auto-save-mode t)
+ (insert "foo\n")
+ (should buffer-auto-save-file-name)
+ (setq auto-save buffer-auto-save-file-name)
+ (do-auto-save)
+ (should (file-exists-p auto-save))
+ ;; This should not delete the auto-save file.
+ (kill-buffer (current-buffer))
+ (should (file-exists-p auto-save)))
+ (when auto-save
+ (ignore-errors (delete-file auto-save))))))))
;;; buffer-tests.el ends here
diff --git a/test/src/casefiddle-tests.el b/test/src/casefiddle-tests.el
index 19a8aad9ce8..eb096f21129 100644
--- a/test/src/casefiddle-tests.el
+++ b/test/src/casefiddle-tests.el
@@ -278,4 +278,20 @@
(with-temp-buffer
(should-error (upcase-region nil nil t)))))
+(ert-deftest casefiddle-turkish ()
+ (skip-unless (member "tr_TR.utf8" (get-locale-names)))
+ ;; See bug#50752. The point is that unibyte and multibyte strings
+ ;; are upcased differently in the "dotless i" case in Turkish,
+ ;; turning ASCII into non-ASCII, which is very unusual.
+ (with-locale-environment "tr_TR.utf8"
+ (should (string-equal (downcase "I ı") "ı ı"))
+ (should (string-equal (downcase "İ i") "i̇ i"))
+ (should (string-equal (downcase "I") "i"))
+ (should (string-equal (capitalize "bIte") "Bite"))
+ (should (string-equal (capitalize "bIté") "Bıté"))
+ (should (string-equal (capitalize "indIa") "India"))
+ ;; This does not work -- it produces "Indıa".
+ ;;(should (string-equal (capitalize "indIá") "İndıa"))
+ ))
+
;;; casefiddle-tests.el ends here
diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el
index eb84262dc8e..89cb3d153d8 100644
--- a/test/src/comp-tests.el
+++ b/test/src/comp-tests.el
@@ -28,17 +28,23 @@
(require 'ert)
(require 'ert-x)
(require 'cl-lib)
+(require 'comp)
+(require 'comp-cstr)
-(defconst comp-test-src (ert-resource-file "comp-test-funcs.el"))
+(eval-and-compile
+ (defconst comp-test-src (ert-resource-file "comp-test-funcs.el"))
+ (defconst comp-test-dyn-src (ert-resource-file "comp-test-funcs-dyn.el")))
-(defconst comp-test-dyn-src (ert-resource-file "comp-test-funcs-dyn.el"))
-
-(when (featurep 'native-compile)
- (require 'comp)
+(when (native-comp-available-p)
(message "Compiling tests...")
(load (native-compile comp-test-src))
(load (native-compile comp-test-dyn-src)))
+;; Load the test code here so the compiler can check the function
+;; names used in this file.
+(require 'comp-test-funcs comp-test-src)
+(require 'comp-test-dyn-funcs comp-test-dyn-src) ;Non-standard feature name!
+
(defmacro comp-deftest (name args &rest docstring-and-body)
"Define a test for the native compiler tagging it as :nativecomp."
(declare (indent defun)
@@ -53,30 +59,32 @@
"Compile the compiler and load it to compile it-self.
Check that the resulting binaries do not differ."
:tags '(:expensive-test :nativecomp)
- (let* ((byte+native-compile t) ; FIXME HACK
- (comp-src (expand-file-name "../../../lisp/emacs-lisp/comp.el"
+ (ert-with-temp-file comp1-src
+ :suffix "-comp-stage1.el"
+ (ert-with-temp-file comp2-src
+ :suffix "-comp-stage2.el"
+ (let* ((byte+native-compile t) ; FIXME HACK
+ (comp-src (expand-file-name "../../../lisp/emacs-lisp/comp.el"
(ert-resource-directory)))
- (comp1-src (make-temp-file "stage1-" nil ".el"))
- (comp2-src (make-temp-file "stage2-" nil ".el"))
- ;; Can't use debug symbols.
- (native-comp-debug 0))
- (copy-file comp-src comp1-src t)
- (copy-file comp-src comp2-src t)
- (let ((load-no-native t))
- (load (concat comp-src "c") nil nil t t))
- (should-not (subr-native-elisp-p (symbol-function #'native-compile)))
- (message "Compiling stage1...")
- (let* ((t0 (current-time))
- (comp1-eln (native-compile comp1-src)))
- (message "Done in %d secs" (float-time (time-since t0)))
- (load comp1-eln nil nil t t)
- (should (subr-native-elisp-p (symbol-function 'native-compile)))
- (message "Compiling stage2...")
- (let ((t0 (current-time))
- (comp2-eln (native-compile comp2-src)))
- (message "Done in %d secs" (float-time (time-since t0)))
- (message "Comparing %s %s" comp1-eln comp2-eln)
- (should (= (call-process "cmp" nil nil nil comp1-eln comp2-eln) 0))))))
+ ;; Can't use debug symbols.
+ (native-comp-debug 0))
+ (copy-file comp-src comp1-src t)
+ (copy-file comp-src comp2-src t)
+ (let ((load-no-native t))
+ (load (concat comp-src "c") nil nil t t))
+ (should-not (subr-native-elisp-p (symbol-function 'native-compile)))
+ (message "Compiling stage1...")
+ (let* ((t0 (current-time))
+ (comp1-eln (native-compile comp1-src)))
+ (message "Done in %d secs" (float-time (time-since t0)))
+ (load comp1-eln nil nil t t)
+ (should (subr-native-elisp-p (symbol-function 'native-compile)))
+ (message "Compiling stage2...")
+ (let ((t0 (current-time))
+ (comp2-eln (native-compile comp2-src)))
+ (message "Done in %d secs" (float-time (time-since t0)))
+ (message "Comparing %s %s" comp1-eln comp2-eln)
+ (should (= (call-process "cmp" nil nil nil comp1-eln comp2-eln) 0))))))))
(comp-deftest provide ()
"Testing top level provide."
@@ -350,6 +358,8 @@ Check that the resulting binaries do not differ."
comp-test-interactive-form2-f)))
(should-not (commandp #'comp-tests-doc-f)))
+(declare-function comp-tests-free-fun-f nil)
+
(comp-deftest free-fun ()
"Check we are able to compile a single function."
(eval '(defun comp-tests-free-fun-f ()
@@ -359,7 +369,7 @@ Check that the resulting binaries do not differ."
t)
(native-compile #'comp-tests-free-fun-f)
- (should (subr-native-elisp-p (symbol-function #'comp-tests-free-fun-f)))
+ (should (subr-native-elisp-p (symbol-function 'comp-tests-free-fun-f)))
(should (= (comp-tests-free-fun-f) 3))
(should (string= (documentation #'comp-tests-free-fun-f)
"Some doc."))
@@ -367,11 +377,13 @@ Check that the resulting binaries do not differ."
(should (equal (interactive-form #'comp-tests-free-fun-f)
'(interactive))))
+(declare-function comp-tests/free\fun-f nil)
+
(comp-deftest free-fun-silly-name ()
"Check we are able to compile a single function."
(eval '(defun comp-tests/free\fun-f ()) t)
(native-compile #'comp-tests/free\fun-f)
- (should (subr-native-elisp-p (symbol-function #'comp-tests/free\fun-f))))
+ (should (subr-native-elisp-p (symbol-function 'comp-tests/free\fun-f))))
(comp-deftest bug-40187 ()
"Check function name shadowing.
@@ -382,7 +394,7 @@ https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-03/msg00914.html."
(comp-deftest speed--1 ()
"Check that at speed -1 we do not native compile."
(should (= (comp-test-speed--1-f) 3))
- (should-not (subr-native-elisp-p (symbol-function #'comp-test-speed--1-f))))
+ (should-not (subr-native-elisp-p (symbol-function 'comp-test-speed--1-f))))
(comp-deftest bug-42360 ()
"<https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-07/msg00418.html>."
@@ -431,7 +443,7 @@ https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-03/msg00914.html."
(comp-deftest primitive-redefine ()
"Test effectiveness of primitive redefinition."
(cl-letf ((comp-test-primitive-redefine-args nil)
- ((symbol-function #'-)
+ ((symbol-function '-)
(lambda (&rest args)
(setq comp-test-primitive-redefine-args args)
'xxx)))
@@ -452,11 +464,11 @@ https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-03/msg00914.html."
(comp-deftest comp-test-defsubst ()
;; Bug#42664, Bug#43280, Bug#44209.
- (should-not (subr-native-elisp-p (symbol-function #'comp-test-defsubst-f))))
+ (should-not (subr-native-elisp-p (symbol-function 'comp-test-defsubst-f))))
(comp-deftest primitive-redefine-compile-44221 ()
"Test the compiler still works while primitives are redefined (bug#44221)."
- (cl-letf (((symbol-function #'delete-region)
+ (cl-letf (((symbol-function 'delete-region)
(lambda (_ _))))
(should (subr-native-elisp-p
(native-compile
@@ -492,12 +504,12 @@ https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-03/msg00914.html."
(comp-deftest 45603-1 ()
"<https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-12/msg01994.html>"
(load (native-compile (ert-resource-file "comp-test-45603.el")))
- (should (fboundp #'comp-test-45603--file-local-name)))
+ (should (fboundp 'comp-test-45603--file-local-name)))
(comp-deftest 46670-1 ()
"<https://lists.gnu.org/archive/html/bug-gnu-emacs/2021-02/msg01413.html>"
(should (string= (comp-test-46670-2-f "foo") "foo"))
- (should (equal (subr-type (symbol-function #'comp-test-46670-2-f))
+ (should (equal (subr-type (symbol-function 'comp-test-46670-2-f))
'(function (t) t))))
(comp-deftest 46824-1 ()
@@ -727,7 +739,7 @@ https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-03/msg00914.html."
(comp-deftest dynamic-help-arglist ()
"Test `help-function-arglist' works on lisp/d (bug#42572)."
(should (equal (help-function-arglist
- (symbol-function #'comp-tests-ffuncall-callee-opt-rest-dyn-f)
+ (symbol-function 'comp-tests-ffuncall-callee-opt-rest-dyn-f)
t)
'(a b &optional c &rest d))))
@@ -784,6 +796,8 @@ Return a list of results."
(comp-tests-mentioned-p (comp-c-func-name 'comp-tests-tco-f "F" t)
insn)))))))
+(declare-function comp-tests-tco-f nil)
+
(comp-deftest tco ()
"Check for tail recursion elimination."
(let ((native-comp-speed 3)
@@ -798,7 +812,7 @@ Return a list of results."
(comp-tests-tco-f (+ a b) a (- count 1))))
t)
(native-compile #'comp-tests-tco-f)
- (should (subr-native-elisp-p (symbol-function #'comp-tests-tco-f)))
+ (should (subr-native-elisp-p (symbol-function 'comp-tests-tco-f)))
(should (= (comp-tests-tco-f 1 0 10) 55))))
(defun comp-tests-fw-prop-checker-1 (_)
@@ -812,6 +826,8 @@ Return a list of results."
(or (comp-tests-mentioned-p 'concat insn)
(comp-tests-mentioned-p 'length insn)))))))
+(declare-function comp-tests-fw-prop-1-f nil)
+
(comp-deftest fw-prop-1 ()
"Some tests for forward propagation."
(let ((native-comp-speed 2)
@@ -823,7 +839,7 @@ Return a list of results."
(length c))) ; <= has to optimize
t)
(native-compile #'comp-tests-fw-prop-1-f)
- (should (subr-native-elisp-p (symbol-function #'comp-tests-fw-prop-1-f)))
+ (should (subr-native-elisp-p (symbol-function 'comp-tests-fw-prop-1-f)))
(should (= (comp-tests-fw-prop-1-f) 6))))
(defun comp-tests-check-ret-type-spec (func-form ret-type)
@@ -1403,11 +1419,13 @@ folded."
(comp-post-pass-hooks '((comp-final comp-tests-pure-checker-1
comp-tests-pure-checker-2))))
(load (native-compile (ert-resource-file "comp-test-pure.el")))
+ (declare-function comp-tests-pure-caller-f nil)
+ (declare-function comp-tests-pure-fibn-entry-f nil)
- (should (subr-native-elisp-p (symbol-function #'comp-tests-pure-caller-f)))
+ (should (subr-native-elisp-p (symbol-function 'comp-tests-pure-caller-f)))
(should (= (comp-tests-pure-caller-f) 4))
- (should (subr-native-elisp-p (symbol-function #'comp-tests-pure-fibn-entry-f)))
+ (should (subr-native-elisp-p (symbol-function 'comp-tests-pure-fibn-entry-f)))
(should (= (comp-tests-pure-fibn-entry-f) 6765))))
(defvar comp-tests-cond-rw-checked-function nil
diff --git a/test/src/data-tests.el b/test/src/data-tests.el
index 6de178743e6..7d8535f5f37 100644
--- a/test/src/data-tests.el
+++ b/test/src/data-tests.el
@@ -419,7 +419,7 @@ comparing the subr with a much slower Lisp implementation."
"Test setting a keyword constant."
(with-no-warnings (should-error (setq :keyword 'bob) :type 'setting-constant)))
-(ert-deftest binding-test-set-constant-nil ()
+(ert-deftest binding-test-set-constant-itself ()
"Test setting a keyword to itself."
(with-no-warnings (should (setq :keyword :keyword))))
@@ -433,26 +433,27 @@ comparing the subr with a much slower Lisp implementation."
;; More specifically, test the problem seen in bug#41029 where setting
;; the default value of a variable takes time proportional to the
;; number of buffers.
- (let* ((fun #'error)
- (test (lambda ()
- (with-temp-buffer
- (let ((st (car (current-cpu-time))))
- (dotimes (_ 1000)
- (let ((case-fold-search 'data-test))
- ;; Use an indirection through a mutable var
- ;; to try and make sure the byte-compiler
- ;; doesn't optimize away the let bindings.
- (funcall fun)))
- ;; FIXME: Handle the wraparound, if any.
- (- (car (current-cpu-time)) st)))))
- (_ (setq fun #'ignore))
- (time1 (funcall test))
- (bufs (mapcar (lambda (_) (generate-new-buffer " data-test"))
- (make-list 1000 nil)))
- (time2 (funcall test)))
- (mapc #'kill-buffer bufs)
- ;; Don't divide one time by the other since they may be 0.
- (should (< time2 (* time1 5)))))
+ (when (fboundp 'current-cpu-time) ; silence byte-compiler
+ (let* ((fun #'error)
+ (test (lambda ()
+ (with-temp-buffer
+ (let ((st (car (current-cpu-time))))
+ (dotimes (_ 1000)
+ (let ((case-fold-search 'data-test))
+ ;; Use an indirection through a mutable var
+ ;; to try and make sure the byte-compiler
+ ;; doesn't optimize away the let bindings.
+ (funcall fun)))
+ ;; FIXME: Handle the wraparound, if any.
+ (- (car (current-cpu-time)) st)))))
+ (_ (setq fun #'ignore))
+ (time1 (funcall test))
+ (bufs (mapcar (lambda (_) (generate-new-buffer " data-test"))
+ (make-list 1000 nil)))
+ (time2 (funcall test)))
+ (mapc #'kill-buffer bufs)
+ ;; Don't divide one time by the other since they may be 0.
+ (should (< time2 (* time1 5))))))
;; More tests to write -
;; kill-local-variable
@@ -690,7 +691,7 @@ comparing the subr with a much slower Lisp implementation."
(let ((n (* 2 most-negative-fixnum)))
(should (= (logand -1 n) n))))
-(ert-deftest data-tests-logcount ()
+(ert-deftest data-tests-logcount-2 ()
(should (= (logcount (read "#xffffffffffffffffffffffffffffffff")) 128)))
(ert-deftest data-tests-logior ()
diff --git a/test/src/decompress-tests.el b/test/src/decompress-tests.el
index b910709183f..47d67b7bda4 100644
--- a/test/src/decompress-tests.el
+++ b/test/src/decompress-tests.el
@@ -23,6 +23,8 @@
(require 'ert)
+(declare-function zlib-decompress-region "decompress.c")
+
(defvar zlib-tests-data-directory
(expand-file-name "data/decompress" (getenv "EMACS_TEST_DIRECTORY"))
"Directory containing zlib test data.")
diff --git a/test/src/editfns-tests.el b/test/src/editfns-tests.el
index a3dd7bd466a..5fe896fbbd1 100644
--- a/test/src/editfns-tests.el
+++ b/test/src/editfns-tests.el
@@ -23,16 +23,16 @@
(ert-deftest format-properties ()
;; Bug #23730
- (should (ert-equal-including-properties
+ (should (equal-including-properties
(format (propertize "%d" 'face '(:background "red")) 1)
#("1" 0 1 (face (:background "red")))))
- (should (ert-equal-including-properties
+ (should (equal-including-properties
(format (propertize "%2d" 'face '(:background "red")) 1)
#(" 1" 0 2 (face (:background "red")))))
- (should (ert-equal-including-properties
+ (should (equal-including-properties
(format (propertize "%02d" 'face '(:background "red")) 1)
#("01" 0 2 (face (:background "red")))))
- (should (ert-equal-including-properties
+ (should (equal-including-properties
(format (concat (propertize "%2d" 'x 'X)
(propertize "a" 'a 'A)
(propertize "b" 'b 'B))
@@ -40,27 +40,27 @@
#(" 1ab" 0 2 (x X) 2 3 (a A) 3 4 (b B))))
;; Bug #5306
- (should (ert-equal-including-properties
+ (should (equal-including-properties
(format "%.10s"
(concat "1234567890aaaa"
(propertize "12345678901234567890" 'xxx 25)))
"1234567890"))
- (should (ert-equal-including-properties
+ (should (equal-including-properties
(format "%.10s"
(concat "123456789"
(propertize "12345678901234567890" 'xxx 25)))
#("1234567891" 9 10 (xxx 25))))
;; Bug #23859
- (should (ert-equal-including-properties
+ (should (equal-including-properties
(format "%4s" (propertize "hi" 'face 'bold))
#(" hi" 2 4 (face bold))))
;; Bug #23897
- (should (ert-equal-including-properties
+ (should (equal-including-properties
(format "%s" (concat (propertize "01234" 'face 'bold) "56789"))
#("0123456789" 0 5 (face bold))))
- (should (ert-equal-including-properties
+ (should (equal-including-properties
(format "%s" (concat (propertize "01" 'face 'bold)
(propertize "23" 'face 'underline)
"45"))
@@ -68,63 +68,63 @@
;; The last property range is extended to include padding on the
;; right, but the first range is not extended to the left to include
;; padding on the left!
- (should (ert-equal-including-properties
+ (should (equal-including-properties
(format "%12s" (concat (propertize "01234" 'face 'bold) "56789"))
#(" 0123456789" 2 7 (face bold))))
- (should (ert-equal-including-properties
+ (should (equal-including-properties
(format "%-12s" (concat (propertize "01234" 'face 'bold) "56789"))
#("0123456789 " 0 5 (face bold))))
- (should (ert-equal-including-properties
+ (should (equal-including-properties
(format "%10s" (concat (propertize "01" 'face 'bold)
(propertize "23" 'face 'underline)
"45"))
#(" 012345" 4 6 (face bold) 6 8 (face underline))))
- (should (ert-equal-including-properties
+ (should (equal-including-properties
(format "%-10s" (concat (propertize "01" 'face 'bold)
(propertize "23" 'face 'underline)
"45"))
#("012345 " 0 2 (face bold) 2 4 (face underline))))
- (should (ert-equal-including-properties
+ (should (equal-including-properties
(format "%-10s" (concat (propertize "01" 'face 'bold)
(propertize "23" 'face 'underline)
(propertize "45" 'face 'italic)))
#("012345 "
0 2 (face bold) 2 4 (face underline) 4 10 (face italic))))
;; Bug #38191
- (should (ert-equal-including-properties
+ (should (equal-including-properties
(format (propertize "‘foo’ %s bar" 'face 'bold) "xxx")
#("‘foo’ xxx bar" 0 13 (face bold))))
;; Bug #32404
- (should (ert-equal-including-properties
+ (should (equal-including-properties
(format (concat (propertize "%s" 'face 'bold)
""
(propertize "%s" 'face 'error))
"foo" "bar")
#("foobar" 0 3 (face bold) 3 6 (face error))))
- (should (ert-equal-including-properties
+ (should (equal-including-properties
(format (concat "%s" (propertize "%s" 'face 'error)) "foo" "bar")
#("foobar" 3 6 (face error))))
- (should (ert-equal-including-properties
+ (should (equal-including-properties
(format (concat "%s " (propertize "%s" 'face 'error)) "foo" "bar")
#("foo bar" 4 7 (face error))))
;; Bug #46317
(let ((s (propertize "X" 'prop "val")))
- (should (ert-equal-including-properties
+ (should (equal-including-properties
(format (concat "%3s/" s) 12)
#(" 12/X" 4 5 (prop "val"))))
- (should (ert-equal-including-properties
+ (should (equal-including-properties
(format (concat "%3S/" s) 12)
#(" 12/X" 4 5 (prop "val"))))
- (should (ert-equal-including-properties
+ (should (equal-including-properties
(format (concat "%3d/" s) 12)
#(" 12/X" 4 5 (prop "val"))))
- (should (ert-equal-including-properties
+ (should (equal-including-properties
(format (concat "%-3s/" s) 12)
#("12 /X" 4 5 (prop "val"))))
- (should (ert-equal-including-properties
+ (should (equal-including-properties
(format (concat "%-3S/" s) 12)
#("12 /X" 4 5 (prop "val"))))
- (should (ert-equal-including-properties
+ (should (equal-including-properties
(format (concat "%-3d/" s) 12)
#("12 /X" 4 5 (prop "val"))))))
@@ -413,4 +413,17 @@
(translate-region-internal (point-min) (point-max) tt)
(should (string-equal (buffer-string) "*")))))
+(ert-deftest find-fields ()
+ (with-temp-buffer
+ (insert "foo" (propertize "bar" 'field 'bar) "zot")
+ (goto-char (point-min))
+ (should (= (field-beginning) (point-min)))
+ (should (= (field-end) 4))
+ (goto-char 5)
+ (should (= (field-beginning) 4))
+ (should (= (field-end) 7))
+ (goto-char 8)
+ (should (= (field-beginning) 7))
+ (should (= (field-end) (point-max)))))
+
;;; editfns-tests.el ends here
diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el
index 57321a951de..2ff33644a8e 100644
--- a/test/src/emacs-module-tests.el
+++ b/test/src/emacs-module-tests.el
@@ -32,6 +32,11 @@
(require 'help-fns)
(require 'subr-x)
+;; Catch information for bug#50902.
+(when (getenv "EMACS_EMBA_CI")
+ (start-process-shell-command
+ "*timeout*" nil (format "sleep 60; kill -ABRT %d" (emacs-pid))))
+
(defconst mod-test-emacs
(expand-file-name invocation-name invocation-directory)
"File name of the Emacs binary currently running.")
@@ -206,20 +211,6 @@ changes."
(should (equal (help-function-arglist #'mod-test-sum)
'(arg1 arg2))))
-(defmacro module--with-temp-directory (name &rest body)
- "Bind NAME to the name of a temporary directory and evaluate BODY.
-NAME must be a symbol. Delete the temporary directory after BODY
-exits normally or non-locally. NAME will be bound to the
-directory name (not the directory file name) of the temporary
-directory."
- (declare (indent 1))
- (cl-check-type name symbol)
- `(let ((,name (file-name-as-directory
- (make-temp-file "emacs-module-test" :directory))))
- (unwind-protect
- (progn ,@body)
- (delete-directory ,name :recursive))))
-
(defmacro module--test-assertion (pattern &rest body)
"Test that PATTERN matches the assertion triggered by BODY.
Run Emacs as a subprocess, load the test module `mod-test-file',
@@ -228,7 +219,7 @@ assertion message that matches PATTERN. PATTERN is evaluated and
must evaluate to a regular expression string."
(declare (indent 1))
;; To contain any core dumps.
- `(module--with-temp-directory tempdir
+ `(ert-with-temp-directory tempdir
(with-temp-buffer
(let* ((default-directory tempdir)
(status (call-process mod-test-emacs nil t nil
@@ -256,6 +247,7 @@ must evaluate to a regular expression string."
(ert-deftest module--test-assertions--load-non-live-object ()
"Check that -module-assertions verify that non-live objects aren't accessed."
+ :tags (if (getenv "EMACS_EMBA_CI") '(:unstable))
(skip-unless (or (file-executable-p mod-test-emacs)
(and (eq system-type 'windows-nt)
(file-executable-p (concat mod-test-emacs ".exe")))))
@@ -274,6 +266,7 @@ must evaluate to a regular expression string."
This differs from `module--test-assertions-load-non-live-object'
in that it stows away a global reference. The module assertions
should nevertheless detect the invalid load."
+ :tags (if (getenv "EMACS_EMBA_CI") '(:unstable))
(skip-unless (or (file-executable-p mod-test-emacs)
(and (eq system-type 'windows-nt)
(file-executable-p (concat mod-test-emacs ".exe")))))
@@ -290,6 +283,7 @@ should nevertheless detect the invalid load."
(ert-deftest module--test-assertions--call-emacs-from-gc ()
"Check that -module-assertions prevents calling Emacs functions
during garbage collection."
+ :tags (if (getenv "EMACS_EMBA_CI") '(:unstable))
(skip-unless (or (file-executable-p mod-test-emacs)
(and (eq system-type 'windows-nt)
(file-executable-p (concat mod-test-emacs ".exe")))))
@@ -301,7 +295,8 @@ during garbage collection."
(ert-deftest module--test-assertions--globref-invalid-free ()
"Check that -module-assertions detects invalid freeing of a
local reference."
- (skip-unless (or (file-executable-p mod-test-emacs)
+ :tags (if (getenv "EMACS_EMBA_CI") '(:unstable))
+ (skip-unless (or (file-executable-p mod-test-emacs)
(and (eq system-type 'windows-nt)
(file-executable-p (concat mod-test-emacs ".exe")))))
(module--test-assertion
diff --git a/test/src/emacs-tests.el b/test/src/emacs-tests.el
index 930cc9fa214..52888135c12 100644
--- a/test/src/emacs-tests.el
+++ b/test/src/emacs-tests.el
@@ -25,6 +25,7 @@
(require 'cl-lib)
(require 'ert)
+(require 'ert-x) ; ert-with-temp-file
(require 'rx)
(require 'subr-x)
@@ -46,22 +47,6 @@
"--seccomp=/does-not-exist.bpf")
0))))
-(cl-defmacro emacs-tests--with-temp-file
- (var (prefix &optional suffix text) &rest body)
- "Evaluate BODY while a new temporary file exists.
-Bind VAR to the name of the file. Pass PREFIX, SUFFIX, and TEXT
-to `make-temp-file', which see."
- (declare (indent 2) (debug (symbolp (form form form) body)))
- (cl-check-type var symbol)
- ;; Use an uninterned symbol so that the code still works if BODY
- ;; changes VAR.
- (let ((filename (make-symbol "filename")))
- `(let ((,filename (make-temp-file ,prefix nil ,suffix ,text)))
- (unwind-protect
- (let ((,var ,filename))
- ,@body)
- (delete-file ,filename)))))
-
(ert-deftest emacs-tests/seccomp/empty-file ()
(skip-unless (string-match-p (rx bow "SECCOMP" eow)
system-configuration-features))
@@ -69,7 +54,8 @@ to `make-temp-file', which see."
(expand-file-name invocation-name invocation-directory))
(process-environment nil))
(skip-unless (file-executable-p emacs))
- (emacs-tests--with-temp-file filter ("seccomp-invalid-" ".bpf")
+ (ert-with-temp-file filter
+ :prefix "seccomp-invalid-" :suffix ".bpf"
;; The --seccomp option is processed early, without filename
;; handlers. Therefore remote or quoted filenames wouldn't
;; work.
@@ -94,9 +80,9 @@ to `make-temp-file', which see."
;; Either 8 or 16, but 16 should be large enough in all cases.
(filter-size 16))
(skip-unless (file-executable-p emacs))
- (emacs-tests--with-temp-file
- filter ("seccomp-too-large-" ".bpf"
- (make-string (* (1+ ushort-max) filter-size) ?a))
+ (ert-with-temp-file filter
+ :prefix "seccomp-too-large-" :suffix ".bpf"
+ :text (make-string (* (1+ ushort-max) filter-size) ?a)
;; The --seccomp option is processed early, without filename
;; handlers. Therefore remote or quoted filenames wouldn't
;; work.
@@ -117,8 +103,8 @@ to `make-temp-file', which see."
(expand-file-name invocation-name invocation-directory))
(process-environment nil))
(skip-unless (file-executable-p emacs))
- (emacs-tests--with-temp-file filter ("seccomp-invalid-" ".bpf"
- "123456")
+ (ert-with-temp-file filter
+ :prefix "seccomp-invalid-" :suffix ".bpf" :text "123456"
;; The --seccomp option is processed early, without filename
;; handlers. Therefore remote or quoted filenames wouldn't
;; work.
diff --git a/test/src/eval-tests.el b/test/src/eval-tests.el
index 797d5a6f7a6..e4230c10efd 100644
--- a/test/src/eval-tests.el
+++ b/test/src/eval-tests.el
@@ -86,23 +86,27 @@ Bug#24912."
(ert-deftest eval-tests--if-dot-string ()
"Check that Emacs rejects (if . \"string\")."
- (should-error (eval '(if . "abc")) :type 'wrong-type-argument)
+ (should-error (eval '(if . "abc") nil) :type 'wrong-type-argument)
+ (should-error (eval '(if . "abc") t) :type 'wrong-type-argument)
(let ((if-tail (list '(setcdr if-tail "abc") t)))
- (should-error (eval (cons 'if if-tail))))
+ (should-error (eval (cons 'if if-tail) nil) :type 'void-variable)
+ (should-error (eval (cons 'if if-tail) t) :type 'void-variable))
(let ((if-tail (list '(progn (setcdr if-tail "abc") nil) t)))
- (should-error (eval (cons 'if if-tail)))))
+ (should-error (eval (cons 'if if-tail) nil) :type 'void-variable)
+ (should-error (eval (cons 'if if-tail) t) :type 'void-variable)))
(ert-deftest eval-tests--let-with-circular-defs ()
"Check that Emacs reports an error for (let VARS ...) when VARS is circular."
(let ((vars (list 'v)))
(setcdr vars vars)
(dolist (let-sym '(let let*))
- (should-error (eval (list let-sym vars))))))
+ (should-error (eval (list let-sym vars) nil)))))
(ert-deftest eval-tests--mutating-cond ()
"Check that Emacs doesn't crash on a cond clause that mutates during eval."
(let ((clauses (list '((progn (setcdr clauses "ouch") nil)))))
- (should-error (eval (cons 'cond clauses)))))
+ (should-error (eval (cons 'cond clauses) nil))
+ (should-error (eval (cons 'cond clauses) t))))
(defun eval-tests--exceed-specbind-limit ()
(defvar eval-tests--var1)
@@ -179,12 +183,13 @@ are found on the stack and therefore not garbage collected."
"Remove the Lisp reference to the byte-compiled object."
(setf (symbol-function #'eval-tests-33014-func) nil))
-(defun eval-tests-19790-backquote-comma-dot-substitution ()
+(ert-deftest eval-tests-19790-backquote-comma-dot-substitution ()
"Regression test for Bug#19790.
Don't handle destructive splicing in backquote expressions (like
in Common Lisp). Instead, make sure substitution in backquote
expressions works for identifiers starting with period."
- (should (equal (let ((.x 'identity)) (eval `(,.x 'ok))) 'ok)))
+ (should (equal (let ((.x 'identity)) (eval `(,.x 'ok) nil)) 'ok))
+ (should (equal (let ((.x 'identity)) (eval `(,.x 'ok) t)) 'ok)))
(ert-deftest eval-tests/backtrace-in-batch-mode ()
(let ((emacs (expand-file-name invocation-name invocation-directory)))
diff --git a/test/src/filelock-tests.el b/test/src/filelock-tests.el
index ae59d2ddc11..21478a1a0f2 100644
--- a/test/src/filelock-tests.el
+++ b/test/src/filelock-tests.el
@@ -28,6 +28,7 @@
(require 'cl-macs)
(require 'ert)
+(require 'ert-x)
(require 'seq)
(defun filelock-tests--fixture (test-function)
@@ -36,22 +37,20 @@ Create a test directory and a buffer whose `buffer-file-name' and
`buffer-file-truename' are a file within it, then call
TEST-FUNCTION. Finally, delete the buffer and the test
directory."
- (let* ((temp-dir (make-temp-file "filelock-tests" t))
- (name (concat (file-name-as-directory temp-dir)
- "userfile"))
- (create-lockfiles t))
- (unwind-protect
- (with-temp-buffer
- (setq buffer-file-name name
- buffer-file-truename name)
- (unwind-protect
- (save-current-buffer
- (funcall test-function))
- ;; Set `buffer-file-truename' nil to prevent unlocking,
- ;; which might prompt the user and/or signal errors.
- (setq buffer-file-name nil
- buffer-file-truename nil)))
- (delete-directory temp-dir t nil))))
+ (ert-with-temp-directory temp-dir
+ (let ((name (concat (file-name-as-directory temp-dir)
+ "userfile"))
+ (create-lockfiles t))
+ (with-temp-buffer
+ (setq buffer-file-name name
+ buffer-file-truename name)
+ (unwind-protect
+ (save-current-buffer
+ (funcall test-function))
+ ;; Set `buffer-file-truename' nil to prevent unlocking,
+ ;; which might prompt the user and/or signal errors.
+ (setq buffer-file-name nil
+ buffer-file-truename nil))))))
(defun filelock-tests--make-lock-name (file-name)
"Return the lock file name for FILE-NAME.
@@ -124,7 +123,9 @@ the case)."
(filelock-tests--spoil-lock-file buffer-file-truename)
(let ((err (should-error (file-locked-p (buffer-file-name)))))
(should (equal (seq-subseq err 0 2)
- '(file-error "Testing file lock")))))))
+ (if (eq system-type 'windows-nt)
+ '(permission-denied "Testing file lock")
+ '(file-error "Testing file lock"))))))))
(ert-deftest filelock-tests-unlock-spoiled ()
"Check that `unlock-buffer' fails if the lockfile is \"spoiled\"."
@@ -145,8 +146,11 @@ the case)."
(lambda (err) (push err errors))))
(unlock-buffer))
(should (consp errors))
- (should (equal '(file-error "Unlocking file")
- (seq-subseq (car errors) 0 2)))
+ (should (equal
+ (if (eq system-type 'windows-nt)
+ '(permission-denied "Unlocking file")
+ '(file-error "Unlocking file"))
+ (seq-subseq (car errors) 0 2)))
(should (equal (length errors) 1))))))
(ert-deftest filelock-tests-kill-buffer-spoiled ()
@@ -175,8 +179,11 @@ the case)."
(lambda (err) (push err errors))))
(kill-buffer))
(should (consp errors))
- (should (equal '(file-error "Unlocking file")
- (seq-subseq (car errors) 0 2)))
+ (should (equal
+ (if (eq system-type 'windows-nt)
+ '(permission-denied "Unlocking file")
+ '(file-error "Unlocking file"))
+ (seq-subseq (car errors) 0 2)))
(should (equal (length errors) 1))))))
(provide 'filelock-tests)
diff --git a/test/src/floatfns-tests.el b/test/src/floatfns-tests.el
index d887939c999..aa709e3c2f5 100644
--- a/test/src/floatfns-tests.el
+++ b/test/src/floatfns-tests.el
@@ -21,6 +21,68 @@
(require 'ert)
+(ert-deftest floatfns-tests-cos ()
+ (should (= (cos 0) 1.0))
+ (should (= (cos float-pi) -1.0)))
+
+(ert-deftest floatfns-tests-sin ()
+ (should (= (sin 0) 0.0)))
+
+(ert-deftest floatfns-tests-tan ()
+ (should (= (tan 0) 0.0)))
+
+(ert-deftest floatfns-tests-isnan ()
+ (should (isnan 0.0e+NaN))
+ (should (isnan -0.0e+NaN))
+ (should-error (isnan "foo") :type 'wrong-type-argument))
+
+(ert-deftest floatfns-tests-exp ()
+ (should (= (exp 0) 1.0)))
+
+(ert-deftest floatfns-tests-expt ()
+ (should (= (expt 2 8) 256)))
+
+(ert-deftest floatfns-tests-log ()
+ (should (= (log 1000 10) 3.0)))
+
+(ert-deftest floatfns-tests-sqrt ()
+ (should (= (sqrt 25) 5)))
+
+(ert-deftest floatfns-tests-abs ()
+ (should (= (abs 10) 10))
+ (should (= (abs -10) 10)))
+
+(ert-deftest floatfns-tests-logb ()
+ (should (= (logb 10000) 13)))
+
+(ert-deftest floatfns-tests-ceiling ()
+ (should (= (ceiling 0.5) 1)))
+
+(ert-deftest floatfns-tests-floor ()
+ (should (= (floor 1.5) 1)))
+
+(ert-deftest floatfns-tests-round ()
+ (should (= (round 1.49999999999) 1))
+ (should (= (round 1.50000000000) 2))
+ (should (= (round 1.50000000001) 2)))
+
+(ert-deftest floatfns-tests-truncate ()
+ (should (= (truncate float-pi) 3)))
+
+(ert-deftest floatfns-tests-fceiling ()
+ (should (= (fceiling 0.5) 1.0)))
+
+(ert-deftest floatfns-tests-ffloor ()
+ (should (= (ffloor 1.5) 1.0)))
+
+(ert-deftest floatfns-tests-fround ()
+ (should (= (fround 1.49999999999) 1.0))
+ (should (= (fround 1.50000000000) 2.0))
+ (should (= (fround 1.50000000001) 2.0)))
+
+(ert-deftest floatfns-tests-ftruncate ()
+ (should (= (ftruncate float-pi) 3.0)))
+
(ert-deftest divide-extreme-sign ()
(should (= (ceiling most-negative-fixnum -1.0) (- most-negative-fixnum)))
(should (= (floor most-negative-fixnum -1.0) (- most-negative-fixnum)))
diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el
index 4d59f349bab..f74e925d3b6 100644
--- a/test/src/fns-tests.el
+++ b/test/src/fns-tests.el
@@ -23,6 +23,29 @@
(require 'cl-lib)
+(ert-deftest fns-tests-identity ()
+ (let ((num 12345)) (should (eq (identity num) num)))
+ (let ((str "foo")) (should (eq (identity str) str)))
+ (let ((lst '(11))) (should (eq (identity lst) lst))))
+
+(ert-deftest fns-tests-random ()
+ (should (integerp (random)))
+ (should (>= (random 10) 0))
+ (should (< (random 10) 10)))
+
+(ert-deftest fns-tests-length ()
+ (should (= (length nil) 0))
+ (should (= (length '(1 2 3)) 3))
+ (should (= (length '[1 2 3]) 3))
+ (should (= (length "foo") 3))
+ (should-error (length t)))
+
+(ert-deftest fns-tests-safe-length ()
+ (should (= (safe-length '(1 2 3)) 3)))
+
+(ert-deftest fns-tests-string-bytes ()
+ (should (= (string-bytes "abc") 3)))
+
;; 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.
@@ -34,6 +57,33 @@
(puthash nan t h)
(should (eq (funcall test nan -nan) (gethash -nan h))))))
+(ert-deftest fns-tests-equal-including-properties ()
+ (should (equal-including-properties "" ""))
+ (should (equal-including-properties "foo" "foo"))
+ (should (equal-including-properties #("foo" 0 3 (a b))
+ (propertize "foo" 'a 'b)))
+ (should (equal-including-properties #("foo" 0 3 (a b c d))
+ (propertize "foo" 'a 'b 'c 'd)))
+ (should (equal-including-properties #("a" 0 1 (k v))
+ #("a" 0 1 (k v))))
+ (should-not (equal-including-properties #("a" 0 1 (k v))
+ #("a" 0 1 (k x))))
+ (should-not (equal-including-properties #("a" 0 1 (k v))
+ #("b" 0 1 (k v))))
+ (should-not (equal-including-properties #("foo" 0 3 (a b c e))
+ (propertize "foo" 'a 'b 'c 'd))))
+
+(ert-deftest fns-tests-equal-including-properties/string-prop-vals ()
+ "Handle string property values. (Bug#6581)"
+ (should (equal-including-properties #("a" 0 1 (k "v"))
+ #("a" 0 1 (k "v"))))
+ (should (equal-including-properties #("foo" 0 3 (a (t)))
+ (propertize "foo" 'a (list t))))
+ (should-not (equal-including-properties #("a" 0 1 (k "v"))
+ #("a" 0 1 (k "x"))))
+ (should-not (equal-including-properties #("a" 0 1 (k "v"))
+ #("b" 0 1 (k "v")))))
+
(ert-deftest fns-tests-reverse ()
(should-error (reverse))
(should-error (reverse 1))
@@ -268,7 +318,10 @@
(should (equal (base64-encode-string "fooba") "Zm9vYmE="))
(should (equal (base64-encode-string "foobar") "Zm9vYmFy"))
(should (equal (base64-encode-string "\x14\xfb\x9c\x03\xd9\x7e") "FPucA9l+"))
- (should (equal (base64-encode-string "\x14\xfb\x9c\x03\xd9\x7f") "FPucA9l/")))
+ (should (equal (base64-encode-string "\x14\xfb\x9c\x03\xd9\x7f") "FPucA9l/"))
+
+ (should-error (base64-encode-string "ƒ"))
+ (should-error (base64-encode-string "ü")))
(ert-deftest fns-test-base64url-encode-region ()
;; url variant with padding
@@ -310,7 +363,11 @@
(should (equal (fns-tests--with-region base64url-encode-region (fns-tests--string-repeat "\x14\xfb\x9c\x03\xd9\x7e" 10) t)
(fns-tests--string-repeat "FPucA9l-" 10)))
(should (equal (fns-tests--with-region base64url-encode-region (fns-tests--string-repeat "\x14\xfb\x9c\x03\xd9\x7f" 10) t)
- (fns-tests--string-repeat "FPucA9l_" 10))))
+ (fns-tests--string-repeat "FPucA9l_" 10)))
+
+ (should-error (fns-tests--with-region base64url-encode-region "ƒ"))
+ (should-error (fns-tests--with-region base64url-encode-region "ü")))
+
(ert-deftest fns-test-base64url-encode-string ()
;; url variant with padding
@@ -344,7 +401,10 @@
(should (equal (base64url-encode-string (fns-tests--string-repeat "fooba" 15) t) (fns-tests--string-repeat "Zm9vYmFmb29iYWZvb2Jh" 5)))
(should (equal (base64url-encode-string (fns-tests--string-repeat "foobar" 15) t) (concat (fns-tests--string-repeat "Zm9vYmFyZm9vYmFy" 7) "Zm9vYmFy")))
(should (equal (base64url-encode-string (fns-tests--string-repeat "\x14\xfb\x9c\x03\xd9\x7e" 10) t) (fns-tests--string-repeat "FPucA9l-" 10)))
- (should (equal (base64url-encode-string (fns-tests--string-repeat "\x14\xfb\x9c\x03\xd9\x7f" 10) t) (fns-tests--string-repeat "FPucA9l_" 10))))
+ (should (equal (base64url-encode-string (fns-tests--string-repeat "\x14\xfb\x9c\x03\xd9\x7f" 10) t) (fns-tests--string-repeat "FPucA9l_" 10)))
+
+ (should-error (base64url-encode-string "ƒ"))
+ (should-error (base64url-encode-string "ü")))
(ert-deftest fns-tests-base64-decode-string ()
;; standard variant RFC2045
@@ -430,6 +490,23 @@
(buffer-hash))
(sha1 "foo"))))
+(ert-deftest fns-tests-mapconcat ()
+ (should (string= (mapconcat #'identity '()) ""))
+ (should (string= (mapconcat #'identity '("a" "b")) "ab"))
+ (should (string= (mapconcat #'identity '() "_") ""))
+ (should (string= (mapconcat #'identity '("A") "_") "A"))
+ (should (string= (mapconcat #'identity '("A" "B") "_") "A_B"))
+ (should (string= (mapconcat #'identity '("A" "B" "C") "_") "A_B_C"))
+ ;; non-ASCII strings
+ (should (string= (mapconcat #'identity '("Ä" "ø" "☭" "தமிழ்") "_漢字_")
+ "Ä_漢字_ø_漢字_☭_漢字_தமிழ்"))
+ ;; vector
+ (should (string= (mapconcat #'identity ["a" "b"] "") "ab"))
+ ;; bool-vector
+ (should (string= (mapconcat #'identity [nil nil] "") ""))
+ (should-error (mapconcat #'identity [nil nil t])
+ :type 'wrong-type-argument))
+
(ert-deftest fns-tests-mapcan ()
(should-error (mapcan))
(should-error (mapcan #'identity))
diff --git a/test/src/image-tests.el b/test/src/image-tests.el
new file mode 100644
index 00000000000..e54d0df71f1
--- /dev/null
+++ b/test/src/image-tests.el
@@ -0,0 +1,244 @@
+;;; image-tests.el --- Tests for image.c -*- lexical-binding: t -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; Author: Stefan Kangas <stefan@marxist.se>
+
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Most of these tests will only run in a GUI session, and not with
+;; "make check". Run them manually in an interactive session with
+;; `M-x eval-buffer' followed by `M-x ert'.
+
+;;; Code:
+
+(require 'ert)
+
+(defmacro image-skip-unless (format)
+ `(skip-unless (and (display-images-p)
+ (image-type-available-p ,format))))
+
+;;;; Images
+
+(defconst image-tests--images
+ `((gif . ,(expand-file-name "test/data/image/black.gif"
+ source-directory))
+ (jpeg . ,(expand-file-name "test/data/image/black.jpg"
+ source-directory))
+ (pbm . ,(find-image '((:file "splash.svg" :type svg))))
+ (png . ,(find-image '((:file "splash.png" :type png))))
+ (svg . ,(find-image '((:file "splash.pbm" :type pbm))))
+ (tiff . ,(expand-file-name
+ "nextstep/GNUstep/Emacs.base/Resources/emacs.tiff"
+ source-directory))
+ (webp . ,(expand-file-name "test/data/image/black.webp"
+ source-directory))
+ (xbm . ,(find-image '((:file "gnus/gnus.xbm" :type xbm))))
+ (xpm . ,(find-image '((:file "splash.xpm" :type xpm))))))
+
+;;;; image-test-size
+
+(ert-deftest image-tests-image-size/gif ()
+ (image-skip-unless 'gif)
+ (pcase (image-size (create-image (cdr (assq 'gif image-tests--images))))
+ (`(,a . ,b)
+ (should (floatp a))
+ (should (floatp b)))))
+
+(ert-deftest image-tests-image-size/jpeg ()
+ (image-skip-unless 'jpeg)
+ (pcase (image-size (create-image (cdr (assq 'jpeg image-tests--images))))
+ (`(,a . ,b)
+ (should (floatp a))
+ (should (floatp b)))))
+
+(ert-deftest image-tests-image-size/pbm ()
+ (image-skip-unless 'pbm)
+ (pcase (image-size (cdr (assq 'pbm image-tests--images)))
+ (`(,a . ,b)
+ (should (floatp a))
+ (should (floatp b)))))
+
+(ert-deftest image-tests-image-size/png ()
+ (image-skip-unless 'png)
+ (pcase (image-size (cdr (assq 'png image-tests--images)))
+ (`(,a . ,b)
+ (should (floatp a))
+ (should (floatp b)))))
+
+(ert-deftest image-tests-image-size/svg ()
+ (image-skip-unless 'svg)
+ (pcase (image-size (cdr (assq 'svg image-tests--images)))
+ (`(,a . ,b)
+ (should (floatp a))
+ (should (floatp b)))))
+
+(ert-deftest image-tests-image-size/tiff ()
+ (image-skip-unless 'tiff)
+ (pcase (image-size (create-image (cdr (assq 'tiff image-tests--images))))
+ (`(,a . ,b)
+ (should (floatp a))
+ (should (floatp b)))))
+
+(ert-deftest image-tests-image-size/webp ()
+ (image-skip-unless 'webp)
+ (pcase (image-size (create-image (cdr (assq 'webp image-tests--images))))
+ (`(,a . ,b)
+ (should (floatp a))
+ (should (floatp b)))))
+
+(ert-deftest image-tests-image-size/xbm ()
+ (image-skip-unless 'xbm)
+ (pcase (image-size (cdr (assq 'xbm image-tests--images)))
+ (`(,a . ,b)
+ (should (floatp a))
+ (should (floatp b)))))
+
+(ert-deftest image-tests-image-size/xpm ()
+ (image-skip-unless 'xpm)
+ (pcase (image-size (cdr (assq 'xpm image-tests--images)))
+ (`(,a . ,b)
+ (should (floatp a))
+ (should (floatp b)))))
+
+(ert-deftest image-tests-image-size/error-on-invalid-spec ()
+ (skip-unless (display-images-p))
+ (should-error (image-size 'invalid-spec)))
+
+(ert-deftest image-tests-image-size/error-on-nongraphical-display ()
+ (skip-unless (not (display-images-p)))
+ (should-error (image-size 'invalid-spec)))
+
+;;;; image-mask-p
+
+(ert-deftest image-tests-image-mask-p/gif ()
+ (image-skip-unless 'gif)
+ (should-not (image-mask-p (create-image
+ (cdr (assq 'gif image-tests--images))))))
+
+(ert-deftest image-tests-image-mask-p/jpeg ()
+ (image-skip-unless 'jpeg)
+ (should-not (image-mask-p (create-image
+ (cdr (assq 'jpeg image-tests--images))))))
+
+(ert-deftest image-tests-image-mask-p/pbm ()
+ (image-skip-unless 'pbm)
+ (should-not (image-mask-p (cdr (assq 'pbm image-tests--images)))))
+
+(ert-deftest image-tests-image-mask-p/png ()
+ (image-skip-unless 'png)
+ (should-not (image-mask-p (cdr (assq 'png image-tests--images)))))
+
+(ert-deftest image-tests-image-mask-p/svg ()
+ (image-skip-unless 'svg)
+ (should-not (image-mask-p (cdr (assq 'svg image-tests--images)))))
+
+(ert-deftest image-tests-image-mask-p/tiff ()
+ (image-skip-unless 'tiff)
+ (should-not (image-mask-p (create-image
+ (cdr (assq 'tiff image-tests--images))))))
+
+(ert-deftest image-tests-image-mask-p/webp ()
+ (image-skip-unless 'webp)
+ (should-not (image-mask-p (create-image
+ (cdr (assq 'webp image-tests--images))))))
+
+(ert-deftest image-tests-image-mask-p/xbm ()
+ (image-skip-unless 'xbm)
+ (should-not (image-mask-p (cdr (assq 'xbm image-tests--images)))))
+
+(ert-deftest image-tests-image-mask-p/xpm ()
+ (image-skip-unless 'xpm)
+ (should-not (image-mask-p (cdr (assq 'xpm image-tests--images)))))
+
+(ert-deftest image-tests-image-mask-p/error-on-invalid-spec ()
+ (skip-unless (display-images-p))
+ (should-error (image-mask-p 'invalid-spec)))
+
+(ert-deftest image-tests-image-mask-p/error-on-nongraphical-display ()
+ (skip-unless (not (display-images-p)))
+ (should-error (image-mask-p (cdr (assq 'xpm image-tests--images)))))
+
+;;;; image-metadata
+
+;; TODO: These tests could be expanded with files that actually
+;; contain metadata.
+
+(ert-deftest image-tests-image-metadata/gif ()
+ (image-skip-unless 'gif)
+ (should-not (image-metadata
+ (create-image (cdr (assq 'gif image-tests--images))))))
+
+(ert-deftest image-tests-image-metadata/jpeg ()
+ (image-skip-unless 'jpeg)
+ (should-not (image-metadata
+ (create-image (cdr (assq 'jpeg image-tests--images))))))
+
+(ert-deftest image-tests-image-metadata/pbm ()
+ (image-skip-unless 'pbm)
+ (should-not (image-metadata (cdr (assq 'pbm image-tests--images)))))
+
+(ert-deftest image-tests-image-metadata/png ()
+ (image-skip-unless 'png)
+ (should-not (image-metadata (cdr (assq 'png image-tests--images)))))
+
+(ert-deftest image-tests-image-metadata/svg ()
+ (image-skip-unless 'svg)
+ (should-not (image-metadata (cdr (assq 'svg image-tests--images)))))
+
+(ert-deftest image-tests-image-metadata/tiff ()
+ (image-skip-unless 'tiff)
+ (should-not (image-metadata
+ (create-image (cdr (assq 'tiff image-tests--images))))))
+
+(ert-deftest image-tests-image-metadata/webp ()
+ (image-skip-unless 'webp)
+ (should-not (image-metadata
+ (create-image (cdr (assq 'webp image-tests--images))))))
+
+(ert-deftest image-tests-image-metadata/xbm ()
+ (image-skip-unless 'xbm)
+ (should-not (image-metadata (cdr (assq 'xbm image-tests--images)))))
+
+(ert-deftest image-tests-image-metadata/xpm ()
+ (image-skip-unless 'xpm)
+ (should-not (image-metadata (cdr (assq 'xpm image-tests--images)))))
+
+(ert-deftest image-tests-image-metadata/nil-on-invalid-spec ()
+ (skip-unless (display-images-p))
+ (should-not (image-metadata 'invalid-spec)))
+
+(ert-deftest image-tests-image-metadata/error-on-nongraphical-display ()
+ (skip-unless (not (display-images-p)))
+ (should-error (image-metadata (cdr (assq 'xpm image-tests--images)))))
+
+;;;; ImageMagick
+
+(ert-deftest image-tests-imagemagick-types ()
+ (skip-unless (fboundp 'imagemagick-types))
+ (when (fboundp 'imagemagick-types)
+ (should (listp (imagemagick-types)))))
+
+;;;; Initialization
+
+(ert-deftest image-tests-init-image-library ()
+ (skip-unless (fboundp 'init-image-library))
+ (should (init-image-library 'pbm)) ; built-in
+ (should-not (init-image-library 'invalid-image-type)))
+
+;;; image-tests.el ends here
diff --git a/test/src/inotify-tests.el b/test/src/inotify-tests.el
index d9390b638b6..295b184be0e 100644
--- a/test/src/inotify-tests.el
+++ b/test/src/inotify-tests.el
@@ -24,9 +24,11 @@
;;; Code:
(require 'ert)
+(require 'ert-x)
(declare-function inotify-add-watch "inotify.c" (file-name aspect callback))
(declare-function inotify-rm-watch "inotify.c" (watch-descriptor))
+(declare-function inotify-valid-p "inotify.c" (watch-descriptor))
(ert-deftest inotify-valid-p-simple ()
"Simple tests for `inotify-valid-p'."
@@ -37,8 +39,7 @@
;; (ert-deftest filewatch-file-watch-aspects-check ()
;; "Test whether `file-watch' properly checks the aspects."
-;; (let ((temp-file (make-temp-file "filewatch-aspects")))
-;; (should (stringp temp-file))
+;; (ert-with-temp-file temp-file
;; (should-error (file-watch temp-file 'wrong nil)
;; :type 'error)
;; (should-error (file-watch temp-file '(modify t) nil)
@@ -50,23 +51,21 @@
(ert-deftest inotify-file-watch-simple ()
"Test if watching a normal file works."
-
(skip-unless (featurep 'inotify))
- (let ((temp-file (make-temp-file "inotify-simple"))
- (events 0))
- (let ((wd
- (inotify-add-watch temp-file t (lambda (_ev)
- (setq events (1+ events))))))
- (unwind-protect
- (progn
- (with-temp-file temp-file
- (insert "Foo\n"))
- (read-event nil nil 5)
- (should (> events 0)))
- (should (inotify-valid-p wd))
- (inotify-rm-watch wd)
- (should-not (inotify-valid-p wd))
- (delete-file temp-file)))))
+ (ert-with-temp-file temp-file
+ (let ((events 0))
+ (let ((wd
+ (inotify-add-watch temp-file t (lambda (_ev)
+ (setq events (1+ events))))))
+ (unwind-protect
+ (progn
+ (with-temp-file temp-file
+ (insert "Foo\n"))
+ (read-event nil nil 5)
+ (should (> events 0)))
+ (should (inotify-valid-p wd))
+ (inotify-rm-watch wd)
+ (should-not (inotify-valid-p wd)))))))
(provide 'inotify-tests)
diff --git a/test/src/keymap-tests.el b/test/src/keymap-tests.el
index 1dbaf7ef2e7..69aa7238493 100644
--- a/test/src/keymap-tests.el
+++ b/test/src/keymap-tests.el
@@ -134,6 +134,45 @@
(define-key map [menu-bar i-bar] 'foo)
(should (eq (lookup-key map [menu-bar I-bar]) 'foo))))
+(ert-deftest keymap-lookup-key/mixed-case-multibyte ()
+ "Backwards compatibility behaviour (Bug#50752)."
+ (let ((map (make-keymap)))
+ ;; (downcase "Åäö") => "åäö"
+ (define-key map [menu-bar åäö bar] 'foo)
+ (should (eq (lookup-key map [menu-bar åäö bar]) 'foo))
+ (should (eq (lookup-key map [menu-bar Åäö Bar]) 'foo))
+ ;; (downcase "Γ") => "γ"
+ (define-key map [menu-bar γ bar] 'baz)
+ (should (eq (lookup-key map [menu-bar γ bar]) 'baz))
+ (should (eq (lookup-key map [menu-bar Γ Bar]) 'baz))))
+
+(ert-deftest keymap-lookup-key/menu-non-symbol ()
+ "Test for Bug#51527."
+ (let ((map (make-keymap)))
+ (define-key map [menu-bar buffer 1] 'foo)
+ (should (eq (lookup-key map [menu-bar buffer 1]) 'foo))))
+
+(ert-deftest keymap-lookup-keymap/with-spaces ()
+ "Backwards compatibility behaviour (Bug#50752)."
+ (let ((map (make-keymap)))
+ (define-key map [menu-bar foo-bar] 'foo)
+ (should (eq (lookup-key map [menu-bar Foo\ Bar]) 'foo))))
+
+(ert-deftest keymap-lookup-keymap/with-spaces-multibyte ()
+ "Backwards compatibility behaviour (Bug#50752)."
+ (let ((map (make-keymap)))
+ (define-key map [menu-bar åäö-bar] 'foo)
+ (should (eq (lookup-key map [menu-bar Åäö\ Bar]) 'foo))))
+
+(ert-deftest keymap-lookup-keymap/with-spaces-multibyte-lang-env ()
+ "Backwards compatibility behaviour (Bug#50752)."
+ (let ((lang-env current-language-environment))
+ (set-language-environment "Turkish")
+ (let ((map (make-keymap)))
+ (define-key map [menu-bar i-bar] 'foo)
+ (should (eq (lookup-key map [menu-bar I-bar]) 'foo)))
+ (set-language-environment lang-env)))
+
(ert-deftest describe-buffer-bindings/header-in-current-buffer ()
"Header should be inserted into the current buffer.
https://debbugs.gnu.org/39149#31"
@@ -237,15 +276,11 @@ commit 86c19714b097aa477d339ed99ffb5136c755a046."
(should (equal (where-is-internal 'foo map t) [?y]))
(should (equal (where-is-internal 'bar map t) [?y]))))
-(defvar keymap-tests-minor-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map "x" 'keymap-tests--command-2)
- map))
+(defvar-keymap keymap-tests-minor-mode-map
+ "x" 'keymap-tests--command-2)
-(defvar keymap-tests-major-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map "x" 'keymap-tests--command-1)
- map))
+(defvar-keymap keymap-tests-major-mode-map
+ "x" 'keymap-tests--command-1)
(define-minor-mode keymap-tests-minor-mode "Test.")
@@ -284,12 +319,12 @@ commit 86c19714b097aa477d339ed99ffb5136c755a046."
(with-temp-buffer
(help--describe-vector (cadr orig-map) nil #'help--describe-command
t shadow-map orig-map t)
- (should (equal (buffer-string)
- "
+ (should (equal (buffer-substring-no-properties (point-min) (point-max))
+ (string-replace "\t" "" "
e foo
f foo (currently shadowed by `bar')
g .. h foo
-")))))
+"))))))
(ert-deftest help--describe-vector/bug-9293-same-command-does-not-shadow ()
"Check that a command can't be shadowed by the same command."
@@ -310,10 +345,10 @@ g .. h foo
(with-temp-buffer
(help--describe-vector (cadr range-map) nil #'help--describe-command
t shadow-map range-map t)
- (should (equal (buffer-string)
- "
+ (should (equal (buffer-substring-no-properties (point-min) (point-max))
+ (string-replace "\t" "" "
0 .. 3 foo
-")))))
+"))))))
(ert-deftest keymap--key-description ()
(should (equal (key-description [right] [?\C-x])
@@ -327,6 +362,62 @@ g .. h foo
(should (equal (single-key-description 'C-s-home)
"C-s-<home>")))
+(ert-deftest keymap-test-lookups ()
+ (should (eq (lookup-key (current-global-map) "\C-x\C-f") 'find-file))
+ (should (eq (lookup-key (current-global-map) [(control x) (control f)])
+ 'find-file))
+ (should (eq (lookup-key (current-global-map) ["C-x C-f"]) 'find-file))
+ (should (eq (lookup-key (current-global-map) [?\C-x ?\C-f]) 'find-file)))
+
+(ert-deftest keymap-removal ()
+ ;; Set to nil.
+ (let ((map (define-keymap "a" 'foo)))
+ (should (equal map '(keymap (97 . foo))))
+ (define-key map "a" nil)
+ (should (equal map '(keymap (97)))))
+ ;; Remove.
+ (let ((map (define-keymap "a" 'foo)))
+ (should (equal map '(keymap (97 . foo))))
+ (define-key map "a" nil t)
+ (should (equal map '(keymap)))))
+
+(ert-deftest keymap-removal-inherit ()
+ ;; Set to nil.
+ (let ((parent (make-sparse-keymap))
+ (child (make-keymap)))
+ (set-keymap-parent child parent)
+ (define-key parent [?a] 'foo)
+ (define-key child [?a] 'bar)
+
+ (should (eq (lookup-key child [?a]) 'bar))
+ (define-key child [?a] nil)
+ (should (eq (lookup-key child [?a]) nil)))
+ ;; Remove.
+ (let ((parent (make-sparse-keymap))
+ (child (make-keymap)))
+ (set-keymap-parent child parent)
+ (define-key parent [?a] 'foo)
+ (define-key child [?a] 'bar)
+
+ (should (eq (lookup-key child [?a]) 'bar))
+ (define-key child [?a] nil t)
+ (should (eq (lookup-key child [?a]) 'foo))))
+
+(ert-deftest keymap-text-char-description ()
+ (should (equal (text-char-description ?a) "a"))
+ (should (equal (text-char-description ?\s) " "))
+ (should (equal (text-char-description ?\t) "^I"))
+ (should (equal (text-char-description ?\^C) "^C"))
+ (should (equal (text-char-description ?\^?) "^?"))
+ (should (equal (text-char-description #x80) "€"))
+ (should (equal (text-char-description ?å) "å"))
+ (should (equal (text-char-description ?Ş) "Ş"))
+ (should (equal (text-char-description ?Ā) "Ā"))
+ (should-error (text-char-description "c"))
+ (should-error (text-char-description [?\C-x ?l]))
+ (should-error (text-char-description ?\M-c))
+ (should-error (text-char-description ?\s-c)))
+
(provide 'keymap-tests)
;;; keymap-tests.el ends here
diff --git a/test/src/lcms-tests.el b/test/src/lcms-tests.el
index 0f4bbd3ef62..1829a7ea1f1 100644
--- a/test/src/lcms-tests.el
+++ b/test/src/lcms-tests.el
@@ -35,6 +35,13 @@
(require 'ert)
(require 'color)
+(declare-function lcms-jab->jch "lcms.c")
+(declare-function lcms-jch->jab "lcms.c")
+(declare-function lcms-xyz->jch "lcms.c")
+(declare-function lcms-jch->xyz "lcms.c")
+(declare-function lcms-temp->white-point "lcms.c")
+(declare-function lcms-cam02-ucs "lcms.c")
+
(defconst lcms-colorspacious-d65 '(0.95047 1.0 1.08883)
"D65 white point from colorspacious.")
diff --git a/test/src/lread-tests.el b/test/src/lread-tests.el
index d337563728b..862f6a6595f 100644
--- a/test/src/lread-tests.el
+++ b/test/src/lread-tests.el
@@ -115,18 +115,14 @@
(should-error (read "#24r") :type 'invalid-read-syntax)
(should-error (read "#") :type 'invalid-read-syntax))
+(ert-deftest lread-char-modifiers ()
+ (should (eq ?\C-\M-é (+ (- ?\M-a ?a) ?\C-é)))
+ (should (eq (- ?\C-ŗ ?ŗ) (- ?\C-é ?é))))
+
(ert-deftest lread-record-1 ()
(should (equal '(#s(foo) #s(foo))
(read "(#1=#s(foo) #1#)"))))
-(defmacro lread-tests--with-temp-file (file-name-var &rest body)
- (declare (indent 1))
- (cl-check-type file-name-var symbol)
- `(let ((,file-name-var (make-temp-file "emacs")))
- (unwind-protect
- (progn ,@body)
- (delete-file ,file-name-var))))
-
(defun lread-tests--last-message ()
(with-current-buffer "*Messages*"
(save-excursion
@@ -137,7 +133,7 @@
(ert-deftest lread-tests--unescaped-char-literals ()
"Check that loading warns about unescaped character
literals (Bug#20852)."
- (lread-tests--with-temp-file file-name
+ (ert-with-temp-file file-name
(write-region "?) ?( ?; ?\" ?[ ?]" nil file-name)
(should (equal (load file-name nil :nomessage :nosuffix) t))
(should (equal (lread-tests--last-message)
diff --git a/test/src/process-tests.el b/test/src/process-tests.el
index 14092187e0b..f5908d3cda5 100644
--- a/test/src/process-tests.el
+++ b/test/src/process-tests.el
@@ -25,11 +25,16 @@
(require 'cl-lib)
(require 'ert)
+(require 'ert-x) ; ert-with-temp-directory
(require 'puny)
(require 'subr-x)
(require 'dns)
(require 'url-http)
+(declare-function thread-last-error "thread.c")
+(declare-function thread-join "thread.c")
+(declare-function make-thread "thread.c")
+
;; Timeout in seconds; the test fails if the timeout is reached.
(defvar process-test-sentinel-wait-timeout 2.0)
@@ -64,24 +69,22 @@
(when (eq system-type 'windows-nt)
(ert-deftest process-test-quoted-batfile ()
"Check that Emacs hides CreateProcess deficiency (bug#18745)."
- (let (batfile)
- (unwind-protect
- (progn
- ;; CreateProcess will fail when both the bat file and 1st
- ;; argument are quoted, so include spaces in both of those
- ;; to force quoting.
- (setq batfile (make-temp-file "echo args" nil ".bat"))
- (with-temp-file batfile
- (insert "@echo arg1=%1, arg2=%2\n"))
- (with-temp-buffer
- (call-process batfile nil '(t t) t "x &y")
- (should (string= (buffer-string) "arg1=\"x &y\", arg2=\n")))
- (with-temp-buffer
- (call-process-shell-command
- (mapconcat #'shell-quote-argument (list batfile "x &y") " ")
- nil '(t t) t)
- (should (string= (buffer-string) "arg1=\"x &y\", arg2=\n"))))
- (when batfile (delete-file batfile))))))
+ (ert-with-temp-file batfile
+ ;; CreateProcess will fail when both the bat file and 1st
+ ;; argument are quoted, so include spaces in both of those
+ ;; to force quoting.
+ :prefix "echo args"
+ :suffix ".bat"
+ (with-temp-file batfile
+ (insert "@echo arg1=%1, arg2=%2\n"))
+ (with-temp-buffer
+ (call-process batfile nil '(t t) t "x &y")
+ (should (string= (buffer-string) "arg1=\"x &y\", arg2=\n")))
+ (with-temp-buffer
+ (call-process-shell-command
+ (mapconcat #'shell-quote-argument (list batfile "x &y") " ")
+ nil '(t t) t)
+ (should (string= (buffer-string) "arg1=\"x &y\", arg2=\n"))))))
(ert-deftest process-test-stderr-buffer ()
(skip-unless (executable-find "bash"))
@@ -531,18 +534,6 @@ FD_SETSIZE."
(delete-process (pop ,processes))
,@body)))))
-(defmacro process-tests--with-temp-directory (var &rest body)
- "Bind VAR to the name of a new directory and evaluate BODY.
-Afterwards, delete the directory."
- (declare (indent 1) (debug (symbolp body)))
- (cl-check-type var symbol)
- (let ((dir (make-symbol "dir")))
- `(let ((,dir (make-temp-file "emacs-test-" :dir)))
- (unwind-protect
- (let ((,var ,dir))
- ,@body)
- (delete-directory ,dir :recursive)))))
-
;; Tests for FD_SETSIZE overflow (Bug#24325). The following tests
;; generate lots of process objects of the various kinds. Running the
;; tests with assertions enabled should not result in any crashes due
@@ -630,7 +621,7 @@ FD_SETSIZE file descriptors (Bug#24325)."
;; Avoid hang due to connect/accept handshake on Cygwin (bug#49496).
(skip-unless (not (eq system-type 'cygwin)))
(with-timeout (60 (ert-fail "Test timed out"))
- (process-tests--with-temp-directory directory
+ (ert-with-temp-directory directory
(process-tests--with-processes processes
(let* ((num-clients 10)
(socket-name (expand-file-name "socket" directory))
@@ -800,6 +791,7 @@ have written output."
(list (list process "finished\n"))))))))))
(ert-deftest process-tests/multiple-threads-waiting ()
+ :tags (if (getenv "EMACS_EMBA_CI") '(:unstable))
(skip-unless (fboundp 'make-thread))
(with-timeout (60 (ert-fail "Test timed out"))
(process-tests--with-processes processes
diff --git a/test/src/search-tests.el b/test/src/search-tests.el
index c7d6004ce44..2fa23842841 100644
--- a/test/src/search-tests.el
+++ b/test/src/search-tests.el
@@ -28,7 +28,7 @@
(setq ov-set (make-overlay 3 5))
(overlay-put
ov-set 'modification-hooks
- (list (lambda (o after &rest _args)
+ (list (lambda (_o after &rest _args)
(when after
(let ((inhibit-modification-hooks t))
(save-excursion
diff --git a/test/src/sqlite-tests.el b/test/src/sqlite-tests.el
new file mode 100644
index 00000000000..d7100537a4e
--- /dev/null
+++ b/test/src/sqlite-tests.el
@@ -0,0 +1,219 @@
+;;; sqlite-tests.el --- Tests for sqlite.el -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2021 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 <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'ert)
+(require 'ert-x)
+
+(declare-function sqlite-execute "sqlite.c")
+(declare-function sqlite-close "sqlite.c")
+(declare-function sqlitep "sqlite.c")
+(declare-function sqlite-available-p "sqlite.c")
+(declare-function sqlite-finalize "sqlite.c")
+(declare-function sqlite-next "sqlite.c")
+(declare-function sqlite-more-p "sqlite.c")
+(declare-function sqlite-select "sqlite.c")
+(declare-function sqlite-open "sqlite.c")
+(declare-function sqlite-load-extension "sqlite.c")
+
+(ert-deftest sqlite-select ()
+ (skip-unless (sqlite-available-p))
+ (let ((db (sqlite-open)))
+ (should (eq (type-of db) 'sqlite))
+ (should (sqlitep db))
+ (should-not (sqlitep 'foo))
+
+ (should
+ (zerop
+ (sqlite-execute
+ db "create table if not exists test1 (col1 text, col2 integer, col3 float, col4 blob)")))
+
+ (should-error
+ (sqlite-execute
+ db "insert into test1 (col1, col2, col3, col4) values ('foo', 2, 9.45, 'bar', 'zot')"))
+
+ (should
+ (=
+ (sqlite-execute
+ db "insert into test1 (col1, col2, col3, col4) values ('foo', 2, 9.45, 'bar')")
+ 1))
+
+ (should
+ (equal
+ (sqlite-select db "select * from test1" nil 'full)
+ '(("col1" "col2" "col3" "col4") ("foo" 2 9.45 "bar"))))))
+
+(ert-deftest sqlite-set ()
+ (skip-unless (sqlite-available-p))
+ (let ((db (sqlite-open))
+ set)
+ (should
+ (zerop
+ (sqlite-execute
+ db "create table if not exists test1 (col1 text, col2 integer)")))
+
+ (should
+ (=
+ (sqlite-execute db "insert into test1 (col1, col2) values ('foo', 1)")
+ 1))
+ (should
+ (=
+ (sqlite-execute db "insert into test1 (col1, col2) values ('bar', 2)")
+ 1))
+
+ (setq set (sqlite-select db "select * from test1" nil 'set))
+ (should (sqlitep set))
+ (should (sqlite-more-p set))
+ (should (equal (sqlite-next set)
+ '("foo" 1)))
+ (should (equal (sqlite-next set)
+ '("bar" 2)))
+ (should-not (sqlite-next set))
+ (should-not (sqlite-more-p set))
+ (sqlite-finalize set)
+ (should-error (sqlite-next set))))
+
+(ert-deftest sqlite-chars ()
+ (skip-unless (sqlite-available-p))
+ (let (db)
+ (setq db (sqlite-open))
+ (sqlite-execute
+ db "create table if not exists test2 (col1 text, col2 integer)")
+ (sqlite-execute
+ db "insert into test2 (col1, col2) values ('fóo', 3)")
+ (sqlite-execute
+ db "insert into test2 (col1, col2) values ('fó‚o', 3)")
+ (sqlite-execute
+ db "insert into test2 (col1, col2) values ('f‚o', 4)")
+ (should
+ (equal (sqlite-select db "select * from test2" nil 'full)
+ '(("col1" "col2") ("fóo" 3) ("fó‚o" 3) ("f‚o" 4))))))
+
+(ert-deftest sqlite-numbers ()
+ (skip-unless (sqlite-available-p))
+ (let (db)
+ (setq db (sqlite-open))
+ (sqlite-execute
+ db "create table if not exists test3 (col1 integer)")
+ (let ((big (expt 2 50))
+ (small (expt 2 10)))
+ (sqlite-execute db (format "insert into test3 values (%d)" small))
+ (sqlite-execute db (format "insert into test3 values (%d)" big))
+ (should
+ (equal
+ (sqlite-select db "select * from test3")
+ (list (list small) (list big)))))))
+
+(ert-deftest sqlite-param ()
+ (skip-unless (sqlite-available-p))
+ (let (db)
+ (setq db (sqlite-open))
+ (sqlite-execute
+ db "create table if not exists test4 (col1 text, col2 number)")
+ (sqlite-execute db "insert into test4 values (?, ?)" (list "foo" 1))
+ (should
+ (equal
+ (sqlite-select db "select * from test4 where col2 = ?" '(1))
+ '(("foo" 1))))
+ (should
+ (equal
+ (sqlite-select db "select * from test4 where col2 = ?" [1])
+ '(("foo" 1))))))
+
+(ert-deftest sqlite-binary ()
+ (skip-unless (sqlite-available-p))
+ (let (db)
+ (setq db (sqlite-open))
+ (sqlite-execute
+ db "create table if not exists test5 (col1 text, col2 number)")
+ (let ((string (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (insert 0 1 2)
+ (buffer-string))))
+ (should-not (multibyte-string-p string))
+ (sqlite-execute
+ db "insert into test5 values (?, ?)" (list string 2))
+ (let ((out (caar
+ (sqlite-select db "select col1 from test5 where col2 = 2"))))
+ (should (equal out string))))))
+
+(ert-deftest sqlite-different-dbs ()
+ (skip-unless (sqlite-available-p))
+ (let (db1 db2)
+ (setq db1 (sqlite-open))
+ (setq db2 (sqlite-open))
+ (sqlite-execute
+ db1 "create table if not exists test6 (col1 text, col2 number)")
+ (sqlite-execute
+ db2 "create table if not exists test6 (col1 text, col2 number)")
+ (sqlite-execute
+ db1 "insert into test6 values (?, ?)" '("foo" 2))
+ (should (sqlite-select db1 "select * from test6"))
+ (should-not (sqlite-select db2 "select * from test6"))))
+
+(ert-deftest sqlite-close-dbs ()
+ (skip-unless (sqlite-available-p))
+ (let (db)
+ (setq db (sqlite-open))
+ (sqlite-execute
+ db "create table if not exists test6 (col1 text, col2 number)")
+ (sqlite-execute db "insert into test6 values (?, ?)" '("foo" 2))
+ (should (sqlite-select db "select * from test6"))
+ (sqlite-close db)
+ (should-error (sqlite-select db "select * from test6"))))
+
+(ert-deftest sqlite-load-extension ()
+ (skip-unless (sqlite-available-p))
+ (skip-unless (fboundp 'sqlite-load-extension))
+ (let (db)
+ (setq db (sqlite-open))
+ (should-error
+ (sqlite-load-extension db "/usr/lib/sqlite3/notpcre.so"))
+ (should-error
+ (sqlite-load-extension db "/usr/lib/sqlite3/n"))
+ (should-error
+ (sqlite-load-extension db "/usr/lib/sqlite3/"))
+ (should-error
+ (sqlite-load-extension db "/usr/lib/sqlite3"))
+ (should
+ (memq
+ (sqlite-load-extension db "/usr/lib/sqlite3/pcre.so")
+ '(nil t)))
+
+ (should-error
+ (sqlite-load-extension
+ db "/usr/lib/x86_64-linux-gnu/libsqlite3_mod_notcsvtable.so"))
+ (should-error
+ (sqlite-load-extension
+ db "/usr/lib/x86_64-linux-gnu/libsqlite3_mod_csvtablen.so"))
+ (should-error
+ (sqlite-load-extension
+ db "/usr/lib/x86_64-linux-gnu/libsqlite3_mod_csvtable"))
+ (should
+ (memq
+ (sqlite-load-extension
+ db "/usr/lib/x86_64-linux-gnu/libsqlite3_mod_csvtable.so")
+ '(nil t)))))
+
+;;; sqlite-tests.el ends here
diff --git a/test/src/thread-tests.el b/test/src/thread-tests.el
index d521f89f7df..b7ab31120aa 100644
--- a/test/src/thread-tests.el
+++ b/test/src/thread-tests.el
@@ -389,6 +389,7 @@
(should (equal (thread-last-error) '(error "Die, die, die!")))))
(ert-deftest threads-test-bug33073 ()
+ (skip-unless (fboundp 'make-thread))
(let ((th (make-thread 'ignore)))
(should-not (equal th main-thread))))
diff --git a/test/src/timefns-tests.el b/test/src/timefns-tests.el
index 2288a9ef613..1b49e0622f5 100644
--- a/test/src/timefns-tests.el
+++ b/test/src/timefns-tests.el
@@ -242,4 +242,16 @@ a fixed place on the right and are padded on the left."
(should (= xdiv (float-time (time-convert xdiv t))))))
(setq x (* x 2)))))
+(ert-deftest time-convert-forms ()
+ ;; These computations involve numbers that should have exact
+ ;; representations on any Emacs platform.
+ (dolist (time '(-86400 -1 0 1 86400))
+ (dolist (delta '(0 0.0 0.25 3.25 1000 1000.25))
+ (let ((time+ (+ time delta))
+ (time- (- time delta)))
+ (dolist (form '(nil t list 4 1000 1000000 1000000000))
+ (should (time-equal-p time (time-convert time form)))
+ (should (time-equal-p time- (time-convert time- form)))
+ (should (time-equal-p time+ (time-convert time+ form))))))))
+
;;; timefns-tests.el ends here
diff --git a/test/src/undo-tests.el b/test/src/undo-tests.el
index 63e7a3f8cb5..c84ed74f0b1 100644
--- a/test/src/undo-tests.el
+++ b/test/src/undo-tests.el
@@ -46,6 +46,7 @@
;;; Code:
(require 'ert)
+(require 'ert-x)
(require 'facemenu)
(ert-deftest undo-test0 ()
@@ -218,17 +219,14 @@
(ert-deftest undo-test-file-modified ()
"Test undoing marks buffer visiting file unmodified."
- (let ((tempfile (make-temp-file "undo-test")))
- (unwind-protect
- (progn
- (with-current-buffer (find-file-noselect tempfile)
- (insert "1")
- (undo-boundary)
- (set-buffer-modified-p nil)
- (insert "2")
- (undo)
- (should-not (buffer-modified-p))))
- (delete-file tempfile))))
+ (ert-with-temp-file tempfile
+ (with-current-buffer (find-file-noselect tempfile)
+ (insert "1")
+ (undo-boundary)
+ (set-buffer-modified-p nil)
+ (insert "2")
+ (undo)
+ (should-not (buffer-modified-p)))))
(ert-deftest undo-test-region-not-most-recent ()
"Test undo in region of an edit not the most recent."
diff --git a/test/src/xdisp-tests.el b/test/src/xdisp-tests.el
index c487ba286c8..0870dc9de4d 100644
--- a/test/src/xdisp-tests.el
+++ b/test/src/xdisp-tests.el
@@ -99,4 +99,75 @@
(width-in-chars (/ (car size) char-width)))
(should (equal width-in-chars 3)))))
+(ert-deftest xdisp-tests--find-directional-overrides-case-1 ()
+ (with-temp-buffer
+ (insert "\
+int main() {
+ bool isAdmin = false;
+ /*‮ }⁦if (isAdmin)⁩ ⁦ begin admins only */
+ printf(\"You are an admin.\\n\");
+ /* end admins only ‮ { ⁦*/
+ return 0;
+}")
+ (goto-char (point-min))
+ (should (eq (bidi-find-overridden-directionality (point-min) (point-max)
+ nil)
+ 46))))
+
+(ert-deftest xdisp-tests--find-directional-overrides-case-2 ()
+ (with-temp-buffer
+ (insert "\
+#define is_restricted_user(user) \\
+ !strcmp (user, \"root\") ? 0 : \\
+ !strcmp (user, \"admin\") ? 0 : \\
+ !strcmp (user, \"superuser‮⁦? 0 : 1⁩ ⁦\")⁩‬
+
+int main () {
+ printf (\"root: %d\\n\", is_restricted_user (\"root\"));
+ printf (\"admin: %d\\n\", is_restricted_user (\"admin\"));
+ printf (\"superuser: %d\\n\", is_restricted_user (\"superuser\"));
+ printf (\"luser: %d\\n\", is_restricted_user (\"luser\"));
+ printf (\"nobody: %d\\n\", is_restricted_user (\"nobody\"));
+}")
+ (goto-char (point-min))
+ (should (eq (bidi-find-overridden-directionality (point-min) (point-max)
+ nil)
+ 138))))
+
+(ert-deftest xdisp-tests--find-directional-overrides-case-3 ()
+ (with-temp-buffer
+ (insert "\
+#define is_restricted_user(user) \\
+ !strcmp (user, \"root\") ? 0 : \\
+ !strcmp (user, \"admin\") ? 0 : \\
+ !strcmp (user, \"superuser‮⁦? '#' : '!'⁩ ⁦\")⁩‬
+
+int main () {
+ printf (\"root: %d\\n\", is_restricted_user (\"root\"));
+ printf (\"admin: %d\\n\", is_restricted_user (\"admin\"));
+ printf (\"superuser: %d\\n\", is_restricted_user (\"superuser\"));
+ printf (\"luser: %d\\n\", is_restricted_user (\"luser\"));
+ printf (\"nobody: %d\\n\", is_restricted_user (\"nobody\"));
+}")
+ (goto-char (point-min))
+ (should (eq (bidi-find-overridden-directionality (point-min) (point-max)
+ nil)
+ 138))))
+
+(ert-deftest test-get-display-property ()
+ (with-temp-buffer
+ (insert (propertize "foo" 'face 'bold 'display '(height 2.0)))
+ (should (equal (get-display-property 2 'height) 2.0)))
+ (with-temp-buffer
+ (insert (propertize "foo" 'face 'bold 'display '((height 2.0)
+ (space-width 2.0))))
+ (should (equal (get-display-property 2 'height) 2.0))
+ (should (equal (get-display-property 2 'space-width) 2.0)))
+ (with-temp-buffer
+ (insert (propertize "foo bar" 'face 'bold
+ 'display '[(height 2.0)
+ (space-width 20)]))
+ (should (equal (get-display-property 2 'height) 2.0))
+ (should (equal (get-display-property 2 'space-width) 20))))
+
;;; xdisp-tests.el ends here
diff --git a/test/src/xml-tests.el b/test/src/xml-tests.el
index 62054ce0e3c..6a8290bd0c8 100644
--- a/test/src/xml-tests.el
+++ b/test/src/xml-tests.el
@@ -27,6 +27,8 @@
(require 'ert)
+(declare-function libxml-parse-xml-region "xml.c")
+
(defvar libxml-tests--data-comments-preserved
`(;; simple case
("<?xml version=\"1.0\"?><foo baz=\"true\">bar</foo>"
generated by cgit v1.2.3 (git 2.39.1) at 2025-04-10 04:10:57 +0000