summaryrefslogtreecommitdiff
path: root/test/src
diff options
context:
space:
mode:
Diffstat (limited to 'test/src')
-rw-r--r--test/src/alloc-tests.el7
-rw-r--r--test/src/buffer-tests.el20
-rw-r--r--test/src/callproc-tests.el17
-rw-r--r--test/src/charset-tests.el2
-rw-r--r--test/src/chartab-tests.el2
-rw-r--r--test/src/cmds-tests.el2
-rw-r--r--test/src/coding-tests.el64
-rw-r--r--test/src/decompress-tests.el2
-rw-r--r--test/src/doc-tests.el2
-rw-r--r--test/src/emacs-module-tests.el64
-rw-r--r--test/src/floatfns-tests.el2
-rw-r--r--test/src/fns-tests.el58
-rw-r--r--test/src/font-tests.el2
-rw-r--r--test/src/keymap-tests.el2
-rw-r--r--test/src/lread-tests.el16
-rw-r--r--test/src/process-tests.el14
-rw-r--r--test/src/regex-emacs-tests.el6
-rw-r--r--test/src/textprop-tests.el2
-rw-r--r--test/src/thread-tests.el2
-rw-r--r--test/src/timefns-tests.el51
-rw-r--r--test/src/undo-tests.el4
-rw-r--r--test/src/xfaces-tests.el50
-rw-r--r--test/src/xml-tests.el2
23 files changed, 303 insertions, 90 deletions
diff --git a/test/src/alloc-tests.el b/test/src/alloc-tests.el
index 4eb776a0555..aa1ab1648f8 100644
--- a/test/src/alloc-tests.el
+++ b/test/src/alloc-tests.el
@@ -51,3 +51,10 @@
(should-not (eq x y))
(dotimes (i 4)
(should (eql (aref x i) (aref y i))))))
+
+;; Bug#39207
+(ert-deftest aset-nbytes-change ()
+ (let ((s (make-string 1 ?a)))
+ (dolist (c (list 10003 ?b 128 ?c ?d (max-char) ?e))
+ (aset s 0 c)
+ (should (equal s (make-string 1 c))))))
diff --git a/test/src/buffer-tests.el b/test/src/buffer-tests.el
index 60d29dd3a12..0db66f97517 100644
--- a/test/src/buffer-tests.el
+++ b/test/src/buffer-tests.el
@@ -1314,4 +1314,24 @@ with parameters from the *Messages* buffer modification."
(ovshould nonempty-eob-end 4 5)
(ovshould empty-eob 5 5)))))
+(ert-deftest buffer-multibyte-overlong-sequences ()
+ (dolist (uni '("\xE0\x80\x80"
+ "\xF0\x80\x80\x80"
+ "\xF8\x8F\xBF\xBF\x80"))
+ (let ((multi (string-to-multibyte uni)))
+ (should
+ (string-equal
+ multi
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (insert uni)
+ (set-buffer-multibyte t)
+ (buffer-string)))))))
+
+;; https://debbugs.gnu.org/33492
+(ert-deftest buffer-tests-buffer-local-variables-undo ()
+ "Test that `buffer-undo-list' appears in `buffer-local-variables'."
+ (with-temp-buffer
+ (should (assq 'buffer-undo-list (buffer-local-variables)))))
+
;;; buffer-tests.el ends here
diff --git a/test/src/callproc-tests.el b/test/src/callproc-tests.el
index 39d2014488a..1617d5e33d3 100644
--- a/test/src/callproc-tests.el
+++ b/test/src/callproc-tests.el
@@ -17,6 +17,11 @@
;; 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:
+;;
+;; Unit tests for src/callproc.c.
+
;;; Code:
(require 'ert)
@@ -60,3 +65,15 @@
(call-process "c:/nul.exe")
(error :got-error))))
(should have-called-debugger)))
+
+(ert-deftest call-process-region-entire-buffer-with-delete ()
+ "Check that Bug#40576 is fixed."
+ (let ((emacs (expand-file-name invocation-name invocation-directory)))
+ (skip-unless (file-executable-p emacs))
+ (with-temp-buffer
+ (insert "Buffer contents\n")
+ (should
+ (eq (call-process-region nil nil emacs :delete nil nil "--version") 0))
+ (should (eq (buffer-size) 0)))))
+
+;;; callproc-tests.el ends here
diff --git a/test/src/charset-tests.el b/test/src/charset-tests.el
index 01a68c21a52..9a1d0a46f91 100644
--- a/test/src/charset-tests.el
+++ b/test/src/charset-tests.el
@@ -1,4 +1,4 @@
-;;; charset-tests.el --- Tests for charset.c
+;;; charset-tests.el --- Tests for charset.c -*- lexical-binding: t -*-
;; Copyright 2017-2020 Free Software Foundation, Inc.
diff --git a/test/src/chartab-tests.el b/test/src/chartab-tests.el
index da320e33b51..0ddea2b338c 100644
--- a/test/src/chartab-tests.el
+++ b/test/src/chartab-tests.el
@@ -1,4 +1,4 @@
-;;; chartab-tests.el --- Tests for char-tab.c
+;;; chartab-tests.el --- Tests for char-tab.c -*- lexical-binding: t -*-
;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
diff --git a/test/src/cmds-tests.el b/test/src/cmds-tests.el
index 8604d346109..e98e5784609 100644
--- a/test/src/cmds-tests.el
+++ b/test/src/cmds-tests.el
@@ -1,4 +1,4 @@
-;;; cmds-tests.el --- Testing some Emacs commands
+;;; cmds-tests.el --- Testing some Emacs commands -*- lexical-binding: t -*-
;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
diff --git a/test/src/coding-tests.el b/test/src/coding-tests.el
index 094a1fad8fa..c438ae22ce3 100644
--- a/test/src/coding-tests.el
+++ b/test/src/coding-tests.el
@@ -1,4 +1,4 @@
-;;; coding-tests.el --- tests for text encoding and decoding
+;;; coding-tests.el --- tests for text encoding and decoding -*- lexical-binding: t -*-
;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
@@ -296,7 +296,7 @@
;;; decoder, not for regression testing.
(defun generate-ascii-file ()
- (dotimes (i 100000)
+ (dotimes (_i 100000)
(insert-char ?a 80)
(insert "\n")))
@@ -309,13 +309,13 @@
(insert "\n")))
(defun generate-mostly-nonascii-file ()
- (dotimes (i 30000)
+ (dotimes (_i 30000)
(insert-char ?a 80)
(insert "\n"))
- (dotimes (i 20000)
+ (dotimes (_i 20000)
(insert-char ?À 80)
(insert "\n"))
- (dotimes (i 10000)
+ (dotimes (_i 10000)
(insert-char ?あ 80)
(insert "\n")))
@@ -375,6 +375,60 @@
(with-temp-buffer (insert-file-contents (car file))))))
(insert (format "%s: %s\n" (car file) result)))))))
+(ert-deftest coding-nocopy-trivial ()
+ "Check that the NOCOPY parameter works for the trivial coding system."
+ (let ((s "abc"))
+ (should-not (eq (decode-coding-string s nil nil) s))
+ (should (eq (decode-coding-string s nil t) s))
+ (should-not (eq (encode-coding-string s nil nil) s))
+ (should (eq (encode-coding-string s nil t) s))))
+
+(ert-deftest coding-nocopy-ascii ()
+ "Check that the NOCOPY parameter works for ASCII-only strings."
+ (let* ((uni (apply #'string (number-sequence 0 127)))
+ (multi (string-to-multibyte uni)))
+ (dolist (s (list uni multi))
+ ;; Encodings without EOL conversion.
+ (dolist (coding '(us-ascii-unix iso-latin-1-unix utf-8-unix))
+ (should-not (eq (decode-coding-string s coding nil) s))
+ (should-not (eq (encode-coding-string s coding nil) s))
+ (should (eq (decode-coding-string s coding t) s))
+ (should (eq (encode-coding-string s coding t) s))
+ (should (eq last-coding-system-used coding)))
+
+ ;; With EOL conversion inhibited.
+ (let ((inhibit-eol-conversion t))
+ (dolist (coding '(us-ascii iso-latin-1 utf-8))
+ (should-not (eq (decode-coding-string s coding nil) s))
+ (should-not (eq (encode-coding-string s coding nil) s))
+ (should (eq (decode-coding-string s coding t) s))
+ (should (eq (encode-coding-string s coding t) s))))))
+
+ ;; Check identity decoding with EOL conversion for ASCII except CR.
+ (let* ((uni (apply #'string (delq ?\r (number-sequence 0 127))))
+ (multi (string-to-multibyte uni)))
+ (dolist (s (list uni multi))
+ (dolist (coding '(us-ascii-dos iso-latin-1-dos utf-8-dos mac-roman-mac))
+ (should-not (eq (decode-coding-string s coding nil) s))
+ (should (eq (decode-coding-string s coding t) s)))))
+
+ ;; Check identity encoding with EOL conversion for ASCII except LF.
+ (let* ((uni (apply #'string (delq ?\n (number-sequence 0 127))))
+ (multi (string-to-multibyte uni)))
+ (dolist (s (list uni multi))
+ (dolist (coding '(us-ascii-dos iso-latin-1-dos utf-8-dos mac-roman-mac))
+ (should-not (eq (encode-coding-string s coding nil) s))
+ (should (eq (encode-coding-string s coding t) s))))))
+
+
+(ert-deftest coding-check-coding-systems-region ()
+ (should (equal (check-coding-systems-region "aå" nil '(utf-8))
+ nil))
+ (should (equal (check-coding-systems-region "aåbγc" nil
+ '(utf-8 iso-latin-1 us-ascii))
+ '((iso-latin-1 3) (us-ascii 1 3))))
+ (should-error (check-coding-systems-region "å" nil '(bad-coding-system))))
+
;; Local Variables:
;; byte-compile-warnings: (not obsolete)
;; End:
diff --git a/test/src/decompress-tests.el b/test/src/decompress-tests.el
index 46fd26635c9..0a328396818 100644
--- a/test/src/decompress-tests.el
+++ b/test/src/decompress-tests.el
@@ -1,4 +1,4 @@
-;;; decompress-tests.el --- Test suite for decompress.
+;;; decompress-tests.el --- Test suite for decompress. -*- lexical-binding: t -*-
;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
diff --git a/test/src/doc-tests.el b/test/src/doc-tests.el
index b6026e79c65..50cf0144b80 100644
--- a/test/src/doc-tests.el
+++ b/test/src/doc-tests.el
@@ -1,4 +1,4 @@
-;;; doc-tests.el --- Tests for doc.c
+;;; doc-tests.el --- Tests for doc.c -*- lexical-binding: t -*-
;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el
index 91206156f85..51b2ca0cd51 100644
--- a/test/src/emacs-module-tests.el
+++ b/test/src/emacs-module-tests.el
@@ -60,8 +60,9 @@
(should (eq 0
(string-match
(concat "#<module function "
- "\\(at \\(0x\\)?[[:xdigit:]]+\\( from .*\\)?"
- "\\|Fmod_test_sum from .*\\)>")
+ "\\(at \\(0x\\)?[[:xdigit:]]+ "
+ "with data 0x1234\\( from .*\\)?"
+ "\\|Fmod_test_sum with data 0x1234 from .*\\)>")
(prin1-to-string (nth 1 descr)))))
(should (= (nth 2 descr) 3)))
(should-error (mod-test-sum "1" 2) :type 'wrong-type-argument)
@@ -97,6 +98,7 @@ changes."
(rx bos "#<module function "
(or "Fmod_test_sum"
(and "at 0x" (+ hex-digit)))
+ " with data 0x1234"
(? " from " (* nonl) "mod-test" (* nonl) )
">" eos)
(prin1-to-string func)))))
@@ -318,6 +320,9 @@ local reference."
(with-temp-buffer
(let ((standard-output (current-buffer)))
(describe-function-1 #'mod-test-sum)
+ (goto-char (point-min))
+ (while (re-search-forward "`[^']*/data/emacs-module/" nil t)
+ (replace-match "`data/emacs-module/"))
(should (equal
(buffer-substring-no-properties 1 (point-max))
(format "a module function in `data/emacs-module/mod-test%s'.
@@ -416,4 +421,59 @@ Interactively, you can try hitting \\[keyboard-quit] to quit."
(ert-info ((format "input: %d" input))
(should (= (mod-test-double input) (* 2 input))))))
+(ert-deftest module-darwin-secondary-suffix ()
+ "Check that on Darwin, both .so and .dylib suffixes work.
+See Bug#36226."
+ (skip-unless (eq system-type 'darwin))
+ (should (member ".dylib" load-suffixes))
+ (should (member ".so" load-suffixes))
+ ;; Preserve the old `load-history'. This is needed for some of the
+ ;; other unit tests that indirectly rely on `load-history'.
+ (let ((load-history load-history)
+ (dylib (concat mod-test-file ".dylib"))
+ (so (concat mod-test-file ".so")))
+ (should (file-regular-p dylib))
+ (should-not (file-exists-p so))
+ (add-name-to-file dylib so)
+ (unwind-protect
+ (load so nil nil :nosuffix :must-suffix)
+ (delete-file so))))
+
+(ert-deftest module/function-finalizer ()
+ "Test that module function finalizers are properly called."
+ ;; We create and leak a couple of module functions with attached
+ ;; finalizer. Creating only one function risks spilling it to the
+ ;; stack, where it wouldn't be garbage-collected. However, with one
+ ;; hundred functions, there should be at least one that's
+ ;; unreachable.
+ (dotimes (_ 100)
+ (mod-test-make-function-with-finalizer))
+ (cl-destructuring-bind (valid-before invalid-before)
+ (mod-test-function-finalizer-calls)
+ (should (zerop invalid-before))
+ (garbage-collect)
+ (cl-destructuring-bind (valid-after invalid-after)
+ (mod-test-function-finalizer-calls)
+ (should (zerop invalid-after))
+ ;; We don't require exactly 100 invocations of the finalizer,
+ ;; but at least one.
+ (should (> valid-after valid-before)))))
+
+(ert-deftest module/async-pipe ()
+ "Check that writing data from another thread works."
+ (skip-unless (not (eq system-type 'windows-nt))) ; FIXME!
+ (with-temp-buffer
+ (let ((process (make-pipe-process :name "module/async-pipe"
+ :buffer (current-buffer)
+ :coding 'utf-8-unix
+ :noquery t)))
+ (unwind-protect
+ (progn
+ (mod-test-async-pipe process)
+ (should (accept-process-output process 1))
+ ;; The string below must be identical to what
+ ;; mod-test.c:write_to_pipe produces.
+ (should (equal (buffer-string) "data from thread")))
+ (delete-process process)))))
+
;;; emacs-module-tests.el ends here
diff --git a/test/src/floatfns-tests.el b/test/src/floatfns-tests.el
index c1c2c8996a7..8c56674d4fd 100644
--- a/test/src/floatfns-tests.el
+++ b/test/src/floatfns-tests.el
@@ -1,4 +1,4 @@
-;;; floatfns-tests.el --- tests for floating point operations
+;;; floatfns-tests.el --- tests for floating point operations -*- lexical-binding: t -*-
;; Copyright 2017-2020 Free Software Foundation, Inc.
diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el
index 60be2c6c2d7..f1faf58659a 100644
--- a/test/src/fns-tests.el
+++ b/test/src/fns-tests.el
@@ -49,21 +49,21 @@
(should-error (nreverse))
(should-error (nreverse 1))
(should-error (nreverse (make-char-table 'foo)))
- (should (equal (nreverse "xyzzy") "yzzyx"))
- (let ((A []))
+ (should (equal (nreverse (copy-sequence "xyzzy")) "yzzyx"))
+ (let ((A (vector)))
(nreverse A)
(should (equal A [])))
- (let ((A [0]))
+ (let ((A (vector 0)))
(nreverse A)
(should (equal A [0])))
- (let ((A [1 2 3 4]))
+ (let ((A (vector 1 2 3 4)))
(nreverse A)
(should (equal A [4 3 2 1])))
- (let ((A [1 2 3 4]))
+ (let ((A (vector 1 2 3 4)))
(nreverse A)
(nreverse A)
(should (equal A [1 2 3 4])))
- (let* ((A [1 2 3 4])
+ (let* ((A (vector 1 2 3 4))
(B (nreverse (nreverse A))))
(should (equal A B))))
@@ -146,13 +146,13 @@
;; Invalid UTF-8 sequences shall be indicated. How to create such strings?
(ert-deftest fns-tests-sort ()
- (should (equal (sort '(9 5 2 -1 5 3 8 7 4) (lambda (x y) (< x y)))
+ (should (equal (sort (list 9 5 2 -1 5 3 8 7 4) (lambda (x y) (< x y)))
'(-1 2 3 4 5 5 7 8 9)))
- (should (equal (sort '(9 5 2 -1 5 3 8 7 4) (lambda (x y) (> x y)))
+ (should (equal (sort (list 9 5 2 -1 5 3 8 7 4) (lambda (x y) (> x y)))
'(9 8 7 5 5 4 3 2 -1)))
- (should (equal (sort '[9 5 2 -1 5 3 8 7 4] (lambda (x y) (< x y)))
+ (should (equal (sort (vector 9 5 2 -1 5 3 8 7 4) (lambda (x y) (< x y)))
[-1 2 3 4 5 5 7 8 9]))
- (should (equal (sort '[9 5 2 -1 5 3 8 7 4] (lambda (x y) (> x y)))
+ (should (equal (sort (vector 9 5 2 -1 5 3 8 7 4) (lambda (x y) (> x y)))
[9 8 7 5 5 4 3 2 -1]))
(should (equal
(sort
@@ -172,7 +172,7 @@
;; Punctuation and whitespace characters are relevant for POSIX.
(should
(equal
- (sort '("11" "12" "1 1" "1 2" "1.1" "1.2")
+ (sort (list "11" "12" "1 1" "1 2" "1.1" "1.2")
(lambda (a b) (string-collate-lessp a b "POSIX")))
'("1 1" "1 2" "1.1" "1.2" "11" "12")))
;; Punctuation and whitespace characters are not taken into account
@@ -180,7 +180,7 @@
(when (eq system-type 'windows-nt)
(should
(equal
- (sort '("11" "12" "1 1" "1 2" "1.1" "1.2")
+ (sort (list "11" "12" "1 1" "1 2" "1.1" "1.2")
(lambda (a b)
(let ((w32-collate-ignore-punctuation t))
(string-collate-lessp
@@ -190,7 +190,7 @@
;; Diacritics are different letters for POSIX, they sort lexicographical.
(should
(equal
- (sort '("Ævar" "Agustín" "Adrian" "Eli")
+ (sort (list "Ævar" "Agustín" "Adrian" "Eli")
(lambda (a b) (string-collate-lessp a b "POSIX")))
'("Adrian" "Agustín" "Eli" "Ævar")))
;; Diacritics are sorted between similar letters for other locales,
@@ -198,7 +198,7 @@
(when (eq system-type 'windows-nt)
(should
(equal
- (sort '("Ævar" "Agustín" "Adrian" "Eli")
+ (sort (list "Ævar" "Agustín" "Adrian" "Eli")
(lambda (a b)
(let ((w32-collate-ignore-punctuation t))
(string-collate-lessp
@@ -212,7 +212,7 @@
(should (not (string-version-lessp "foo20000.png" "foo12.png")))
(should (string-version-lessp "foo.png" "foo2.png"))
(should (not (string-version-lessp "foo2.png" "foo.png")))
- (should (equal (sort '("foo12.png" "foo2.png" "foo1.png")
+ (should (equal (sort (list "foo12.png" "foo2.png" "foo1.png")
'string-version-lessp)
'("foo1.png" "foo2.png" "foo12.png")))
(should (string-version-lessp "foo2" "foo1234"))
@@ -432,9 +432,9 @@
(should-error (mapcan))
(should-error (mapcan #'identity))
(should-error (mapcan #'identity (make-char-table 'foo)))
- (should (equal (mapcan #'list '(1 2 3)) '(1 2 3)))
+ (should (equal (mapcan #'list (list 1 2 3)) '(1 2 3)))
;; `mapcan' is destructive
- (let ((data '((foo) (bar))))
+ (let ((data (list (list 'foo) (list 'bar))))
(should (equal (mapcan #'identity data) '(foo bar)))
(should (equal data '((foo bar) (bar))))))
@@ -858,6 +858,22 @@
(puthash k k h)))
(should (= 100 (hash-table-count h)))))
+(ert-deftest test-sxhash-equal ()
+ (should (= (sxhash-equal (* most-positive-fixnum most-negative-fixnum))
+ (sxhash-equal (* most-positive-fixnum most-negative-fixnum))))
+ (should (= (sxhash-equal (make-string 1000 ?a))
+ (sxhash-equal (make-string 1000 ?a))))
+ (should (= (sxhash-equal (point-marker))
+ (sxhash-equal (point-marker))))
+ (should (= (sxhash-equal (make-vector 1000 (make-string 10 ?a)))
+ (sxhash-equal (make-vector 1000 (make-string 10 ?a)))))
+ (should (= (sxhash-equal (make-bool-vector 1000 t))
+ (sxhash-equal (make-bool-vector 1000 t))))
+ (should (= (sxhash-equal (make-char-table nil (make-string 10 ?a)))
+ (sxhash-equal (make-char-table nil (make-string 10 ?a)))))
+ (should (= (sxhash-equal (record 'a (make-string 10 ?a)))
+ (sxhash-equal (record 'a (make-string 10 ?a))))))
+
(ert-deftest test-secure-hash ()
(should (equal (secure-hash 'md5 "foobar")
"3858f62230ac3c915f300c664312c63f"))
@@ -874,6 +890,8 @@
(should (equal (secure-hash 'sha512 "foobar")
(concat "0a50261ebd1a390fed2bf326f2673c145582a6342d5"
"23204973d0219337f81616a8069b012587cf5635f69"
- "25f1b56c360230c19b273500ee013e030601bf2425"))))
-
-(provide 'fns-tests)
+ "25f1b56c360230c19b273500ee013e030601bf2425")))
+ ;; Test that a call to getrandom returns the right format.
+ ;; This does not test randomness; it's merely a format check.
+ (should (string-match "\\`[0-9a-f]\\{128\\}\\'"
+ (secure-hash 'sha512 'iv-auto 100))))
diff --git a/test/src/font-tests.el b/test/src/font-tests.el
index 73c2846b032..cfc6f4c31b7 100644
--- a/test/src/font-tests.el
+++ b/test/src/font-tests.el
@@ -1,4 +1,4 @@
-;;; font-tests.el --- Test suite for font-related functions.
+;;; font-tests.el --- Test suite for font-related functions. -*- lexical-binding: t -*-
;; Copyright (C) 2011-2020 Free Software Foundation, Inc.
diff --git a/test/src/keymap-tests.el b/test/src/keymap-tests.el
index dbf0a7d1229..75f8c0f092e 100644
--- a/test/src/keymap-tests.el
+++ b/test/src/keymap-tests.el
@@ -1,4 +1,4 @@
-;;; keymap-tests.el --- Test suite for src/keymap.c
+;;; keymap-tests.el --- Test suite for src/keymap.c -*- lexical-binding: t -*-
;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
diff --git a/test/src/lread-tests.el b/test/src/lread-tests.el
index 1426b0145e0..6efd8bed302 100644
--- a/test/src/lread-tests.el
+++ b/test/src/lread-tests.el
@@ -157,22 +157,6 @@ literals (Bug#20852)."
(load "somelib" nil t)
(should (string-suffix-p "/somelib.el" (caar load-history)))))
-(ert-deftest lread-tests--old-style-backquotes ()
- "Check that loading doesn't accept old-style backquotes."
- (lread-tests--with-temp-file file-name
- (write-region "(` (a b))" nil file-name)
- (let ((data (should-error (load file-name nil :nomessage :nosuffix))))
- (should (equal (cdr data)
- (list (concat (format-message "Loading `%s': " file-name)
- "old-style backquotes detected!")))))))
-
-(ert-deftest lread-tests--force-new-style-backquotes ()
- (let ((data (should-error (read "(` (a b))"))))
- (should (equal (cdr data) '("Old-style backquotes detected!"))))
- (should (equal (let ((force-new-style-backquotes t))
- (read "(` (a b))"))
- '(`(a b)))))
-
(ert-deftest lread-lread--substitute-object-in-subtree ()
(let ((x (cons 0 1)))
(setcar x x)
diff --git a/test/src/process-tests.el b/test/src/process-tests.el
index 66a76fd33b8..748afe41d2c 100644
--- a/test/src/process-tests.el
+++ b/test/src/process-tests.el
@@ -1,4 +1,4 @@
-;;; process-tests.el --- Testing the process facilities
+;;; process-tests.el --- Testing the process facilities -*- lexical-binding: t -*-
;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
@@ -33,7 +33,7 @@
(let ((proc (start-process "test" nil "bash" "-c" "exit 20"))
(sentinel-called nil)
(start-time (float-time)))
- (set-process-sentinel proc (lambda (proc msg)
+ (set-process-sentinel proc (lambda (_proc _msg)
(setq sentinel-called t)))
(while (not (or sentinel-called
(> (- (float-time) start-time)
@@ -88,7 +88,7 @@
:stderr stderr-buffer))
(sentinel-called nil)
(start-time (float-time)))
- (set-process-sentinel proc (lambda (proc msg)
+ (set-process-sentinel proc (lambda (_proc _msg)
(setq sentinel-called t)))
(while (not (or sentinel-called
(> (- (float-time) start-time)
@@ -120,13 +120,13 @@
"exit 20"))
:stderr stderr-proc))
(start-time (float-time)))
- (set-process-filter proc (lambda (proc input)
+ (set-process-filter proc (lambda (_proc input)
(push input stdout-output)))
- (set-process-sentinel proc (lambda (proc msg)
+ (set-process-sentinel proc (lambda (_proc _msg)
(setq sentinel-called t)))
- (set-process-filter stderr-proc (lambda (proc input)
+ (set-process-filter stderr-proc (lambda (_proc input)
(push input stderr-output)))
- (set-process-sentinel stderr-proc (lambda (proc input)
+ (set-process-sentinel stderr-proc (lambda (_proc _input)
(setq stderr-sentinel-called t)))
(while (not (or sentinel-called
(> (- (float-time) start-time)
diff --git a/test/src/regex-emacs-tests.el b/test/src/regex-emacs-tests.el
index 6a661afeff9..f9372e37b11 100644
--- a/test/src/regex-emacs-tests.el
+++ b/test/src/regex-emacs-tests.el
@@ -161,7 +161,7 @@ what failed, if anything; valid values are 'search-failed,
'compilation-failed and nil. I compare the beginning/end of each
group with their expected values. This is done with either
BOUNDS-REF or SUBSTRING-REF; one of those should be non-nil.
-BOUNDS-REF is a sequence \[start-ref0 end-ref0 start-ref1
+BOUNDS-REF is a sequence [start-ref0 end-ref0 start-ref1
end-ref1 ....] while SUBSTRING-REF is the expected substring
obtained by indexing the input string by start/end-ref.
@@ -327,7 +327,7 @@ emacs requires an extra symbol character"
(defun regex-tests-BOOST-frob-escapes (s ispattern)
"Mangle \\ the way it is done in frob_escapes() in
regex-tests-BOOST.c in glibc: \\t, \\n, \\r are interpreted;
-\\\\, \\^, \{, \\|, \} are unescaped for the string (not
+\\\\, \\^, \\{, \\|, \\} are unescaped for the string (not
pattern)"
;; this is all similar to (regex-tests-unextend)
@@ -505,7 +505,7 @@ differences in behavior.")
(cond
;; pattern
- ((save-excursion (re-search-forward "^/\\(.*\\)/\\(.*i?\\)$" nil t))
+ ((save-excursion (re-search-forward "^/\\(.*\\)/\\(.*\\)$" nil t))
(setq icase (string= "i" (match-string 2))
pattern (regex-tests-unextend (match-string 1))))
diff --git a/test/src/textprop-tests.el b/test/src/textprop-tests.el
index 7333444df0b..365d2c7a7b7 100644
--- a/test/src/textprop-tests.el
+++ b/test/src/textprop-tests.el
@@ -1,4 +1,4 @@
-;;; textprop-tests.el --- Test suite for text properties.
+;;; textprop-tests.el --- Test suite for text properties. -*- lexical-binding: t -*-
;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
diff --git a/test/src/thread-tests.el b/test/src/thread-tests.el
index 5d85fc74e50..df34a2b66eb 100644
--- a/test/src/thread-tests.el
+++ b/test/src/thread-tests.el
@@ -1,4 +1,4 @@
-;;; threads.el --- tests for threads.
+;;; threads.el --- tests for threads. -*- lexical-binding: t -*-
;; Copyright (C) 2012-2020 Free Software Foundation, Inc.
diff --git a/test/src/timefns-tests.el b/test/src/timefns-tests.el
index 62d56ac0d9f..51dd1d1aeb5 100644
--- a/test/src/timefns-tests.el
+++ b/test/src/timefns-tests.el
@@ -1,4 +1,4 @@
-;;; timefns-tests.el -- tests for timefns.c
+;;; timefns-tests.el -- tests for timefns.c -*- lexical-binding: t -*-
;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
@@ -124,44 +124,44 @@
;;; Tests of format-time-string padding
(ert-deftest format-time-string-padding-minimal-deletes-unneeded-zeros ()
- (let ((ref-time (append (encode-time 0 0 0 15 2 2000) '(123450))))
+ (let ((ref-time (encode-time '((123450 . 1000000) 0 0 15 2 2000 - - t))))
(should (equal (format-time-string "%-:::z" ref-time "FJT-12") "+12"))
- (should (equal (format-time-string "%-N" ref-time) "12345"))
- (should (equal (format-time-string "%-6N" ref-time) "12345"))
- (should (equal (format-time-string "%-m" ref-time) "2")))) ;not "02"
+ (should (equal (format-time-string "%-N" ref-time t) "12345"))
+ (should (equal (format-time-string "%-6N" ref-time t) "12345"))
+ (should (equal (format-time-string "%-m" ref-time t) "2")))) ;not "02"
(ert-deftest format-time-string-padding-minimal-retains-needed-zeros ()
- (let ((ref-time (append (encode-time 0 0 0 20 10 2000) '(3450))))
+ (let ((ref-time (encode-time '((3450 . 1000000) 0 0 20 10 2000 - - t))))
(should (equal (format-time-string "%-z" ref-time "IST-5:30") "+530"))
(should (equal (format-time-string "%-4z" ref-time "IST-5:30") "+530"))
(should (equal (format-time-string "%4z" ref-time "IST-5:30") "+530"))
- (should (equal (format-time-string "%-N" ref-time) "00345"))
- (should (equal (format-time-string "%-3N" ref-time) "003"))
- (should (equal (format-time-string "%3N" ref-time) "003"))
- (should (equal (format-time-string "%-m" ref-time) "10")) ;not "1"
- (should (equal (format-time-string "%-1m" ref-time) "10")) ;not "1"
- (should (equal (format-time-string "%1m" ref-time) "10")))) ;not "1"
+ (should (equal (format-time-string "%-N" ref-time t) "00345"))
+ (should (equal (format-time-string "%-3N" ref-time t) "003"))
+ (should (equal (format-time-string "%3N" ref-time t) "003"))
+ (should (equal (format-time-string "%-m" ref-time t) "10")) ;not "1"
+ (should (equal (format-time-string "%-1m" ref-time t) "10")) ;not "1"
+ (should (equal (format-time-string "%1m" ref-time t) "10")))) ;not "1"
(ert-deftest format-time-string-padding-spaces ()
- (let ((ref-time (append (encode-time 0 0 0 10 12 2000) '(123000))))
+ (let ((ref-time (encode-time '((123000 . 1000000) 0 0 10 12 2000 - - t))))
(should (equal (format-time-string "%_7z" ref-time "CHA-12:45") " +1245"))
- (should (equal (format-time-string "%_6N" ref-time) "123 "))
- (should (equal (format-time-string "%_9N" ref-time) "123 "))
- (should (equal (format-time-string "%_12N" ref-time) "123 "))
- (should (equal (format-time-string "%_m" ref-time) "12"))
- (should (equal (format-time-string "%_2m" ref-time) "12"))
- (should (equal (format-time-string "%_3m" ref-time) " 12"))))
+ (should (equal (format-time-string "%_6N" ref-time t) "123 "))
+ (should (equal (format-time-string "%_9N" ref-time t) "123 "))
+ (should (equal (format-time-string "%_12N" ref-time t) "123 "))
+ (should (equal (format-time-string "%_m" ref-time t) "12"))
+ (should (equal (format-time-string "%_2m" ref-time t) "12"))
+ (should (equal (format-time-string "%_3m" ref-time t) " 12"))))
(ert-deftest format-time-string-padding-zeros-adds-on-insignificant-side ()
"Fractional seconds have a fixed place on the left,
and any padding must happen on the right. All other numbers have
a fixed place on the right and are padded on the left."
- (let ((ref-time (append (encode-time 0 0 0 10 12 2000) '(123000))))
- (should (equal (format-time-string "%3m" ref-time) "012"))
+ (let ((ref-time (encode-time '((123000 . 1000000) 0 0 10 12 2000 - - t))))
+ (should (equal (format-time-string "%3m" ref-time t) "012"))
(should (equal (format-time-string "%7z" ref-time "CHA-12:45") "+001245"))
- (should (equal (format-time-string "%12N" ref-time) "123000000000"))
- (should (equal (format-time-string "%9N" ref-time) "123000000"))
- (should (equal (format-time-string "%6N" ref-time) "123000"))))
+ (should (equal (format-time-string "%12N" ref-time t) "123000000000"))
+ (should (equal (format-time-string "%9N" ref-time t) "123000000"))
+ (should (equal (format-time-string "%6N" ref-time t) "123000"))))
(ert-deftest time-equal-p-nil-nil ()
@@ -220,6 +220,9 @@ a fixed place on the right and are padded on the left."
'(23752 27217))))
(ert-deftest float-time-precision ()
+ (should (= (float-time '(0 1 0 4025)) 1.000000004025))
+ (should (= (float-time '(1000000004025 . 1000000000000)) 1.000000004025))
+
(should (< 0 (float-time '(1 . 10000000000))))
(should (< (float-time '(-1 . 10000000000)) 0))
diff --git a/test/src/undo-tests.el b/test/src/undo-tests.el
index 995e4365e12..b26a276c61b 100644
--- a/test/src/undo-tests.el
+++ b/test/src/undo-tests.el
@@ -1,4 +1,4 @@
-;;; undo-tests.el --- Tests of primitive-undo
+;;; undo-tests.el --- Tests of primitive-undo -*- lexical-binding: t -*-
;; Copyright (C) 2012-2020 Free Software Foundation, Inc.
@@ -452,7 +452,7 @@ Demonstrates bug 25599."
(insert ";; aaaaaaaaa
;; bbbbbbbb")
(let ((overlay-modified
- (lambda (ov after-p _beg _end &optional length)
+ (lambda (ov after-p _beg _end &optional _length)
(unless after-p
(when (overlay-buffer ov)
(delete-overlay ov))))))
diff --git a/test/src/xfaces-tests.el b/test/src/xfaces-tests.el
new file mode 100644
index 00000000000..bde3a354229
--- /dev/null
+++ b/test/src/xfaces-tests.el
@@ -0,0 +1,50 @@
+;;; xfaces-tests.el --- tests for xfaces.c -*- lexical-binding: t -*-
+
+;; Copyright (C) 2020 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/>.
+
+(require 'ert)
+
+(ert-deftest xfaces-color-distance ()
+ ;; Check symmetry (bug#41544).
+ (should (equal (color-distance "#222222" "#ffffff")
+ (color-distance "#ffffff" "#222222"))))
+
+(ert-deftest xfaces-internal-color-values-from-color-spec ()
+ (should (equal (color-values-from-color-spec "#f05")
+ '(#xffff #x0000 #x5555)))
+ (should (equal (color-values-from-color-spec "#1fb0C5")
+ '(#x1f1f #xb0b0 #xc5c5)))
+ (should (equal (color-values-from-color-spec "#1f8b0AC5e")
+ '(#x1f81 #xb0aa #xc5eb)))
+ (should (equal (color-values-from-color-spec "#1f83b0ADC5e2")
+ '(#x1f83 #xb0ad #xc5e2)))
+ (should (equal (color-values-from-color-spec "#1f83b0ADC5e2g") nil))
+ (should (equal (color-values-from-color-spec "#1f83b0ADC5e20") nil))
+ (should (equal (color-values-from-color-spec "#12345") nil))
+ (should (equal (color-values-from-color-spec "rgb:f/23/28a")
+ '(#xffff #x2323 #x28a2)))
+ (should (equal (color-values-from-color-spec "rgb:1234/5678/09ab")
+ '(#x1234 #x5678 #x09ab)))
+ (should (equal (color-values-from-color-spec "rgb:0//0") nil))
+ (should (equal (color-values-from-color-spec "rgbi:0/0.5/0.1")
+ '(0 32768 6554)))
+ (should (equal (color-values-from-color-spec "rgbi:1e-3/1.0e-2/1e0")
+ '(66 655 65535)))
+ (should (equal (color-values-from-color-spec "rgbi:0/0.5/10") nil)))
+
+(provide 'xfaces-tests)
diff --git a/test/src/xml-tests.el b/test/src/xml-tests.el
index 02a52e9115d..d758c8868cf 100644
--- a/test/src/xml-tests.el
+++ b/test/src/xml-tests.el
@@ -1,4 +1,4 @@
-;;; libxml-parse-tests.el --- Test suite for libxml parsing.
+;;; xml-tests.el --- Test suite for libxml parsing. -*- lexical-binding: t -*-
;; Copyright (C) 2014-2020 Free Software Foundation, Inc.
generated by cgit v1.2.3 (git 2.39.1) at 2025-05-16 08:46:35 +0000