summaryrefslogtreecommitdiff
path: root/test/src
diff options
context:
space:
mode:
Diffstat (limited to 'test/src')
-rw-r--r--test/src/data-tests.el15
-rw-r--r--test/src/editfns-tests.el6
-rw-r--r--test/src/fileio-tests.el6
-rw-r--r--test/src/json-tests.el180
-rw-r--r--test/src/keyboard-tests.el36
-rw-r--r--test/src/lread-tests.el10
6 files changed, 243 insertions, 10 deletions
diff --git a/test/src/data-tests.el b/test/src/data-tests.el
index dda1278b6d4..3b88dbca9a2 100644
--- a/test/src/data-tests.el
+++ b/test/src/data-tests.el
@@ -107,6 +107,21 @@
(should (isnan (min 1.0 0.0e+NaN)))
(should (isnan (min 1.0 0.0e+NaN 1.1))))
+(defun data-tests-popcnt (byte)
+ "Calculate the Hamming weight of BYTE."
+ (if (< byte 0)
+ (setq byte (lognot byte)))
+ (setq byte (- byte (logand (lsh byte -1) #x55555555)))
+ (setq byte (+ (logand byte #x33333333) (logand (lsh byte -2) #x33333333)))
+ (lsh (* (logand (+ byte (lsh byte -4)) #x0f0f0f0f) #x01010101) -24))
+
+(ert-deftest data-tests-logcount ()
+ (should (cl-loop for n in (number-sequence -255 255)
+ always (= (logcount n) (data-tests-popcnt n))))
+ ;; https://oeis.org/A000120
+ (should (= 11 (logcount 9727)))
+ (should (= 8 (logcount 9999))))
+
;; Bool vector tests. Compactly represent bool vectors as hex
;; strings.
diff --git a/test/src/editfns-tests.el b/test/src/editfns-tests.el
index b72f37d1f01..69ea6f5cc8f 100644
--- a/test/src/editfns-tests.el
+++ b/test/src/editfns-tests.el
@@ -136,6 +136,12 @@
(ert-deftest format-c-float ()
(should-error (format "%c" 0.5)))
+;;; Test for Bug#29609.
+(ert-deftest format-sharp-0-x ()
+ (should (string-equal (format "%#08x" #x10) "0x000010"))
+ (should (string-equal (format "%#05X" #x10) "0X010"))
+ (should (string-equal (format "%#04x" 0) "0000")))
+
;;; Check format-time-string with various TZ settings.
;;; Use only POSIX-compatible TZ values, since the tests should work
;;; even if tzdb is not in use.
diff --git a/test/src/fileio-tests.el b/test/src/fileio-tests.el
index 5b4db5423fe..5d12685fa19 100644
--- a/test/src/fileio-tests.el
+++ b/test/src/fileio-tests.el
@@ -29,11 +29,7 @@
(defun fileio-tests--symlink-failure ()
(let* ((dir (make-temp-file "fileio" t))
- (link (expand-file-name "link" dir))
- (file-name-coding-system (if (and (eq system-type 'darwin)
- (featurep 'ucs-normalize))
- 'utf-8-hfs-unix
- file-name-coding-system)))
+ (link (expand-file-name "link" dir)))
(unwind-protect
(let (failure
(char 0))
diff --git a/test/src/json-tests.el b/test/src/json-tests.el
new file mode 100644
index 00000000000..107cab89083
--- /dev/null
+++ b/test/src/json-tests.el
@@ -0,0 +1,180 @@
+;;; json-tests.el --- unit tests for json.c -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2017 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Unit tests for src/json.c.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'map)
+
+(ert-deftest json-serialize/roundtrip ()
+ (skip-unless (fboundp 'json-serialize))
+ ;; The noncharacter U+FFFF should be passed through,
+ ;; cf. https://www.unicode.org/faq/private_use.html#noncharacters.
+ (let ((lisp [:null :false t 0 123 -456 3.75 "abc\uFFFFαβγ𝔸𝐁𝖢\"\\"])
+ (json "[null,false,true,0,123,-456,3.75,\"abc\uFFFFαβγ𝔸𝐁𝖢\\\"\\\\\"]"))
+ (should (equal (json-serialize lisp) json))
+ (with-temp-buffer
+ (json-insert lisp)
+ (should (equal (buffer-string) json))
+ (should (eobp)))
+ (should (equal (json-parse-string json) lisp))
+ (with-temp-buffer
+ (insert json)
+ (goto-char 1)
+ (should (equal (json-parse-buffer) lisp))
+ (should (eobp)))))
+
+(ert-deftest json-serialize/object ()
+ (skip-unless (fboundp 'json-serialize))
+ (let ((table (make-hash-table :test #'equal)))
+ (puthash "abc" [1 2 t] table)
+ (puthash "def" :null table)
+ (should (equal (json-serialize table)
+ "{\"abc\":[1,2,true],\"def\":null}")))
+ (should (equal (json-serialize '((abc . [1 2 t]) (def . :null)))
+ "{\"abc\":[1,2,true],\"def\":null}"))
+ (should (equal (json-serialize nil) "{}"))
+ (should (equal (json-serialize '((abc))) "{\"abc\":{}}"))
+ (should (equal (json-serialize '((a . 1) (b . 2) (a . 3)))
+ "{\"a\":1,\"b\":2}"))
+ (should-error (json-serialize '(abc)) :type 'wrong-type-argument)
+ (should-error (json-serialize '((a 1))) :type 'wrong-type-argument)
+ (should-error (json-serialize '((1 . 2))) :type 'wrong-type-argument)
+ (should-error (json-serialize '((a . 1) . b)) :type 'wrong-type-argument)
+ (should-error (json-serialize '#1=((a . 1) . #1#)) :type 'circular-list)
+ (should-error (json-serialize '(#1=(a #1#)))))
+
+(ert-deftest json-serialize/object-with-duplicate-keys ()
+ (skip-unless (fboundp 'json-serialize))
+ (let ((table (make-hash-table :test #'eq)))
+ (puthash (copy-sequence "abc") [1 2 t] table)
+ (puthash (copy-sequence "abc") :null table)
+ (should (equal (hash-table-count table) 2))
+ (should-error (json-serialize table) :type 'wrong-type-argument)))
+
+(ert-deftest json-parse-string/object ()
+ (skip-unless (fboundp 'json-parse-string))
+ (let ((input
+ "{ \"abc\" : [1, 2, true], \"def\" : null, \"abc\" : [9, false] }\n"))
+ (let ((actual (json-parse-string input)))
+ (should (hash-table-p actual))
+ (should (equal (hash-table-count actual) 2))
+ (should (equal (cl-sort (map-pairs actual) #'string< :key #'car)
+ '(("abc" . [9 :false]) ("def" . :null)))))
+ (should (equal (json-parse-string input :object-type 'alist)
+ '((abc . [9 :false]) (def . :null))))))
+
+(ert-deftest json-parse-string/string ()
+ (skip-unless (fboundp 'json-parse-string))
+ (should-error (json-parse-string "[\"formfeed\f\"]") :type 'json-parse-error)
+ (should (equal (json-parse-string "[\"foo \\\"bar\\\"\"]") ["foo \"bar\""]))
+ (should (equal (json-parse-string "[\"abcαβγ\"]") ["abcαβγ"]))
+ (should (equal (json-parse-string "[\"\\nasd\\u0444\\u044b\\u0432fgh\\t\"]")
+ ["\nasdфывfgh\t"]))
+ (should (equal (json-parse-string "[\"\\uD834\\uDD1E\"]") ["\U0001D11E"]))
+ (should-error (json-parse-string "foo") :type 'json-parse-error)
+ ;; FIXME: Is this the right behavior?
+ (should (equal (json-parse-string "[\"\u00C4\xC3\x84\"]") ["\u00C4\u00C4"])))
+
+(ert-deftest json-serialize/string ()
+ (skip-unless (fboundp 'json-serialize))
+ (should (equal (json-serialize ["foo"]) "[\"foo\"]"))
+ (should (equal (json-serialize ["a\n\fb"]) "[\"a\\n\\fb\"]"))
+ (should (equal (json-serialize ["\nasdфыв\u001f\u007ffgh\t"])
+ "[\"\\nasdфыв\\u001F\u007ffgh\\t\"]"))
+ (should (equal (json-serialize ["a\0b"]) "[\"a\\u0000b\"]"))
+ ;; FIXME: Is this the right behavior?
+ (should (equal (json-serialize ["\u00C4\xC3\x84"]) "[\"\u00C4\u00C4\"]")))
+
+(ert-deftest json-serialize/invalid-unicode ()
+ (skip-unless (fboundp 'json-serialize))
+ (should-error (json-serialize ["a\uDBBBb"]) :type 'wrong-type-argument)
+ (should-error (json-serialize ["u\x110000v"]) :type 'wrong-type-argument)
+ (should-error (json-serialize ["u\x3FFFFFv"]) :type 'wrong-type-argument)
+ (should-error (json-serialize ["u\xCCv"]) :type 'wrong-type-argument)
+ (should-error (json-serialize ["u\u00C4\xCCv"]) :type 'wrong-type-argument))
+
+(ert-deftest json-parse-string/null ()
+ (skip-unless (fboundp 'json-parse-string))
+ (should-error (json-parse-string "\x00") :type 'wrong-type-argument)
+ ;; FIXME: Reconsider whether this is the right behavior.
+ (should-error (json-parse-string "[a\\u0000b]") :type 'json-parse-error))
+
+(ert-deftest json-parse-string/invalid-unicode ()
+ "Some examples from
+https://www.cl.cam.ac.uk/~mgk25/ucs/examples/UTF-8-test.txt.
+Test with both unibyte and multibyte strings."
+ (skip-unless (fboundp 'json-parse-string))
+ ;; Invalid UTF-8 code unit sequences.
+ (should-error (json-parse-string "[\"\x80\"]") :type 'json-parse-error)
+ (should-error (json-parse-string "[\"\u00C4\x80\"]") :type 'json-parse-error)
+ (should-error (json-parse-string "[\"\xBF\"]") :type 'json-parse-error)
+ (should-error (json-parse-string "[\"\u00C4\xBF\"]") :type 'json-parse-error)
+ (should-error (json-parse-string "[\"\xFE\"]") :type 'json-parse-error)
+ (should-error (json-parse-string "[\"\u00C4\xFE\"]") :type 'json-parse-error)
+ (should-error (json-parse-string "[\"\xC0\xAF\"]") :type 'json-parse-error)
+ (should-error (json-parse-string "[\"\u00C4\xC0\xAF\"]")
+ :type 'json-parse-error)
+ (should-error (json-parse-string "[\"\u00C4\xC0\x80\"]")
+ :type 'json-parse-error)
+ ;; Surrogates.
+ (should-error (json-parse-string "[\"\uDB7F\"]")
+ :type 'json-parse-error)
+ (should-error (json-parse-string "[\"\xED\xAD\xBF\"]")
+ :type 'json-parse-error)
+ (should-error (json-parse-string "[\"\u00C4\xED\xAD\xBF\"]")
+ :type 'json-parse-error)
+ (should-error (json-parse-string "[\"\uDB7F\uDFFF\"]")
+ :type 'json-parse-error)
+ (should-error (json-parse-string "[\"\xED\xAD\xBF\xED\xBF\xBF\"]")
+ :type 'json-parse-error)
+ (should-error (json-parse-string "[\"\u00C4\xED\xAD\xBF\xED\xBF\xBF\"]")
+ :type 'json-parse-error))
+
+(ert-deftest json-parse-string/incomplete ()
+ (skip-unless (fboundp 'json-parse-string))
+ (should-error (json-parse-string "[123") :type 'json-end-of-file))
+
+(ert-deftest json-parse-string/trailing ()
+ (skip-unless (fboundp 'json-parse-string))
+ (should-error (json-parse-string "[123] [456]") :type 'json-trailing-content))
+
+(ert-deftest json-parse-buffer/incomplete ()
+ (skip-unless (fboundp 'json-parse-buffer))
+ (with-temp-buffer
+ (insert "[123")
+ (goto-char 1)
+ (should-error (json-parse-buffer) :type 'json-end-of-file)
+ (should (bobp))))
+
+(ert-deftest json-parse-buffer/trailing ()
+ (skip-unless (fboundp 'json-parse-buffer))
+ (with-temp-buffer
+ (insert "[123] [456]")
+ (goto-char 1)
+ (should (equal (json-parse-buffer) [123]))
+ (should-not (bobp))
+ (should (looking-at-p (rx " [456]" eos)))))
+
+(provide 'json-tests)
+;;; json-tests.el ends here
diff --git a/test/src/keyboard-tests.el b/test/src/keyboard-tests.el
new file mode 100644
index 00000000000..301cef0092c
--- /dev/null
+++ b/test/src/keyboard-tests.el
@@ -0,0 +1,36 @@
+;;; keyboard-tests.el --- Tests for keyboard.c -*- lexical-binding: t -*-
+
+;; Copyright (C) 2017 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 keyboard-unread-command-events ()
+ "Test `unread-command-events'."
+ (should (equal (progn (push ?\C-a unread-command-events)
+ (read-event nil nil 1))
+ ?\C-a))
+ (should (equal (progn (run-with-timer
+ 1 nil
+ (lambda () (push '(t . ?\C-b) unread-command-events)))
+ (read-event nil nil 2))
+ ?\C-b)))
+
+(provide 'keyboard-tests)
+;;; keyboard-tests.el ends here
diff --git a/test/src/lread-tests.el b/test/src/lread-tests.el
index 4fec9286e45..e2d4eaa63c7 100644
--- a/test/src/lread-tests.el
+++ b/test/src/lread-tests.el
@@ -173,13 +173,13 @@ literals (Bug#20852)."
(should (string-suffix-p "/somelib.el" (caar load-history)))))
(ert-deftest lread-tests--old-style-backquotes ()
- "Check that loading warns about 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)
- (should (equal (load file-name nil :nomessage :nosuffix) t))
- (should (equal (lread-tests--last-message)
- (concat (format-message "Loading `%s': " file-name)
- "old-style backquotes detected!")))))
+ (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-lread--substitute-object-in-subtree ()
(let ((x (cons 0 1)))
generated by cgit v1.2.3 (git 2.39.1) at 2025-04-08 20:21:38 +0000