diff options
Diffstat (limited to 'test/src')
40 files changed, 934 insertions, 263 deletions
diff --git a/test/src/alloc-tests.el b/test/src/alloc-tests.el index 1324c2d3b4d..5383c436035 100644 --- a/test/src/alloc-tests.el +++ b/test/src/alloc-tests.el @@ -58,3 +58,5 @@ (dolist (c (list 10003 ?b 128 ?c ?d (max-char) ?e)) (aset s 0 c) (should (equal s (make-string 1 c)))))) + +;;; alloc-tests.el ends here diff --git a/test/src/buffer-tests.el b/test/src/buffer-tests.el index 11f842e8fe0..7943ac2ec26 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 () @@ -754,7 +756,7 @@ with parameters from the *Messages* buffer modification." (should-length 2 (overlays-in 1 (point-max))) (should-length 1 (overlays-in (point-max) (point-max))) (narrow-to-region 1 50) - (should-length 0 (overlays-in 1 (point-max))) + (should-length 1 (overlays-in 1 (point-max))) (should-length 1 (overlays-in (point-max) (point-max)))))) @@ -1399,4 +1401,85 @@ with parameters from the *Messages* buffer modification." (should (memq long-overlay (overlays-in 3 3))) (should (memq zero-overlay (overlays-in 3 3)))))) +(ert-deftest test-remove-overlays () + (with-temp-buffer + (insert "foo") + (make-overlay (point) (point)) + (should (= (length (overlays-in (point-min) (point-max))) 1)) + (remove-overlays) + (should (= (length (overlays-in (point-min) (point-max))) 0))) + + (with-temp-buffer + (insert "foo") + (goto-char 2) + (make-overlay (point) (point)) + ;; We only count zero-length overlays at the end of the buffer. + (should (= (length (overlays-in 1 2)) 0)) + (narrow-to-region 1 2) + ;; We've now narrowed, so the zero-length overlay is at the end of + ;; the (accessible part of the) buffer. + (should (= (length (overlays-in 1 2)) 1)) + (remove-overlays) + (should (= (length (overlays-in (point-min) (point-max))) 0)))) + +(ert-deftest test-kill-buffer-auto-save-default () + (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 () + (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 9fa54dcaf43..dbbe9f30925 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/character-tests.el b/test/src/character-tests.el index f630b32a5ee..ba24d49039c 100644 --- a/test/src/character-tests.el +++ b/test/src/character-tests.el @@ -43,3 +43,5 @@ (should (= (string-width "áëòç" nil 4) 2)) (should (= (string-width "הַרְבֵּה אַהֲבָה") 9)) (should (= (string-width "הַרְבֵּה אַהֲבָה" nil 8) 4))) + +;;; character-tests.el ends here diff --git a/test/src/charset-tests.el b/test/src/charset-tests.el index 5c46627c163..23e201ad453 100644 --- a/test/src/charset-tests.el +++ b/test/src/charset-tests.el @@ -22,7 +22,9 @@ (require 'ert) (ert-deftest charset-decode-char () - "Test decode-char." + "Test `decode-char'." (should-error (decode-char 'ascii 0.5))) (provide 'charset-tests) + +;;; charset-tests.el ends here diff --git a/test/src/coding-tests.el b/test/src/coding-tests.el index 0309b2b1ad6..1c585ea5377 100644 --- a/test/src/coding-tests.el +++ b/test/src/coding-tests.el @@ -56,7 +56,7 @@ (set-buffer-multibyte nil) (insert (encode-coding-string "あ" 'euc-jp) "\xd" "\n") (decode-coding-region (point-min) (point-max) 'euc-jp-dos) - (should-not (string-match-p "\^M" (buffer-string))))) + (should-not (string-search "\^M" (buffer-string))))) ;; Return the contents (specified by CONTENT-TYPE; ascii, latin, or ;; binary) of a test file. @@ -434,4 +434,4 @@ ;; End: (provide 'coding-tests) -;; coding-tests.el ends here +;;; coding-tests.el ends here diff --git a/test/src/comp-resources/comp-test-funcs.el b/test/src/comp-resources/comp-test-funcs.el index f2a246320ac..6352a7c7e94 100644 --- a/test/src/comp-resources/comp-test-funcs.el +++ b/test/src/comp-resources/comp-test-funcs.el @@ -202,7 +202,7 @@ (defun comp-tests-err-arith-f () (/ 1 0)) (defun comp-tests-err-foo-f () - (error "foo")) + (error "Foo")) (defun comp-tests-condition-case-0-f () ;; Bpushhandler Bpophandler @@ -264,7 +264,7 @@ (% a b))) (defun comp-tests-doc-f () - "A nice docstring" + "A nice docstring." t) (defun comp-test-interactive-form0-f (dir) @@ -478,6 +478,7 @@ (eq family 'unspecified)) family))) +;; This function doesn't have a doc string on purpose. (defun comp-test-46670-1-f (_) "foo") @@ -647,7 +648,7 @@ (?> 2)))) (defun comp-test-big-interactive (filename &optional force arg load) - ;; Check non trivial interactive form using `byte-recompile-file'. + "Check non trivial interactive form using `byte-recompile-file'." (interactive (let ((file buffer-file-name) (file-name nil) @@ -683,17 +684,17 @@ (defun comp-test-no-return-1 (x) (while x - (error "foo"))) + (error "Foo"))) (defun comp-test-no-return-2 (x) (cond ((eql x '2) t) - ((error "bar") nil))) + ((error "Bar") nil))) (defun comp-test-no-return-3 ()) (defun comp-test-no-return-4 (x) (when x - (error "foo") + (error "Foo") (while (comp-test-no-return-3) (comp-test-no-return-3)))) diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el index fb9441eb66e..025bc2058ec 100644 --- a/test/src/comp-tests.el +++ b/test/src/comp-tests.el @@ -53,30 +53,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." @@ -285,7 +287,7 @@ Check that the resulting binaries do not differ." (should (string= (comp-tests-condition-case-0-f) "arith-error Arithmetic error catched")) (should (string= (comp-tests-condition-case-1-f) - "error foo catched")) + "error Foo catched")) (should (= (comp-tests-catch-f (lambda () (throw 'foo 3))) 3)) @@ -333,7 +335,7 @@ Check that the resulting binaries do not differ." (comp-deftest doc () (should (string= (documentation #'comp-tests-doc-f) - "A nice docstring")) + "A nice docstring.")) ;; Check a preloaded function, we can't use `comp-tests-doc-f' now ;; as this is loaded manually with no .elc. (should (string-match "\\.*.elc\\'" (symbol-file #'error)))) @@ -1167,7 +1169,7 @@ Return a list of results." ;; 49 ((defun comp-tests-ret-type-spec-f () - (error "foo")) + (error "Foo")) nil) ;; 50 @@ -1373,7 +1375,7 @@ Return a list of results." (defun comp-tests-pure-checker-1 (_) "Check that inside `comp-tests-pure-caller-f' `comp-tests-pure-callee-f' is - folded." +folded." (should (cl-notany #'identity diff --git a/test/src/data-tests.el b/test/src/data-tests.el index b1e5fa0767c..756c41b6ff3 100644 --- a/test/src/data-tests.el +++ b/test/src/data-tests.el @@ -26,10 +26,10 @@ (defconst data-tests--float-greater-than-fixnums (+ 1.0 most-positive-fixnum) "A floating-point value that is greater than all fixnums. It is also as small as conveniently possible, to make the tests sharper. -Adding 1.0 to most-positive-fixnum should suffice on all +Adding 1.0 to `most-positive-fixnum' should suffice on all practical Emacs platforms, since the result is a power of 2 and this is exactly representable and is greater than -most-positive-fixnum, which is just less than a power of 2.") +`most-positive-fixnum', which is just less than a power of 2.") (ert-deftest data-tests-= () (should-error (=)) @@ -204,11 +204,11 @@ most-positive-fixnum, which is just less than a power of 2.") ""))) (defun test-bool-vector-count-consecutive-tc (desc) - "Run a test case for bool-vector-count-consecutive. + "Run a test case for `bool-vector-count-consecutive'. DESC is a string describing the test. It is a sequence of hexadecimal digits describing the bool vector. We exhaustively test all counts at all possible positions in the vector by -comparing the subr with a much slower lisp implementation." +comparing the subr with a much slower Lisp implementation." (let ((bv (test-bool-vector-bv-from-hex-string desc))) (cl-loop for lf in '(nil t) @@ -338,7 +338,7 @@ comparing the subr with a much slower lisp implementation." (should (eq binding-test-some-local 'local)))) (ert-deftest binding-test-setq-default () - "Test that a setq-default has no effect when there is a local binding." + "Test that a `setq-default' has no effect when there is a local binding." (with-current-buffer binding-test-buffer-B ;; This variable is not local in this buffer. (let ((binding-test-some-local 'something-else)) @@ -399,28 +399,28 @@ comparing the subr with a much slower lisp implementation." (eq binding-test-some-local 'outer)))))) (ert-deftest binding-test-defvar-bool () - "Test DEFVAR_BOOL" + "Test DEFVAR_BOOL." (let ((display-hourglass 5)) (should (eq display-hourglass t)))) (ert-deftest binding-test-defvar-int () - "Test DEFVAR_INT" + "Test DEFVAR_INT." (should-error (setq gc-cons-threshold 5.0) :type 'wrong-type-argument)) (ert-deftest binding-test-set-constant-t () - "Test setting the constant t" + "Test setting the constant t." (with-no-warnings (should-error (setq t 'bob) :type 'setting-constant))) (ert-deftest binding-test-set-constant-nil () - "Test setting the constant nil" + "Test setting the constant nil." (with-no-warnings (should-error (setq nil 'bob) :type 'setting-constant))) (ert-deftest binding-test-set-constant-keyword () - "Test setting a keyword constant" + "Test setting a keyword constant." (with-no-warnings (should-error (setq :keyword 'bob) :type 'setting-constant))) (ert-deftest binding-test-set-constant-nil () - "Test setting a keyword to itself" + "Test setting a keyword to itself." (with-no-warnings (should (setq :keyword :keyword)))) (ert-deftest data-tests--set-default-per-buffer () @@ -757,7 +757,7 @@ comparing the subr with a much slower lisp implementation." ;; forwarding, but this needs to happen before the var is accessed ;; from the Lisp side and before we switch to another buffer. ;; The trigger in bug#34318 doesn't exist any more because the C code has - ;; changes. Instead I found the trigger below. + ;; changed. Instead I found the trigger below. (with-temp-buffer (setq last-coding-system-used 'bug34318) (make-local-variable 'last-coding-system-used) diff --git a/test/src/decompress-tests.el b/test/src/decompress-tests.el index 520445cca5a..1d25cf2f66b 100644 --- a/test/src/decompress-tests.el +++ b/test/src/decompress-tests.el @@ -42,4 +42,4 @@ (provide 'decompress-tests) -;;; decompress-tests.el ends here. +;;; decompress-tests.el ends here diff --git a/test/src/editfns-tests.el b/test/src/editfns-tests.el index a731a95ccf0..e83dd7c857b 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")))))) diff --git a/test/src/emacs-module-resources/mod-test.c b/test/src/emacs-module-resources/mod-test.c index 5720af8c605..4c0b168e34d 100644 --- a/test/src/emacs-module-resources/mod-test.c +++ b/test/src/emacs-module-resources/mod-test.c @@ -298,7 +298,10 @@ Fmod_test_userptr_make (emacs_env *env, ptrdiff_t nargs, emacs_value args[], { struct super_struct *p = calloc (1, sizeof *p); if (!p) - signal_errno (env, "calloc"); + { + signal_errno (env, "calloc"); + return NULL; + } p->amazing_int = env->extract_integer (env, args[0]); return env->make_user_ptr (env, free, p); } diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el index a4d858113ed..442bca5facb 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 @@ -324,7 +315,9 @@ local reference." (mod-test-sum a b) -Return A + B" +Return A + B + +" module-file-suffix)))))) (ert-deftest module/load-history () diff --git a/test/src/emacs-tests.el b/test/src/emacs-tests.el index ac08e055b55..a1a412423cb 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 b2b7dfefda5..3c3e7033419 100644 --- a/test/src/eval-tests.el +++ b/test/src/eval-tests.el @@ -39,31 +39,40 @@ (ert-deftest eval-tests--bugs-24912-and-24913 () "Check that Emacs doesn't accept weird argument lists. Bug#24912 and Bug#24913." - (dolist (args '((&rest &optional) - (&rest a &optional) (&rest &optional a) - (&optional &optional) (&optional &optional a) - (&optional a &optional b) - (&rest &rest) (&rest &rest a) - (&rest a &rest b))) - (should-error (eval `(funcall (lambda ,args)) t) :type 'invalid-function) - (should-error (byte-compile-check-lambda-list args)) - (let ((byte-compile-debug t)) - (ert-info ((format "bytecomp: args = %S" args)) - (should-error (eval `(byte-compile (lambda ,args)) t)))))) - -(ert-deftest eval-tests-accept-empty-optional-rest () - "Check that Emacs accepts empty &optional and &rest arglists. + (dolist (lb '(t false)) + (ert-info ((prin1-to-string lb) :prefix "lexical-binding: ") + (let ((lexical-binding lb)) + (dolist (args '((&rest &optional) + (&rest a &optional) (&rest &optional a) + (&optional &optional) (&optional &optional a) + (&optional a &optional b) + (&rest &rest) (&rest &rest a) + (&rest a &rest b) + (&rest) (&optional &rest) + )) + (ert-info ((prin1-to-string args) :prefix "args: ") + (should-error + (eval `(funcall (lambda ,args)) lb) :type 'invalid-function) + (should-error (byte-compile-check-lambda-list args)) + (let ((byte-compile-debug t)) + (should-error (eval `(byte-compile (lambda ,args)) lb))))))))) + +(ert-deftest eval-tests-accept-empty-optional () + "Check that Emacs accepts empty &optional arglists. Bug#24912." - (dolist (args '((&optional) (&rest) (&optional &rest) - (&optional &rest a) (&optional a &rest))) - (let ((fun `(lambda ,args 'ok))) - (ert-info ("eval") - (should (eq (funcall (eval fun t)) 'ok))) - (ert-info ("byte comp check") - (byte-compile-check-lambda-list args)) - (ert-info ("bytecomp") - (let ((byte-compile-debug t)) - (should (eq (funcall (byte-compile fun)) 'ok))))))) + (dolist (lb '(t false)) + (ert-info ((prin1-to-string lb) :prefix "lexical-binding: ") + (let ((lexical-binding lb)) + (dolist (args '((&optional) (&optional &rest a))) + (ert-info ((prin1-to-string args) :prefix "args: ") + (let ((fun `(lambda ,args 'ok))) + (ert-info ("eval") + (should (eq (funcall (eval fun lb)) 'ok))) + (ert-info ("byte comp check") + (byte-compile-check-lambda-list args)) + (ert-info ("bytecomp") + (let ((byte-compile-debug t)) + (should (eq (funcall (byte-compile fun)) 'ok))))))))))) (dolist (form '(let let*)) diff --git a/test/src/fileio-tests.el b/test/src/fileio-tests.el index f4d123b4261..4143503aa18 100644 --- a/test/src/fileio-tests.el +++ b/test/src/fileio-tests.el @@ -17,6 +17,8 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. +;;; Code: + (require 'ert) (defun try-link (target link) @@ -97,7 +99,7 @@ Also check that an encoding error can appear in a symlink." (should (equal (file-name-as-directory "D:/abc//") "d:/abc//"))) (ert-deftest fileio-tests--relative-HOME () - "Test that expand-file-name works even when HOME is relative." + "Test that `expand-file-name' works even when HOME is relative." (let ((process-environment (copy-sequence process-environment))) (setenv "HOME" "a/b/c") (should (equal (expand-file-name "~/foo") @@ -128,7 +130,7 @@ Also check that an encoding error can appear in a symlink." (if f (delete-file f))))) (ert-deftest fileio-tests--relative-default-directory () - "Test expand-file-name when default-directory is relative." + "Test `expand-file-name' when `default-directory' is relative." (let ((default-directory "some/relative/name")) (should (file-name-absolute-p (expand-file-name "foo")))) (let* ((default-directory "~foo") @@ -136,8 +138,17 @@ Also check that an encoding error can appear in a symlink." (should (and (file-name-absolute-p name) (not (eq (aref name 0) ?~)))))) +(ert-deftest fileio-test--expand-file-name-null-bytes () + "Test that `expand-file-name' checks for null bytes in filenames." + (should-error (expand-file-name (concat "file" (char-to-string ?\0) ".txt")) + :type 'wrong-type-argument) + (should-error (expand-file-name "file.txt" (concat "dir" (char-to-string ?\0))) + :type 'wrong-type-argument) + (let ((default-directory (concat "dir" (char-to-string ?\0)))) + (should-error (expand-file-name "file.txt") :type 'wrong-type-argument))) + (ert-deftest fileio-tests--file-name-absolute-p () - "Test file-name-absolute-p." + "Test `file-name-absolute-p'." (dolist (suffix '("" "/" "//" "/foo" "/foo/" "/foo//" "/foo/bar")) (unless (string-equal suffix "") (should (file-name-absolute-p suffix))) @@ -148,7 +159,7 @@ Also check that an encoding error can appear in a symlink." (should (not (file-name-absolute-p (concat "~nosuchuser" suffix))))))) (ert-deftest fileio-tests--circular-after-insert-file-functions () - "Test after-insert-file-functions as a circular list." + "Test `after-insert-file-functions' as a circular list." (let ((f (make-temp-file "fileio")) (after-insert-file-functions (list 'identity))) (setcdr after-insert-file-functions after-insert-file-functions) diff --git a/test/src/filelock-tests.el b/test/src/filelock-tests.el index a96d6d67289..ba001679639 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. diff --git a/test/src/floatfns-tests.el b/test/src/floatfns-tests.el index 4a3c03d833e..a066d2e15e2 100644 --- a/test/src/floatfns-tests.el +++ b/test/src/floatfns-tests.el @@ -17,8 +17,72 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. +;;; Code: + (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))) @@ -125,3 +189,5 @@ (ash (1- (ash 1 53)) 2045)))) (provide 'floatfns-tests) + +;;; floatfns-tests.el ends here diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el index 9f6593a177c..bec5c03f9e7 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)) @@ -430,6 +480,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)) @@ -786,7 +853,15 @@ ;; string containing hanzi character, compare by character (should (equal 2 (string-distance "ab" "ab我她"))) (should (equal 1 (string-distance "ab" "a我b"))) - (should (equal 1 (string-distance "我" "她")))) + (should (equal 1 (string-distance "我" "她"))) + + ;; correct behaviour with empty strings + (should (equal 0 (string-distance "" ""))) + (should (equal 0 (string-distance "" "" t))) + (should (equal 1 (string-distance "x" ""))) + (should (equal 1 (string-distance "x" "" t))) + (should (equal 1 (string-distance "" "x"))) + (should (equal 1 (string-distance "" "x" t)))) (ert-deftest test-bignum-eql () "Test that `eql' works for bignums." @@ -1106,3 +1181,5 @@ (should (= (line-number-at-pos nil) 11)) (should-error (line-number-at-pos -1)) (should-error (line-number-at-pos 100)))) + +;;; fns-tests.el ends here diff --git a/test/src/font-tests.el b/test/src/font-tests.el index de153b8de9b..ea57b122f4f 100644 --- a/test/src/font-tests.el +++ b/test/src/font-tests.el @@ -159,6 +159,31 @@ expected font properties from parsing NAME.") (insert "\n")))) (goto-char (point-min))) +(ert-deftest font-parse-xlfd-test () + ;; Normal number of segments. + (should (equal (font-get + (font-spec :name "-GNU -FreeSans-semibold-italic-normal-*-*-*-*-*-*-0-iso10646-1") + :family) + 'FreeSans)) + (should (equal (font-get + (font-spec :name "-GNU -FreeSans-semibold-italic-normal-*-*-*-*-*-*-0-iso10646-1") + :foundry) + 'GNU\ )) + ;; Dash in the family name. + (should (equal (font-get + (font-spec :name "-Take-mikachan-PS-normal-normal-normal-*-*-*-*-*-*-0-iso10646-1") + :family) + 'mikachan-PS)) + (should (equal (font-get + (font-spec :name "-Take-mikachan-PS-normal-normal-normal-*-*-*-*-*-*-0-iso10646-1") + :weight) + 'normal)) + ;; Synthetic test. + (should (equal (font-get + (font-spec :name "-foundry-name-with-lots-of-dashes-normal-normal-normal-*-*-*-*-*-*-0-iso10646-1") + :family) + 'name-with-lots-of-dashes))) + ;; Local Variables: ;; no-byte-compile: t ;; End: diff --git a/test/src/image-tests.el b/test/src/image-tests.el new file mode 100644 index 00000000000..2b236086b6f --- /dev/null +++ b/test/src/image-tests.el @@ -0,0 +1,245 @@ +;;; 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 (init-image-library 'xpm)) ; built-in + (should-not (init-image-library 'invalid-image-type))) + +;;; image-tests.el ends here diff --git a/test/src/indent-tests.el b/test/src/indent-tests.el index 6a3f1a5c95f..6cfe64c07e4 100644 --- a/test/src/indent-tests.el +++ b/test/src/indent-tests.el @@ -57,3 +57,5 @@ (move-to-column 12 t) (buffer-substring-no-properties 1 14)) "\txxx \tLine"))) + +;;; indent-tests.el ends here diff --git a/test/src/inotify-tests.el b/test/src/inotify-tests.el index 5572c7d7a0f..70330ac8657 100644 --- a/test/src/inotify-tests.el +++ b/test/src/inotify-tests.el @@ -24,6 +24,7 @@ ;;; 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)) @@ -37,8 +38,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,24 +50,22 @@ (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) -;;; inotify-tests.el ends here. +;;; inotify-tests.el ends here diff --git a/test/src/json-tests.el b/test/src/json-tests.el index 908945fcb08..8dc0a744aa0 100644 --- a/test/src/json-tests.el +++ b/test/src/json-tests.el @@ -252,7 +252,7 @@ Test with both unibyte and multibyte strings." (let* ((input "{ \"abc\" : [9, false] , \"def\" : null }") (output - (replace-regexp-in-string " " "" input))) + (string-replace " " "" input))) (should (equal (json-parse-string input :object-type 'plist :null-object :json-null diff --git a/test/src/keymap-tests.el b/test/src/keymap-tests.el index a9b0cb502d3..8e28faf2b26 100644 --- a/test/src/keymap-tests.el +++ b/test/src/keymap-tests.el @@ -124,6 +124,55 @@ ;; (ert-deftest keymap-lookup-key/accept-default () ;; ...) +(ert-deftest keymap-lookup-key/mixed-case () + "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)) + (should (eq (lookup-key map [menu-bar Foo Bar]) 'foo))) + (let ((map (make-keymap))) + (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" @@ -269,16 +318,17 @@ commit 86c19714b097aa477d339ed99ffb5136c755a046." (shadow-map (let ((map (make-keymap))) (define-key map "f" 'bar) map)) - (text-quoting-style 'grave)) + (text-quoting-style 'grave) + (describe-bindings-check-shadowing-in-ranges 'ignore-self-insert)) (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." @@ -299,10 +349,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]) @@ -316,6 +366,13 @@ 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))) + (provide 'keymap-tests) ;;; keymap-tests.el ends here diff --git a/test/src/lcms-tests.el b/test/src/lcms-tests.el index 40a48f1e9bb..d2d137e9bd5 100644 --- a/test/src/lcms-tests.el +++ b/test/src/lcms-tests.el @@ -95,7 +95,7 @@ B is considered the exact value." '(0.29902 0.31485 1.0)))) (ert-deftest lcms-roundtrip () - "Test accuracy of converting to and from different color spaces" + "Test accuracy of converting to and from different color spaces." (skip-unless (featurep 'lcms2)) (should (let ((color '(.5 .3 .7))) @@ -109,7 +109,7 @@ B is considered the exact value." 0.0001)))) (ert-deftest lcms-ciecam02-gold () - "Test CIE CAM02 JCh gold values" + "Test CIE CAM02 JCh gold values." (skip-unless (featurep 'lcms2)) (should (lcms-triple-approx-p diff --git a/test/src/lread-tests.el b/test/src/lread-tests.el index dac8f95bc4d..be685fe999f 100644 --- a/test/src/lread-tests.el +++ b/test/src/lread-tests.el @@ -119,14 +119,6 @@ (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 +129,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/marker-tests.el b/test/src/marker-tests.el index 234a0b35ea7..cf8e82cd560 100644 --- a/test/src/marker-tests.el +++ b/test/src/marker-tests.el @@ -57,4 +57,4 @@ (set-marker marker-2 marker-1) (should (goto-char marker-2)))) -;;; marker-tests.el ends here. +;;; marker-tests.el ends here diff --git a/test/src/minibuf-tests.el b/test/src/minibuf-tests.el index c55611eb84b..51d9c67453e 100644 --- a/test/src/minibuf-tests.el +++ b/test/src/minibuf-tests.el @@ -406,7 +406,7 @@ (should (equal (try-completion "bar" '("bArfoo" "barbaz")) (try-completion "bar" '("barbaz" "bArfoo")))) ;; bug#11339 - (should (equal (try-completion "baz" '("baz" "bAz")) "baz")) ;And not `t'! + (should (equal (try-completion "baz" '("baz" "bAz")) "baz")) ;And not t! (should (equal (try-completion "baz" '("bAz" "baz")) (try-completion "baz" '("baz" "bAz")))))) @@ -414,8 +414,8 @@ (let ((inhibit-interaction t)) (should-error (read-from-minibuffer "foo: ") :type 'inhibited-interaction) - (should-error (y-or-n-p "foo: ") :type 'inhibited-interaction) - (should-error (yes-or-no-p "foo: ") :type 'inhibited-interaction) + (should-error (y-or-n-p "Foo?") :type 'inhibited-interaction) + (should-error (yes-or-no-p "Foo?") :type 'inhibited-interaction) (should-error (read-no-blanks-input "foo: ") :type 'inhibited-interaction) ;; See that we get the expected error. diff --git a/test/src/process-tests.el b/test/src/process-tests.el index 9bab523708e..b831ca3bdaa 100644 --- a/test/src/process-tests.el +++ b/test/src/process-tests.el @@ -25,6 +25,7 @@ (require 'cl-lib) (require 'ert) +(require 'ert-x) ; ert-with-temp-directory (require 'puny) (require 'subr-x) (require 'dns) @@ -64,24 +65,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 +530,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 +617,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)) @@ -745,7 +732,7 @@ Return nil if that can't be determined." process-tests--EMFILE-message) (ert-deftest process-tests/sentinel-called () - "Check that sentinels are called after processes finish" + "Check that sentinels are called after processes finish." (let ((command (process-tests--emacs-command))) (skip-unless command) (dolist (conn-type '(pipe pty)) @@ -946,5 +933,11 @@ Return nil if FILENAME doesn't exist." (when buf (kill-buffer buf))))) +(ert-deftest process-num-processors () + "Sanity checks for num-processors." + (should (equal (num-processors) (num-processors))) + (should (integerp (num-processors))) + (should (< 0 (num-processors)))) + (provide 'process-tests) ;;; process-tests.el ends here diff --git a/test/src/regex-emacs-tests.el b/test/src/regex-emacs-tests.el index 0607eacf397..71e3189443e 100644 --- a/test/src/regex-emacs-tests.el +++ b/test/src/regex-emacs-tests.el @@ -279,11 +279,11 @@ on success" (defconst regex-tests-re-even-escapes "\\(?:^\\|[^\\]\\)\\(?:\\\\\\\\\\)*" - "Regex that matches an even number of \\ characters") + "Regex that matches an even number of \\ characters.") (defconst regex-tests-re-odd-escapes (concat regex-tests-re-even-escapes "\\\\") - "Regex that matches an odd number of \\ characters") + "Regex that matches an odd number of \\ characters.") (defun regex-tests-unextend (pattern) @@ -396,9 +396,9 @@ pattern)" ;; emacs matches non-greedy regex ab.*? non-greedily 639 677 712 ] - "Line numbers in the boost test that should be skipped. These -are false-positive test failures that represent known/benign -differences in behavior.") + "Line numbers in the boost test that should be skipped. +These are false-positive test failures that represent +known/benign differences in behavior.") ;; - Format ;; - Comments are lines starting with ; @@ -480,9 +480,9 @@ differences in behavior.") ;; ambiguous groupings are ambiguous 610 611 1154 1157 1160 1168 1171 1176 1179 1182 1185 1188 1193 1196 1203 ] - "Line numbers in the PCRE test that should be skipped. These -are false-positive test failures that represent known/benign -differences in behavior.") + "Line numbers in the PCRE test that should be skipped. +These are false-positive test failures that represent +known/benign differences in behavior.") ;; - Format ;; @@ -562,9 +562,9 @@ differences in behavior.") ;; fails to match 168 ] - "Line numbers in the PTESTS test that should be skipped. These -are false-positive test failures that represent known/benign -differences in behavior.") + "Line numbers in the PTESTS test that should be skipped. +These are false-positive test failures that represent +known/benign differences in behavior.") ;; - Format ;; - fields separated by ¦ (note: this is not a |) @@ -621,9 +621,9 @@ differences in behavior.") ;; emacs is more stringent with regexes involving unbalanced ) 67 ] - "Line numbers in the TESTS test that should be skipped. These -are false-positive test failures that represent known/benign -differences in behavior.") + "Line numbers in the TESTS test that should be skipped. +These are false-positive test failures that represent +known/benign differences in behavior.") ;; - Format ;; - fields separated by :. Watch for [\[:xxx:]] diff --git a/test/src/search-tests.el b/test/src/search-tests.el new file mode 100644 index 00000000000..b7b4ab9a8ff --- /dev/null +++ b/test/src/search-tests.el @@ -0,0 +1,42 @@ +;;; search-tests.el --- tests for search.c functions -*- lexical-binding: t -*- + +;; Copyright (C) 2015-2016, 2018-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/>. + +;;; Code: + +(require 'ert) + +(ert-deftest test-replace-match-modification-hooks () + (let ((ov-set nil)) + (with-temp-buffer + (insert "1 abc") + (setq ov-set (make-overlay 3 5)) + (overlay-put + ov-set 'modification-hooks + (list (lambda (o after &rest _args) + (when after + (let ((inhibit-modification-hooks t)) + (save-excursion + (goto-char 2) + (insert "234"))))))) + (goto-char 3) + (if (search-forward "bc") + (replace-match "bcd")) + (should (= (point) 10))))) + +;;; search-tests.el ends here diff --git a/test/src/syntax-tests.el b/test/src/syntax-tests.el index e4e3054d37a..bd89283dd14 100644 --- a/test/src/syntax-tests.el +++ b/test/src/syntax-tests.el @@ -500,4 +500,10 @@ the `parse-partial-sexp's are expected to stop. See (syntax-pps-comments /* 56 76 77 58) (syntax-pps-comments /* 60 78 79) +(ert-deftest test-from-to-parse-partial-sexp () + (with-temp-buffer + (insert "foo") + (should (parse-partial-sexp 1 1)) + (should-error (parse-partial-sexp 2 1)))) + ;;; syntax-tests.el ends here diff --git a/test/src/textprop-tests.el b/test/src/textprop-tests.el index b083588e645..c001579c474 100644 --- a/test/src/textprop-tests.el +++ b/test/src/textprop-tests.el @@ -69,4 +69,4 @@ (null stack))))) (provide 'textprop-tests) -;; textprop-tests.el ends here. +;;; textprop-tests.el ends here diff --git a/test/src/thread-tests.el b/test/src/thread-tests.el index fc7bc7441b7..52eace7e9d2 100644 --- a/test/src/thread-tests.el +++ b/test/src/thread-tests.el @@ -70,12 +70,12 @@ (thread-live-p (make-thread #'ignore)))) (ert-deftest threads-all-threads () - "Simple test for all-threads." + "Simple test for `all-threads'." (skip-unless (featurep 'threads)) (should (listp (all-threads)))) (ert-deftest threads-main-thread () - "Simple test for all-threads." + "Simple test for `all-threads'." (skip-unless (featurep 'threads)) (should (eq main-thread (car (all-threads))))) @@ -155,7 +155,7 @@ (should (eq (type-of (make-mutex)) 'mutex))) (ert-deftest threads-mutex-lock-unlock () - "Test mutex-lock and unlock." + "Test `mutex-lock' and unlock." (skip-unless (featurep 'threads)) (should (let ((mx (make-mutex))) @@ -392,4 +392,4 @@ (let ((th (make-thread 'ignore))) (should-not (equal th main-thread)))) -;;; threads.el ends here +;;; thread-tests.el ends here diff --git a/test/src/timefns-tests.el b/test/src/timefns-tests.el index 0a450a7573f..bba9b3fcd8c 100644 --- a/test/src/timefns-tests.el +++ b/test/src/timefns-tests.el @@ -241,3 +241,5 @@ a fixed place on the right and are padded on the left." (let ((xdiv (/ x divisor))) (should (= xdiv (float-time (time-convert xdiv t)))))) (setq x (* x 2))))) + +;;; timefns-tests.el ends here diff --git a/test/src/undo-tests.el b/test/src/undo-tests.el index a658bccf6dc..88fcfad14cc 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 4e7d2ad8ab2..cc67aef8e15 100644 --- a/test/src/xdisp-tests.el +++ b/test/src/xdisp-tests.el @@ -99,4 +99,59 @@ (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)))) + ;;; xdisp-tests.el ends here diff --git a/test/src/xfaces-tests.el b/test/src/xfaces-tests.el index 0a7ef55b2b6..cba706f4535 100644 --- a/test/src/xfaces-tests.el +++ b/test/src/xfaces-tests.el @@ -17,6 +17,8 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. +;;; Code: + (require 'ert) (ert-deftest xfaces-color-distance () @@ -48,3 +50,5 @@ (should (equal (color-values-from-color-spec "rgbi:0/0.5/10") nil))) (provide 'xfaces-tests) + +;;; xfaces-tests.el ends here diff --git a/test/src/xml-tests.el b/test/src/xml-tests.el index a35b4d2ccc8..7c4ca396f70 100644 --- a/test/src/xml-tests.el +++ b/test/src/xml-tests.el @@ -52,4 +52,4 @@ (should (equal (cdr test) (libxml-parse-xml-region (point-min) (point-max))))))) -;;; libxml-tests.el ends here +;;; xml-tests.el ends here |