diff options
| author | Andrea Corallo | 2021-03-09 10:03:47 +0100 |
|---|---|---|
| committer | Andrea Corallo | 2021-03-09 10:03:47 +0100 |
| commit | 43b0df62cd5922df5495b3f4aee5b7beca14384f (patch) | |
| tree | 3c0bfa9526d08c9c85e646cd355467e3dfb439ac /test | |
| parent | 380ba045c48bfbb160da288b1bd50f82d3f999f0 (diff) | |
| parent | 9cbdf20316e1cec835a7dfe28877142e437976f4 (diff) | |
| download | emacs-43b0df62cd5922df5495b3f4aee5b7beca14384f.tar.gz emacs-43b0df62cd5922df5495b3f4aee5b7beca14384f.zip | |
Merge commit '9cbdf20316' into native-comp
Diffstat (limited to 'test')
| -rw-r--r-- | test/lisp/calc/calc-tests.el | 76 | ||||
| -rw-r--r-- | test/lisp/custom-tests.el | 160 | ||||
| -rw-r--r-- | test/lisp/emacs-lisp/bindat-tests.el | 133 | ||||
| -rw-r--r-- | test/lisp/emacs-lisp/bytecomp-tests.el | 23 | ||||
| -rw-r--r-- | test/lisp/emacs-lisp/cconv-tests.el | 9 | ||||
| -rw-r--r-- | test/lisp/emacs-lisp/checkdoc-tests.el | 42 | ||||
| -rw-r--r-- | test/lisp/emacs-lisp/map-tests.el | 474 | ||||
| -rw-r--r-- | test/lisp/emacs-lisp/pcase-tests.el | 27 | ||||
| -rw-r--r-- | test/lisp/emacs-lisp/rx-tests.el | 8 | ||||
| -rw-r--r-- | test/lisp/erc/erc-tests.el | 64 | ||||
| -rw-r--r-- | test/lisp/json-tests.el | 194 | ||||
| -rw-r--r-- | test/lisp/minibuffer-tests.el | 6 | ||||
| -rw-r--r-- | test/lisp/net/puny-tests.el | 6 | ||||
| -rw-r--r-- | test/lisp/obsolete/inversion-tests.el (renamed from test/lisp/cedet/inversion-tests.el) | 0 | ||||
| -rw-r--r-- | test/src/keymap-tests.el | 58 |
15 files changed, 848 insertions, 432 deletions
diff --git a/test/lisp/calc/calc-tests.el b/test/lisp/calc/calc-tests.el index bdcf78e020a..c5aa5a31eb2 100644 --- a/test/lisp/calc/calc-tests.el +++ b/test/lisp/calc/calc-tests.el | |||
| @@ -707,6 +707,82 @@ An existing calc stack is reused, otherwise a new one is created." | |||
| 707 | (var c var-c)))))) | 707 | (var c var-c)))))) |
| 708 | (calc-set-language nil))) | 708 | (calc-set-language nil))) |
| 709 | 709 | ||
| 710 | (defvar var-g) | ||
| 711 | |||
| 712 | ;; Test `let'. | ||
| 713 | (defmath test1 (x) | ||
| 714 | (let ((x (+ x 1)) | ||
| 715 | (y (+ x 3))) | ||
| 716 | (let ((z (+ y 6))) | ||
| 717 | (* x y z g)))) | ||
| 718 | |||
| 719 | ;; Test `let*'. | ||
| 720 | (defmath test2 (x) | ||
| 721 | (let* ((y (+ x 1)) | ||
| 722 | (z (+ y 3))) | ||
| 723 | (let* ((u (+ z 6))) | ||
| 724 | (* x y z u g)))) | ||
| 725 | |||
| 726 | ;; Test `for'. | ||
| 727 | (defmath test3 (x) | ||
| 728 | (let ((s 0)) | ||
| 729 | (for ((ii 1 x) | ||
| 730 | (jj 1 ii)) | ||
| 731 | (setq s (+ s (* ii jj)))) | ||
| 732 | s)) | ||
| 733 | |||
| 734 | ;; Test `for' with non-unit stride. | ||
| 735 | (defmath test4 (x) | ||
| 736 | (let ((l nil)) | ||
| 737 | (for ((ii 1 x 1) | ||
| 738 | (jj 1 10 ii)) | ||
| 739 | (setq l ('cons jj l))) ; Use Lisp `cons', not `calcFunc-cons'. | ||
| 740 | (reverse l))) | ||
| 741 | |||
| 742 | ;; Test `foreach'. | ||
| 743 | (defmath test5 (x) | ||
| 744 | (let ((s 0)) | ||
| 745 | (foreach ((a x) | ||
| 746 | (b a)) | ||
| 747 | (setq s (+ s b))) | ||
| 748 | s)) | ||
| 749 | |||
| 750 | ;; Test `break'. | ||
| 751 | (defmath test6 (x) | ||
| 752 | (let ((a (for ((ii 1 10)) | ||
| 753 | (when (= ii x) | ||
| 754 | (break (* ii 2))))) | ||
| 755 | (b (foreach ((e '(9 3 6))) | ||
| 756 | (when (= e x) | ||
| 757 | (break (- e 1)))))) | ||
| 758 | (* a b))) | ||
| 759 | |||
| 760 | ;; Test `return' from `for'. | ||
| 761 | (defmath test7 (x) | ||
| 762 | (for ((ii 1 10)) | ||
| 763 | (when (= ii x) | ||
| 764 | (return (* ii 2)))) | ||
| 765 | 5) | ||
| 766 | |||
| 767 | (ert-deftest calc-defmath () | ||
| 768 | (let ((var-g 17)) | ||
| 769 | (should (equal (calcFunc-test1 2) (* 3 5 11 17))) | ||
| 770 | (should (equal (calcFunc-test2 2) (* 2 3 6 12 17)))) | ||
| 771 | (should (equal (calcFunc-test3 3) | ||
| 772 | (+ (* 1 1) | ||
| 773 | (* 2 1) (* 2 2) | ||
| 774 | (* 3 1) (* 3 2) (* 3 3)))) | ||
| 775 | (should (equal (calcFunc-test4 5) | ||
| 776 | '( 1 2 3 4 5 6 7 8 9 10 | ||
| 777 | 1 3 5 7 9 | ||
| 778 | 1 4 7 10 | ||
| 779 | 1 5 9 | ||
| 780 | 1 6))) | ||
| 781 | (should (equal (calcFunc-test5 '((2 3) (5) (7 11 13))) | ||
| 782 | (+ 2 3 5 7 11 13))) | ||
| 783 | (should (equal (calcFunc-test6 3) (* (* 3 2) (- 3 1)))) | ||
| 784 | (should (equal (calcFunc-test7 3) (* 3 2)))) | ||
| 785 | |||
| 710 | (provide 'calc-tests) | 786 | (provide 'calc-tests) |
| 711 | ;;; calc-tests.el ends here | 787 | ;;; calc-tests.el ends here |
| 712 | 788 | ||
diff --git a/test/lisp/custom-tests.el b/test/lisp/custom-tests.el index 09f79c1a089..02a9239824d 100644 --- a/test/lisp/custom-tests.el +++ b/test/lisp/custom-tests.el | |||
| @@ -24,70 +24,108 @@ | |||
| 24 | 24 | ||
| 25 | (require 'wid-edit) | 25 | (require 'wid-edit) |
| 26 | (require 'cus-edit) | 26 | (require 'cus-edit) |
| 27 | (require 'seq) ; For `seq-find'. | 27 | |
| 28 | (defmacro custom-tests--with-temp-dir (&rest body) | ||
| 29 | "Eval BODY with `temporary-file-directory' bound to a fresh directory. | ||
| 30 | Ensure the directory is recursively deleted after the fact." | ||
| 31 | (declare (debug t) (indent 0)) | ||
| 32 | (let ((dir (make-symbol "dir"))) | ||
| 33 | `(let ((,dir (file-name-as-directory (make-temp-file "custom-tests-" t)))) | ||
| 34 | (unwind-protect | ||
| 35 | (let ((temporary-file-directory ,dir)) | ||
| 36 | ,@body) | ||
| 37 | (delete-directory ,dir t))))) | ||
| 28 | 38 | ||
| 29 | (ert-deftest custom-theme--load-path () | 39 | (ert-deftest custom-theme--load-path () |
| 30 | "Test `custom-theme--load-path' behavior." | 40 | "Test `custom-theme--load-path' behavior." |
| 31 | (let ((tmpdir (file-name-as-directory (make-temp-file "custom-tests-" t)))) | 41 | (custom-tests--with-temp-dir |
| 32 | (unwind-protect | 42 | ;; Path is empty. |
| 33 | ;; Create all temporary files under the same deletable parent. | 43 | (let ((custom-theme-load-path ())) |
| 34 | (let ((temporary-file-directory tmpdir)) | 44 | (should (null (custom-theme--load-path)))) |
| 35 | ;; Path is empty. | 45 | |
| 36 | (let ((custom-theme-load-path ())) | 46 | ;; Path comprises non-existent file. |
| 37 | (should (null (custom-theme--load-path)))) | 47 | (let* ((name (make-temp-name temporary-file-directory)) |
| 38 | 48 | (custom-theme-load-path (list name))) | |
| 39 | ;; Path comprises non-existent file. | 49 | (should (not (file-exists-p name))) |
| 40 | (let* ((name (make-temp-name tmpdir)) | 50 | (should (null (custom-theme--load-path)))) |
| 41 | (custom-theme-load-path (list name))) | 51 | |
| 42 | (should (not (file-exists-p name))) | 52 | ;; Path comprises existing file. |
| 43 | (should (null (custom-theme--load-path)))) | 53 | (let* ((file (make-temp-file "file")) |
| 44 | 54 | (custom-theme-load-path (list file))) | |
| 45 | ;; Path comprises existing file. | 55 | (should (file-exists-p file)) |
| 46 | (let* ((file (make-temp-file "file")) | 56 | (should (not (file-directory-p file))) |
| 47 | (custom-theme-load-path (list file))) | 57 | (should (null (custom-theme--load-path)))) |
| 48 | (should (file-exists-p file)) | 58 | |
| 49 | (should (not (file-directory-p file))) | 59 | ;; Path comprises existing directory. |
| 50 | (should (null (custom-theme--load-path)))) | 60 | (let* ((dir (make-temp-file "dir" t)) |
| 51 | 61 | (custom-theme-load-path (list dir))) | |
| 52 | ;; Path comprises existing directory. | 62 | (should (file-directory-p dir)) |
| 53 | (let* ((dir (make-temp-file "dir" t)) | 63 | (should (equal (custom-theme--load-path) custom-theme-load-path))) |
| 54 | (custom-theme-load-path (list dir))) | 64 | |
| 55 | (should (file-directory-p dir)) | 65 | ;; Expand `custom-theme-directory' path element. |
| 56 | (should (equal (custom-theme--load-path) custom-theme-load-path))) | 66 | (let ((custom-theme-load-path '(custom-theme-directory))) |
| 57 | 67 | (let ((custom-theme-directory (make-temp-name temporary-file-directory))) | |
| 58 | ;; Expand `custom-theme-directory' path element. | 68 | (should (not (file-exists-p custom-theme-directory))) |
| 59 | (let ((custom-theme-load-path '(custom-theme-directory))) | 69 | (should (null (custom-theme--load-path)))) |
| 60 | (let ((custom-theme-directory (make-temp-name tmpdir))) | 70 | (let ((custom-theme-directory (make-temp-file "file"))) |
| 61 | (should (not (file-exists-p custom-theme-directory))) | 71 | (should (file-exists-p custom-theme-directory)) |
| 62 | (should (null (custom-theme--load-path)))) | 72 | (should (not (file-directory-p custom-theme-directory))) |
| 63 | (let ((custom-theme-directory (make-temp-file "file"))) | 73 | (should (null (custom-theme--load-path)))) |
| 64 | (should (file-exists-p custom-theme-directory)) | 74 | (let ((custom-theme-directory (make-temp-file "dir" t))) |
| 65 | (should (not (file-directory-p custom-theme-directory))) | 75 | (should (file-directory-p custom-theme-directory)) |
| 66 | (should (null (custom-theme--load-path)))) | 76 | (should (equal (custom-theme--load-path) |
| 67 | (let ((custom-theme-directory (make-temp-file "dir" t))) | 77 | (list custom-theme-directory))))) |
| 68 | (should (file-directory-p custom-theme-directory)) | 78 | |
| 69 | (should (equal (custom-theme--load-path) | 79 | ;; Expand t path element. |
| 70 | (list custom-theme-directory))))) | 80 | (let ((custom-theme-load-path '(t))) |
| 71 | 81 | (let ((data-directory (make-temp-name temporary-file-directory))) | |
| 72 | ;; Expand t path element. | 82 | (should (not (file-exists-p data-directory))) |
| 73 | (let ((custom-theme-load-path '(t))) | 83 | (should (null (custom-theme--load-path)))) |
| 74 | (let ((data-directory (make-temp-name tmpdir))) | 84 | (let ((data-directory temporary-file-directory) |
| 75 | (should (not (file-exists-p data-directory))) | 85 | (themedir (expand-file-name "themes" temporary-file-directory))) |
| 76 | (should (null (custom-theme--load-path)))) | 86 | (should (not (file-exists-p themedir))) |
| 77 | (let ((data-directory tmpdir) | 87 | (should (null (custom-theme--load-path))) |
| 78 | (themedir (expand-file-name "themes" tmpdir))) | 88 | (with-temp-file themedir) |
| 79 | (should (not (file-exists-p themedir))) | 89 | (should (file-exists-p themedir)) |
| 80 | (should (null (custom-theme--load-path))) | 90 | (should (not (file-directory-p themedir))) |
| 81 | (with-temp-file themedir) | 91 | (should (null (custom-theme--load-path))) |
| 82 | (should (file-exists-p themedir)) | 92 | (delete-file themedir) |
| 83 | (should (not (file-directory-p themedir))) | 93 | (make-directory themedir) |
| 84 | (should (null (custom-theme--load-path))) | 94 | (should (file-directory-p themedir)) |
| 85 | (delete-file themedir) | 95 | (should (equal (custom-theme--load-path) (list themedir))))))) |
| 86 | (make-directory themedir) | 96 | |
| 87 | (should (file-directory-p themedir)) | 97 | (ert-deftest custom-tests-require-theme () |
| 88 | (should (equal (custom-theme--load-path) (list themedir)))))) | 98 | "Test `require-theme'." |
| 89 | (when (file-directory-p tmpdir) | 99 | (custom-tests--with-temp-dir |
| 90 | (delete-directory tmpdir t))))) | 100 | (let* ((default-directory temporary-file-directory) |
| 101 | (custom-theme-load-path (list default-directory)) | ||
| 102 | (load-path ())) | ||
| 103 | ;; Generate some `.el' and `.elc' files. | ||
| 104 | (with-temp-file "custom-tests--a.el" | ||
| 105 | (insert "(provide 'custom-tests--a)")) | ||
| 106 | (make-empty-file "custom-tests--b.el") | ||
| 107 | (with-temp-file "custom-tests--b.elc" | ||
| 108 | (byte-compile-insert-header nil (current-buffer)) | ||
| 109 | (insert "(provide 'custom-tests--b)")) | ||
| 110 | (make-empty-file "custom-tests--c.el") | ||
| 111 | (with-temp-file "custom-tests--d.elc" | ||
| 112 | (byte-compile-insert-header nil (current-buffer))) | ||
| 113 | ;; Load them. | ||
| 114 | (dolist (feature '(a b c d e)) | ||
| 115 | (should-not (featurep (intern (format "custom-tests--%s" feature))))) | ||
| 116 | (should (eq (require-theme 'custom-tests--a) 'custom-tests--a)) | ||
| 117 | (delete-file "custom-tests--a.el") | ||
| 118 | (dolist (feature '(custom-tests--a custom-tests--b)) | ||
| 119 | (should (eq (require-theme feature) feature)) | ||
| 120 | (should (featurep feature))) | ||
| 121 | (dolist (feature '(custom-tests--c custom-tests--d)) | ||
| 122 | (dolist (noerror '(nil t)) | ||
| 123 | (let ((err (should-error (require-theme feature noerror)))) | ||
| 124 | (should (string-search "failed to provide feature" (cadr err)))))) | ||
| 125 | (should-error (require-theme 'custom-tests--e) :type 'file-missing) | ||
| 126 | (should-not (require-theme 'custom-tests--e t)) | ||
| 127 | (dolist (feature '(custom-tests--c custom-tests--d custom-tests--e)) | ||
| 128 | (should-not (featurep feature)))))) | ||
| 91 | 129 | ||
| 92 | (defcustom custom--test-user-option 'foo | 130 | (defcustom custom--test-user-option 'foo |
| 93 | "User option for test." | 131 | "User option for test." |
diff --git a/test/lisp/emacs-lisp/bindat-tests.el b/test/lisp/emacs-lisp/bindat-tests.el index 72883fc2ec7..911a5f0c7b1 100644 --- a/test/lisp/emacs-lisp/bindat-tests.el +++ b/test/lisp/emacs-lisp/bindat-tests.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; bindat-tests.el --- tests for bindat.el -*- lexical-binding: t; coding: utf-8; -*- | 1 | ;;; bindat-tests.el --- tests for bindat.el -*- lexical-binding: t -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2019-2021 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2019-2021 Free Software Foundation, Inc. |
| 4 | 4 | ||
| @@ -23,47 +23,50 @@ | |||
| 23 | (require 'bindat) | 23 | (require 'bindat) |
| 24 | (require 'cl-lib) | 24 | (require 'cl-lib) |
| 25 | 25 | ||
| 26 | (defvar header-bindat-spec | 26 | (bindat-defmacro ip () "An IPv4 address" '(vec 4 byte)) |
| 27 | (bindat-spec | 27 | |
| 28 | (defconst header-bindat-spec | ||
| 29 | (bindat-type | ||
| 28 | (dest-ip ip) | 30 | (dest-ip ip) |
| 29 | (src-ip ip) | 31 | (src-ip ip) |
| 30 | (dest-port u16) | 32 | (dest-port uint 16) |
| 31 | (src-port u16))) | 33 | (src-port uint 16))) |
| 32 | 34 | ||
| 33 | (defvar data-bindat-spec | 35 | (defconst data-bindat-spec |
| 34 | (bindat-spec | 36 | (bindat-type |
| 35 | (type u8) | 37 | (type u8) |
| 36 | (opcode u8) | 38 | (opcode u8) |
| 37 | (length u16r) ;; little endian order | 39 | (length uintr 16) ;; little endian order |
| 38 | (id strz 8) | 40 | (id strz 8) |
| 39 | (data vec (length)) | 41 | (data vec length) |
| 40 | (align 4))) | 42 | (_ align 4))) |
| 43 | |||
| 41 | 44 | ||
| 42 | (defvar packet-bindat-spec | 45 | (defconst packet-bindat-spec |
| 43 | (bindat-spec | 46 | (bindat-type |
| 44 | (header struct header-bindat-spec) | 47 | (header type header-bindat-spec) |
| 45 | (items u8) | 48 | (items u8) |
| 46 | (fill 3) | 49 | (_ fill 3) |
| 47 | (item repeat (items) | 50 | (item repeat items |
| 48 | (struct data-bindat-spec)))) | 51 | (_ type data-bindat-spec)))) |
| 49 | 52 | ||
| 50 | (defvar struct-bindat | 53 | (defconst struct-bindat |
| 51 | '((header | 54 | '((header |
| 52 | (dest-ip . [192 168 1 100]) | 55 | (dest-ip . [192 168 1 100]) |
| 53 | (src-ip . [192 168 1 101]) | 56 | (src-ip . [192 168 1 101]) |
| 54 | (dest-port . 284) | 57 | (dest-port . 284) |
| 55 | (src-port . 5408)) | 58 | (src-port . 5408)) |
| 56 | (items . 2) | 59 | (items . 2) |
| 57 | (item ((data . [1 2 3 4 5]) | 60 | (item ((type . 2) |
| 58 | (id . "ABCDEF") | ||
| 59 | (length . 5) | ||
| 60 | (opcode . 3) | 61 | (opcode . 3) |
| 61 | (type . 2)) | 62 | (length . 5) |
| 62 | ((data . [6 7 8 9 10 11 12]) | 63 | (id . "ABCDEF") |
| 63 | (id . "BCDEFG") | 64 | (data . [1 2 3 4 5])) |
| 64 | (length . 7) | 65 | ((type . 1) |
| 65 | (opcode . 4) | 66 | (opcode . 4) |
| 66 | (type . 1))))) | 67 | (length . 7) |
| 68 | (id . "BCDEFG") | ||
| 69 | (data . [6 7 8 9 10 11 12]))))) | ||
| 67 | 70 | ||
| 68 | (ert-deftest bindat-test-pack () | 71 | (ert-deftest bindat-test-pack () |
| 69 | (should (equal | 72 | (should (equal |
| @@ -77,27 +80,7 @@ | |||
| 77 | (should (equal | 80 | (should (equal |
| 78 | (bindat-unpack packet-bindat-spec | 81 | (bindat-unpack packet-bindat-spec |
| 79 | (bindat-pack packet-bindat-spec struct-bindat)) | 82 | (bindat-pack packet-bindat-spec struct-bindat)) |
| 80 | '((item | 83 | struct-bindat))) |
| 81 | ((data . | ||
| 82 | [1 2 3 4 5]) | ||
| 83 | (id . "ABCDEF") | ||
| 84 | (length . 5) | ||
| 85 | (opcode . 3) | ||
| 86 | (type . 2)) | ||
| 87 | ((data . | ||
| 88 | [6 7 8 9 10 11 12]) | ||
| 89 | (id . "BCDEFG") | ||
| 90 | (length . 7) | ||
| 91 | (opcode . 4) | ||
| 92 | (type . 1))) | ||
| 93 | (items . 2) | ||
| 94 | (header | ||
| 95 | (src-port . 5408) | ||
| 96 | (dest-port . 284) | ||
| 97 | (src-ip . | ||
| 98 | [192 168 1 101]) | ||
| 99 | (dest-ip . | ||
| 100 | [192 168 1 100])))))) | ||
| 101 | 84 | ||
| 102 | (ert-deftest bindat-test-pack/multibyte-string-fails () | 85 | (ert-deftest bindat-test-pack/multibyte-string-fails () |
| 103 | (should-error (bindat-pack nil nil "ö"))) | 86 | (should-error (bindat-pack nil nil "ö"))) |
| @@ -121,4 +104,62 @@ | |||
| 121 | (should (equal (bindat-ip-to-string [192 168 0 1]) "192.168.0.1")) | 104 | (should (equal (bindat-ip-to-string [192 168 0 1]) "192.168.0.1")) |
| 122 | (should (equal (bindat-ip-to-string "\300\250\0\1") "192.168.0.1"))) | 105 | (should (equal (bindat-ip-to-string "\300\250\0\1") "192.168.0.1"))) |
| 123 | 106 | ||
| 107 | (defconst bindat-test--int-websocket-type | ||
| 108 | (bindat-type | ||
| 109 | :pack-var value | ||
| 110 | (n1 u8 | ||
| 111 | :pack-val (if (< value 126) value (if (< value 65536) 126 127))) | ||
| 112 | (n2 uint (pcase n1 (127 64) (126 16) (_ 0)) | ||
| 113 | :pack-val value) | ||
| 114 | :unpack-val (if (< n1 126) n1 n2))) | ||
| 115 | |||
| 116 | (ert-deftest bindat-test--pack-val () | ||
| 117 | ;; This is intended to test the :(un)pack-val feature that offers | ||
| 118 | ;; control over the unpacked representation of the data. | ||
| 119 | (dolist (n '(0 42 125 126 127 128 150 255 5000 65535 65536 8769786876)) | ||
| 120 | (should | ||
| 121 | (equal (bindat-unpack bindat-test--int-websocket-type | ||
| 122 | (bindat-pack bindat-test--int-websocket-type n)) | ||
| 123 | n)))) | ||
| 124 | |||
| 125 | (ert-deftest bindat-test--sint () | ||
| 126 | (dotimes (kind 32) | ||
| 127 | (let ((bitlen (* 8 (/ kind 2))) | ||
| 128 | (r (zerop (% kind 2)))) | ||
| 129 | (dotimes (_ 100) | ||
| 130 | (let* ((n (random (ash 1 bitlen))) | ||
| 131 | (i (- n (ash 1 (1- bitlen))))) | ||
| 132 | (should (equal (bindat-unpack | ||
| 133 | (bindat-type sint bitlen r) | ||
| 134 | (bindat-pack (bindat-type sint bitlen r) i)) | ||
| 135 | i)) | ||
| 136 | (when (>= i 0) | ||
| 137 | (should (equal (bindat-pack | ||
| 138 | (bindat-type if r (uintr bitlen) (uint bitlen)) i) | ||
| 139 | (bindat-pack (bindat-type sint bitlen r) i))) | ||
| 140 | (should (equal (bindat-unpack | ||
| 141 | (bindat-type if r (uintr bitlen) (uint bitlen)) | ||
| 142 | (bindat-pack (bindat-type sint bitlen r) i)) | ||
| 143 | i)))))))) | ||
| 144 | |||
| 145 | (defconst bindat-test--LEB128 | ||
| 146 | (bindat-type | ||
| 147 | letrec ((loop | ||
| 148 | (struct :pack-var n | ||
| 149 | (head u8 | ||
| 150 | :pack-val (+ (logand n 127) (if (> n 127) 128 0))) | ||
| 151 | (tail if (< head 128) (unit 0) loop | ||
| 152 | :pack-val (ash n -7)) | ||
| 153 | :unpack-val (+ (logand head 127) (ash tail 7))))) | ||
| 154 | loop)) | ||
| 155 | |||
| 156 | (ert-deftest bindat-test--recursive () | ||
| 157 | (dotimes (n 10) | ||
| 158 | (let ((max (ash 1 (* n 10)))) | ||
| 159 | (dotimes (_ 10) | ||
| 160 | (let ((n (random max))) | ||
| 161 | (should (equal (bindat-unpack bindat-test--LEB128 | ||
| 162 | (bindat-pack bindat-test--LEB128 n)) | ||
| 163 | n))))))) | ||
| 164 | |||
| 124 | ;;; bindat-tests.el ends here | 165 | ;;; bindat-tests.el ends here |
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index fb84596ad3f..03c267ccd0f 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el | |||
| @@ -1199,6 +1199,29 @@ interpreted and compiled." | |||
| 1199 | (should (equal (funcall (eval fun t)) '(c d))) | 1199 | (should (equal (funcall (eval fun t)) '(c d))) |
| 1200 | (should (equal (funcall (byte-compile fun)) '(c d)))))) | 1200 | (should (equal (funcall (byte-compile fun)) '(c d)))))) |
| 1201 | 1201 | ||
| 1202 | (ert-deftest bytecomp-reify-function () | ||
| 1203 | "Check that closures that modify their bound variables are | ||
| 1204 | compiled correctly." | ||
| 1205 | (cl-letf ((lexical-binding t) | ||
| 1206 | ((symbol-function 'counter) nil)) | ||
| 1207 | (let ((x 0)) | ||
| 1208 | (defun counter () (cl-incf x)) | ||
| 1209 | (should (equal (counter) 1)) | ||
| 1210 | (should (equal (counter) 2)) | ||
| 1211 | ;; byte compiling should not cause counter to always return the | ||
| 1212 | ;; same value (bug#46834) | ||
| 1213 | (byte-compile 'counter) | ||
| 1214 | (should (equal (counter) 3)) | ||
| 1215 | (should (equal (counter) 4))) | ||
| 1216 | (let ((x 0)) | ||
| 1217 | (let ((x 1)) | ||
| 1218 | (defun counter () x) | ||
| 1219 | (should (equal (counter) 1)) | ||
| 1220 | ;; byte compiling should not cause the outer binding to shadow | ||
| 1221 | ;; the inner one (bug#46834) | ||
| 1222 | (byte-compile 'counter) | ||
| 1223 | (should (equal (counter) 1)))))) | ||
| 1224 | |||
| 1202 | ;; Local Variables: | 1225 | ;; Local Variables: |
| 1203 | ;; no-byte-compile: t | 1226 | ;; no-byte-compile: t |
| 1204 | ;; End: | 1227 | ;; End: |
diff --git a/test/lisp/emacs-lisp/cconv-tests.el b/test/lisp/emacs-lisp/cconv-tests.el index 517373386e3..5aeed0cc155 100644 --- a/test/lisp/emacs-lisp/cconv-tests.el +++ b/test/lisp/emacs-lisp/cconv-tests.el | |||
| @@ -182,7 +182,14 @@ | |||
| 182 | (should (eq (cconv-tests-cl-defsubst) 'cl-defsubst-result))) | 182 | (should (eq (cconv-tests-cl-defsubst) 'cl-defsubst-result))) |
| 183 | 183 | ||
| 184 | (ert-deftest cconv-convert-lambda-lifted () | 184 | (ert-deftest cconv-convert-lambda-lifted () |
| 185 | "Bug#30872." | 185 | ;; Verify that lambda-lifting is actually performed at all. |
| 186 | (should (equal (cconv-closure-convert | ||
| 187 | '#'(lambda (x) (let ((f #'(lambda () (+ x 1)))) | ||
| 188 | (funcall f)))) | ||
| 189 | '#'(lambda (x) (let ((f #'(lambda (x) (+ x 1)))) | ||
| 190 | (funcall f x))))) | ||
| 191 | |||
| 192 | ;; Bug#30872. | ||
| 186 | (should | 193 | (should |
| 187 | (equal (funcall | 194 | (equal (funcall |
| 188 | (byte-compile | 195 | (byte-compile |
diff --git a/test/lisp/emacs-lisp/checkdoc-tests.el b/test/lisp/emacs-lisp/checkdoc-tests.el index cf7baf4ce44..7a7aa9fb3cd 100644 --- a/test/lisp/emacs-lisp/checkdoc-tests.el +++ b/test/lisp/emacs-lisp/checkdoc-tests.el | |||
| @@ -52,49 +52,31 @@ | |||
| 52 | (insert "(cl-defmethod foo ((a (eql smthg)) (b list)) \"Return A+B.\")") | 52 | (insert "(cl-defmethod foo ((a (eql smthg)) (b list)) \"Return A+B.\")") |
| 53 | (checkdoc-defun))) | 53 | (checkdoc-defun))) |
| 54 | 54 | ||
| 55 | (ert-deftest checkdoc-cl-defun-with-key-ok () | 55 | (ert-deftest checkdoc-cl-defmethod-qualified-ok () |
| 56 | "Checkdoc should be happy with a cl-defun using &key." | 56 | "Checkdoc should be happy with a `cl-defmethod' using qualifiers." |
| 57 | (with-temp-buffer | ||
| 58 | (emacs-lisp-mode) | ||
| 59 | (insert "(cl-defun foo (&key a (b 27)) \"Return :A+:B.\")") | ||
| 60 | (checkdoc-defun))) | ||
| 61 | |||
| 62 | (ert-deftest checkdoc-cl-defun-with-allow-other-keys-ok () | ||
| 63 | "Checkdoc should be happy with a cl-defun using &allow-other-keys." | ||
| 64 | (with-temp-buffer | ||
| 65 | (emacs-lisp-mode) | ||
| 66 | (insert "(cl-defun foo (&key a &allow-other-keys) \"Return :A.\")") | ||
| 67 | (checkdoc-defun))) | ||
| 68 | |||
| 69 | (ert-deftest checkdoc-cl-defun-with-default-optional-value-ok () | ||
| 70 | "Checkdoc should be happy with a cl-defun using default values for optional args." | ||
| 71 | (with-temp-buffer | 57 | (with-temp-buffer |
| 72 | (emacs-lisp-mode) | 58 | (emacs-lisp-mode) |
| 73 | ;; B is optional and equals 1+a if not provided. HAS-BS is non-nil | 59 | (insert "(cl-defmethod test :around ((a (eql smthg))) \"Return A.\")") |
| 74 | ;; if B was provided in the call: | ||
| 75 | (insert "(cl-defun foo (a &optional (b (1+ a) has-bs)) \"Return A + B.\")") | ||
| 76 | (checkdoc-defun))) | 60 | (checkdoc-defun))) |
| 77 | 61 | ||
| 78 | (ert-deftest checkdoc-cl-defun-with-destructuring-ok () | 62 | (ert-deftest checkdoc-cl-defmethod-with-extra-qualifier-ok () |
| 79 | "Checkdoc should be happy with a cl-defun destructuring its arguments." | 63 | "Checkdoc should be happy with a :extra qualified `cl-defmethod'." |
| 80 | (with-temp-buffer | 64 | (with-temp-buffer |
| 81 | (emacs-lisp-mode) | 65 | (emacs-lisp-mode) |
| 82 | (insert "(cl-defun foo ((a b &optional c) d) \"Return A+B+C+D.\")") | 66 | (insert "(cl-defmethod foo :extra \"foo\" ((a (eql smthg))) \"Return A.\")") |
| 83 | (checkdoc-defun))) | 67 | (checkdoc-defun)) |
| 84 | 68 | ||
| 85 | (ert-deftest checkdoc-cl-defmethod-ok () | ||
| 86 | "Checkdoc should be happy with a simple correct cl-defmethod." | ||
| 87 | (with-temp-buffer | 69 | (with-temp-buffer |
| 88 | (emacs-lisp-mode) | 70 | (emacs-lisp-mode) |
| 89 | (insert "(cl-defmethod foo (a) \"Return A.\")") | 71 | (insert |
| 72 | "(cl-defmethod foo :extra \"foo\" :after ((a (eql smthg))) \"Return A.\")") | ||
| 90 | (checkdoc-defun))) | 73 | (checkdoc-defun))) |
| 91 | 74 | ||
| 92 | (ert-deftest checkdoc-cl-defmethod-with-types-ok () | 75 | (ert-deftest checkdoc-cl-defmethod-with-extra-qualifier-and-nil-args-ok () |
| 93 | "Checkdoc should be happy with a cl-defmethod using types." | 76 | "Checkdoc should be happy with a 0-arity :extra qualified `cl-defmethod'." |
| 94 | (with-temp-buffer | 77 | (with-temp-buffer |
| 95 | (emacs-lisp-mode) | 78 | (emacs-lisp-mode) |
| 96 | ;; this method matches if A is the symbol `smthg' and if b is a list: | 79 | (insert "(cl-defmethod foo :extra \"foo\" () \"Return A.\")") |
| 97 | (insert "(cl-defmethod foo ((a (eql smthg)) (b list)) \"Return A+B.\")") | ||
| 98 | (checkdoc-defun))) | 80 | (checkdoc-defun))) |
| 99 | 81 | ||
| 100 | (ert-deftest checkdoc-cl-defun-with-key-ok () | 82 | (ert-deftest checkdoc-cl-defun-with-key-ok () |
diff --git a/test/lisp/emacs-lisp/map-tests.el b/test/lisp/emacs-lisp/map-tests.el index 9a2cd42a211..67666d8e7e7 100644 --- a/test/lisp/emacs-lisp/map-tests.el +++ b/test/lisp/emacs-lisp/map-tests.el | |||
| @@ -22,7 +22,7 @@ | |||
| 22 | 22 | ||
| 23 | ;;; Commentary: | 23 | ;;; Commentary: |
| 24 | 24 | ||
| 25 | ;; Tests for map.el | 25 | ;; Tests for map.el. |
| 26 | 26 | ||
| 27 | ;;; Code: | 27 | ;;; Code: |
| 28 | 28 | ||
| @@ -30,12 +30,10 @@ | |||
| 30 | (require 'map) | 30 | (require 'map) |
| 31 | 31 | ||
| 32 | (defmacro with-maps-do (var &rest body) | 32 | (defmacro with-maps-do (var &rest body) |
| 33 | "Successively bind VAR to an alist, vector and hash-table. | 33 | "Successively bind VAR to an alist, plist, vector, and hash-table. |
| 34 | Each map is built from the following alist data: | 34 | Each map is built from the following alist data: |
| 35 | '((0 . 3) (1 . 4) (2 . 5)). | 35 | \\='((0 . 3) (1 . 4) (2 . 5)). |
| 36 | Evaluate BODY for each created map. | 36 | Evaluate BODY for each created map." |
| 37 | |||
| 38 | \(fn (var map) body)" | ||
| 39 | (declare (indent 1) (debug (symbolp body))) | 37 | (declare (indent 1) (debug (symbolp body))) |
| 40 | (let ((alist (make-symbol "alist")) | 38 | (let ((alist (make-symbol "alist")) |
| 41 | (plist (make-symbol "plist")) | 39 | (plist (make-symbol "plist")) |
| @@ -53,43 +51,62 @@ Evaluate BODY for each created map. | |||
| 53 | (dolist (,var (list ,alist ,plist ,vec ,ht)) | 51 | (dolist (,var (list ,alist ,plist ,vec ,ht)) |
| 54 | ,@body)))) | 52 | ,@body)))) |
| 55 | 53 | ||
| 54 | (defmacro with-empty-maps-do (var &rest body) | ||
| 55 | "Like `with-maps-do', but with empty maps." | ||
| 56 | (declare (indent 1) (debug (symbolp body))) | ||
| 57 | `(dolist (,var (list (list) (vector) (make-hash-table))) | ||
| 58 | ,@body)) | ||
| 59 | |||
| 60 | (ert-deftest test-map-plist-p () | ||
| 61 | "Test `map--plist-p'." | ||
| 62 | (with-empty-maps-do map | ||
| 63 | (should-not (map--plist-p map))) | ||
| 64 | (should-not (map--plist-p "")) | ||
| 65 | (should-not (map--plist-p '((())))) | ||
| 66 | (should (map--plist-p '(:a))) | ||
| 67 | (should (map--plist-p '(a))) | ||
| 68 | (should (map--plist-p '(nil))) | ||
| 69 | (should (map--plist-p '("")))) | ||
| 70 | |||
| 56 | (ert-deftest test-map-elt () | 71 | (ert-deftest test-map-elt () |
| 57 | (with-maps-do map | 72 | (with-maps-do map |
| 58 | (should (= 3 (map-elt map 0))) | 73 | (should (= 3 (map-elt map 0))) |
| 59 | (should (= 4 (map-elt map 1))) | 74 | (should (= 4 (map-elt map 1))) |
| 60 | (should (= 5 (map-elt map 2))) | 75 | (should (= 5 (map-elt map 2))) |
| 61 | (should (null (map-elt map -1))) | 76 | (should-not (map-elt map -1)) |
| 62 | (should (null (map-elt map 4))))) | 77 | (should-not (map-elt map 4)) |
| 78 | (should-not (map-elt map 0.1)))) | ||
| 63 | 79 | ||
| 64 | (ert-deftest test-map-elt-default () | 80 | (ert-deftest test-map-elt-default () |
| 65 | (with-maps-do map | 81 | (with-maps-do map |
| 66 | (should (= 5 (map-elt map 7 5))))) | 82 | (should (= 5 (map-elt map 7 5))) |
| 83 | (should (= 5 (map-elt map 0.1 5)))) | ||
| 84 | (with-empty-maps-do map | ||
| 85 | (should (= 5 (map-elt map 0 5))))) | ||
| 67 | 86 | ||
| 68 | (ert-deftest test-map-elt-testfn () | 87 | (ert-deftest test-map-elt-testfn () |
| 69 | (let ((map (list (cons "a" 1) (cons "b" 2))) | 88 | (let ((map (list (cons "a" 1) (cons "b" 2))) |
| 70 | ;; Make sure to use a non-eq "a", even when compiled. | 89 | ;; Make sure to use a non-eq "a", even when compiled. |
| 71 | (noneq-key (string ?a))) | 90 | (noneq-key (string ?a))) |
| 72 | (should-not (map-elt map noneq-key)) | 91 | (should-not (map-elt map noneq-key)) |
| 73 | (should (map-elt map noneq-key nil 'equal)))) | 92 | (should (map-elt map noneq-key nil #'equal)))) |
| 74 | 93 | ||
| 75 | (ert-deftest test-map-elt-with-nil-value () | 94 | (ert-deftest test-map-elt-with-nil-value () |
| 76 | (should (null (map-elt '((a . 1) | 95 | (should-not (map-elt '((a . 1) (b)) 'b 2))) |
| 77 | (b)) | ||
| 78 | 'b | ||
| 79 | '2)))) | ||
| 80 | 96 | ||
| 81 | (ert-deftest test-map-put! () | 97 | (ert-deftest test-map-put! () |
| 82 | (with-maps-do map | 98 | (with-maps-do map |
| 83 | (setf (map-elt map 2) 'hello) | 99 | (setf (map-elt map 2) 'hello) |
| 84 | (should (eq (map-elt map 2) 'hello))) | 100 | (should (eq (map-elt map 2) 'hello))) |
| 85 | (with-maps-do map | 101 | (with-maps-do map |
| 86 | (map-put map 2 'hello) | 102 | (with-suppressed-warnings ((obsolete map-put)) |
| 103 | (map-put map 2 'hello)) | ||
| 87 | (should (eq (map-elt map 2) 'hello))) | 104 | (should (eq (map-elt map 2) 'hello))) |
| 88 | (with-maps-do map | 105 | (with-maps-do map |
| 89 | (map-put! map 2 'hello) | 106 | (map-put! map 2 'hello) |
| 90 | (should (eq (map-elt map 2) 'hello)) | 107 | (should (eq (map-elt map 2) 'hello)) |
| 91 | (if (not (or (hash-table-p map) | 108 | (if (not (or (hash-table-p map) |
| 92 | (and (listp map) (not (listp (car map)))))) ;plist! | 109 | (map--plist-p map))) |
| 93 | (should-error (map-put! map 5 'value) | 110 | (should-error (map-put! map 5 'value) |
| 94 | ;; For vectors, it could arguably signal | 111 | ;; For vectors, it could arguably signal |
| 95 | ;; map-not-inplace as well, but it currently doesn't. | 112 | ;; map-not-inplace as well, but it currently doesn't. |
| @@ -97,49 +114,88 @@ Evaluate BODY for each created map. | |||
| 97 | 'map-not-inplace | 114 | 'map-not-inplace |
| 98 | 'error)) | 115 | 'error)) |
| 99 | (map-put! map 5 'value) | 116 | (map-put! map 5 'value) |
| 100 | (should (eq (map-elt map 5) 'value)))) | 117 | (should (eq (map-elt map 5) 'value))))) |
| 101 | (let ((ht (make-hash-table))) | 118 | |
| 102 | (setf (map-elt ht 2) 'a) | 119 | (ert-deftest test-map-put!-new-keys () |
| 103 | (should (eq (map-elt ht 2) | 120 | "Test `map-put!' with new keys." |
| 104 | 'a))) | 121 | (with-maps-do map |
| 105 | (let ((alist '((0 . a) (1 . b) (2 . c)))) | 122 | (let ((size (map-length map))) |
| 106 | (setf (map-elt alist 2) 'a) | 123 | (if (arrayp map) |
| 107 | (should (eq (map-elt alist 2) | 124 | (progn |
| 108 | 'a))) | 125 | (should-error (setf (map-elt map 'k) 'v)) |
| 109 | (let ((vec [3 4 5])) | 126 | (should-error (setf (map-elt map size) 'v))) |
| 110 | (should-error (setf (map-elt vec 3) 6)))) | 127 | (setf (map-elt map 'k) 'v) |
| 128 | (should (eq (map-elt map 'k) 'v)) | ||
| 129 | (setf (map-elt map size) 'v) | ||
| 130 | (should (eq (map-elt map size) 'v)))))) | ||
| 111 | 131 | ||
| 112 | (ert-deftest test-map-put-alist-new-key () | 132 | (ert-deftest test-map-put-alist-new-key () |
| 113 | "Regression test for Bug#23105." | 133 | "Regression test for Bug#23105." |
| 114 | (let ((alist '((0 . a)))) | 134 | (let ((alist (list (cons 0 'a)))) |
| 115 | (map-put alist 2 'b) | 135 | (with-suppressed-warnings ((obsolete map-put)) |
| 116 | (should (eq (map-elt alist 2) | 136 | (map-put alist 2 'b)) |
| 117 | 'b)))) | 137 | (should (eq (map-elt alist 2) 'b)))) |
| 118 | 138 | ||
| 119 | (ert-deftest test-map-put-testfn-alist () | 139 | (ert-deftest test-map-put-testfn-alist () |
| 120 | (let ((alist (list (cons "a" 1) (cons "b" 2))) | 140 | (let ((alist (list (cons "a" 1) (cons "b" 2))) |
| 121 | ;; Make sure to use a non-eq "a", even when compiled. | 141 | ;; Make sure to use a non-eq "a", even when compiled. |
| 122 | (noneq-key (string ?a))) | 142 | (noneq-key (string ?a))) |
| 123 | (map-put alist noneq-key 3 #'equal) | 143 | (with-suppressed-warnings ((obsolete map-put)) |
| 124 | (should-not (cddr alist)) | 144 | (map-put alist noneq-key 3 #'equal) |
| 125 | (map-put alist noneq-key 9 #'eql) | 145 | (should-not (cddr alist)) |
| 126 | (should (cddr alist)))) | 146 | (map-put alist noneq-key 9 #'eql) |
| 147 | (should (cddr alist))))) | ||
| 127 | 148 | ||
| 128 | (ert-deftest test-map-put-return-value () | 149 | (ert-deftest test-map-put-return-value () |
| 129 | (let ((ht (make-hash-table))) | 150 | (let ((ht (make-hash-table))) |
| 130 | (should (eq (map-put ht 'a 'hello) 'hello)))) | 151 | (with-suppressed-warnings ((obsolete map-put)) |
| 152 | (should (eq (map-put ht 'a 'hello) 'hello))))) | ||
| 153 | |||
| 154 | (ert-deftest test-map-insert-empty () | ||
| 155 | "Test `map-insert' on empty maps." | ||
| 156 | (with-empty-maps-do map | ||
| 157 | (if (arrayp map) | ||
| 158 | (should-error (map-insert map 0 6)) | ||
| 159 | (let ((new (map-insert map 0 6))) | ||
| 160 | (should-not (eq map new)) | ||
| 161 | (should-not (map-pairs map)) | ||
| 162 | (should (= (map-elt new 0) 6)))))) | ||
| 163 | |||
| 164 | (ert-deftest test-map-insert () | ||
| 165 | "Test `map-insert'." | ||
| 166 | (with-maps-do map | ||
| 167 | (let ((pairs (map-pairs map)) | ||
| 168 | (size (map-length map)) | ||
| 169 | (new (map-insert map 0 6))) | ||
| 170 | (should-not (eq map new)) | ||
| 171 | (should (equal (map-pairs map) pairs)) | ||
| 172 | (should (= (map-elt new 0) 6)) | ||
| 173 | (if (arrayp map) | ||
| 174 | (should-error (map-insert map size 7)) | ||
| 175 | (setq new (map-insert map size 7)) | ||
| 176 | (should-not (eq map new)) | ||
| 177 | (should (equal (map-pairs map) pairs)) | ||
| 178 | (should (= (map-elt new size) 7)))))) | ||
| 131 | 179 | ||
| 132 | (ert-deftest test-map-delete () | 180 | (ert-deftest test-map-delete () |
| 133 | (with-maps-do map | 181 | (with-maps-do map |
| 134 | (map-delete map 1) | 182 | (should (map-elt map 1)) |
| 135 | (should (null (map-elt map 1)))) | 183 | (should (eq map (map-delete map 1))) |
| 184 | (should-not (map-elt map 1))) | ||
| 136 | (with-maps-do map | 185 | (with-maps-do map |
| 137 | (map-delete map -2) | 186 | (should-not (map-elt map -2)) |
| 138 | (should (null (map-elt map -2))))) | 187 | (should (eq map (map-delete map -2))) |
| 188 | (should-not (map-elt map -2))) | ||
| 189 | (with-maps-do map | ||
| 190 | ;; Check for OBOE. | ||
| 191 | (let ((key (map-length map))) | ||
| 192 | (should-not (map-elt map key)) | ||
| 193 | (should (eq map (map-delete map key))) | ||
| 194 | (should-not (map-elt map key))))) | ||
| 139 | 195 | ||
| 140 | (ert-deftest test-map-delete-return-value () | 196 | (ert-deftest test-map-delete-empty () |
| 141 | (let ((ht (make-hash-table))) | 197 | (with-empty-maps-do map |
| 142 | (should (eq (map-delete ht 'a) ht)))) | 198 | (should (eq map (map-delete map t))))) |
| 143 | 199 | ||
| 144 | (ert-deftest test-map-nested-elt () | 200 | (ert-deftest test-map-nested-elt () |
| 145 | (let ((vec [a b [c d [e f]]])) | 201 | (let ((vec [a b [c d [e f]]])) |
| @@ -149,8 +205,9 @@ Evaluate BODY for each created map. | |||
| 149 | (d . 3) | 205 | (d . 3) |
| 150 | (e . ((f . 4) | 206 | (e . ((f . 4) |
| 151 | (g . 5)))))))) | 207 | (g . 5)))))))) |
| 152 | (should (eq (map-nested-elt alist '(b e f)) | 208 | (should (eq (map-nested-elt alist '(b e f)) 4))) |
| 153 | 4))) | 209 | (let ((plist '(a 1 b (c 2 d 3 e (f 4 g 5))))) |
| 210 | (should (eq (map-nested-elt plist '(b e f)) 4))) | ||
| 154 | (let ((ht (make-hash-table))) | 211 | (let ((ht (make-hash-table))) |
| 155 | (setf (map-elt ht 'a) 1) | 212 | (setf (map-elt ht 'a) 1) |
| 156 | (setf (map-elt ht 'b) (make-hash-table)) | 213 | (setf (map-elt ht 'b) (make-hash-table)) |
| @@ -160,214 +217,238 @@ Evaluate BODY for each created map. | |||
| 160 | 217 | ||
| 161 | (ert-deftest test-map-nested-elt-default () | 218 | (ert-deftest test-map-nested-elt-default () |
| 162 | (let ((vec [a b [c d]])) | 219 | (let ((vec [a b [c d]])) |
| 163 | (should (null (map-nested-elt vec '(2 3)))) | 220 | (should-not (map-nested-elt vec '(2 3))) |
| 164 | (should (null (map-nested-elt vec '(2 1 1)))) | 221 | (should-not (map-nested-elt vec '(2 1 1))) |
| 165 | (should (= 4 (map-nested-elt vec '(2 1 1) 4))))) | 222 | (should (= 4 (map-nested-elt vec '(2 1 1) 4))))) |
| 166 | 223 | ||
| 167 | (ert-deftest test-mapp () | 224 | (ert-deftest test-mapp () |
| 168 | (should (mapp nil)) | 225 | (with-empty-maps-do map |
| 169 | (should (mapp '((a . b) (c . d)))) | 226 | (should (mapp map))) |
| 170 | (should (mapp '(a b c d))) | 227 | (with-maps-do map |
| 171 | (should (mapp [])) | 228 | (should (mapp map))) |
| 172 | (should (mapp [1 2 3])) | 229 | (should (mapp "")) |
| 173 | (should (mapp (make-hash-table))) | ||
| 174 | (should (mapp "hello")) | 230 | (should (mapp "hello")) |
| 175 | (should (not (mapp 1))) | 231 | (should-not (mapp 1)) |
| 176 | (should (not (mapp 'hello)))) | 232 | (should-not (mapp 'hello))) |
| 177 | 233 | ||
| 178 | (ert-deftest test-map-keys () | 234 | (ert-deftest test-map-keys () |
| 179 | (with-maps-do map | 235 | (with-maps-do map |
| 180 | (should (equal (map-keys map) '(0 1 2)))) | 236 | (should (equal (map-keys map) '(0 1 2)))) |
| 181 | (should (null (map-keys nil))) | 237 | (with-empty-maps-do map |
| 182 | (should (null (map-keys [])))) | 238 | (should-not (map-keys map)))) |
| 183 | 239 | ||
| 184 | (ert-deftest test-map-values () | 240 | (ert-deftest test-map-values () |
| 185 | (with-maps-do map | 241 | (with-maps-do map |
| 186 | (should (equal (map-values map) '(3 4 5))))) | 242 | (should (equal (map-values map) '(3 4 5)))) |
| 243 | (with-empty-maps-do map | ||
| 244 | (should-not (map-values map)))) | ||
| 187 | 245 | ||
| 188 | (ert-deftest test-map-pairs () | 246 | (ert-deftest test-map-pairs () |
| 189 | (with-maps-do map | 247 | (with-maps-do map |
| 190 | (should (equal (map-pairs map) '((0 . 3) | 248 | (should (equal (map-pairs map) |
| 191 | (1 . 4) | 249 | '((0 . 3) |
| 192 | (2 . 5)))))) | 250 | (1 . 4) |
| 251 | (2 . 5))))) | ||
| 252 | (with-empty-maps-do map | ||
| 253 | (should-not (map-pairs map)))) | ||
| 193 | 254 | ||
| 194 | (ert-deftest test-map-length () | 255 | (ert-deftest test-map-length () |
| 195 | (let ((ht (make-hash-table))) | 256 | (with-empty-maps-do map |
| 196 | (puthash 'a 1 ht) | 257 | (should (zerop (map-length map)))) |
| 197 | (puthash 'b 2 ht) | 258 | (with-maps-do map |
| 198 | (puthash 'c 3 ht) | 259 | (should (= 3 (map-length map)))) |
| 199 | (puthash 'd 4 ht) | 260 | (should (= 1 (map-length '(nil 1)))) |
| 200 | (should (= 0 (map-length nil))) | 261 | (should (= 2 (map-length '(nil 1 t 2)))) |
| 201 | (should (= 0 (map-length []))) | 262 | (should (= 2 (map-length '((a . 1) (b . 2))))) |
| 202 | (should (= 0 (map-length (make-hash-table)))) | 263 | (should (= 5 (map-length [0 1 2 3 4]))) |
| 203 | (should (= 5 (map-length [0 1 2 3 4]))) | 264 | (should (= 4 (map-length #s(hash-table data (a 1 b 2 c 3 d 4)))))) |
| 204 | (should (= 2 (map-length '((a . 1) (b . 2))))) | ||
| 205 | (should (= 4 (map-length ht))))) | ||
| 206 | 265 | ||
| 207 | (ert-deftest test-map-copy () | 266 | (ert-deftest test-map-copy () |
| 208 | (with-maps-do map | 267 | (with-maps-do map |
| 209 | (let ((copy (map-copy map))) | 268 | (let ((copy (map-copy map))) |
| 210 | (should (equal (map-keys map) (map-keys copy))) | 269 | (should (equal (map-pairs map) (map-pairs copy))) |
| 211 | (should (equal (map-values map) (map-values copy))) | 270 | (should-not (eq map copy)) |
| 212 | (should (not (eq map copy)))))) | 271 | (map-put! map 0 0) |
| 272 | (should-not (equal (map-pairs map) (map-pairs copy))))) | ||
| 273 | (with-empty-maps-do map | ||
| 274 | (should-not (map-pairs (map-copy map))))) | ||
| 275 | |||
| 276 | (ert-deftest test-map-copy-alist () | ||
| 277 | "Test use of `copy-alist' for alists." | ||
| 278 | (let* ((cons (list 'a 1 2)) | ||
| 279 | (alist (list cons)) | ||
| 280 | (copy (map-copy alist))) | ||
| 281 | (setcar cons 'b) | ||
| 282 | (should (equal alist '((b 1 2)))) | ||
| 283 | (should (equal copy '((a 1 2)))) | ||
| 284 | (setcar (cdr cons) 0) | ||
| 285 | (should (equal alist '((b 0 2)))) | ||
| 286 | (should (equal copy '((a 0 2)))) | ||
| 287 | (setcdr cons 3) | ||
| 288 | (should (equal alist '((b . 3)))) | ||
| 289 | (should (equal copy '((a 0 2)))))) | ||
| 213 | 290 | ||
| 214 | (ert-deftest test-map-apply () | 291 | (ert-deftest test-map-apply () |
| 215 | (with-maps-do map | 292 | (let ((fn (lambda (k v) (cons (number-to-string k) v)))) |
| 216 | (should (equal (map-apply (lambda (k v) (cons (int-to-string k) v)) | 293 | (with-maps-do map |
| 217 | map) | 294 | (should (equal (map-apply fn map) |
| 218 | '(("0" . 3) ("1" . 4) ("2" . 5))))) | 295 | '(("0" . 3) ("1" . 4) ("2" . 5))))) |
| 219 | (let ((vec [a b c])) | 296 | (with-empty-maps-do map |
| 220 | (should (equal (map-apply (lambda (k v) (cons (1+ k) v)) | 297 | (should-not (map-apply fn map))))) |
| 221 | vec) | ||
| 222 | '((1 . a) | ||
| 223 | (2 . b) | ||
| 224 | (3 . c)))))) | ||
| 225 | 298 | ||
| 226 | (ert-deftest test-map-do () | 299 | (ert-deftest test-map-do () |
| 227 | (with-maps-do map | 300 | (let* (res |
| 228 | (let ((result nil)) | 301 | (fn (lambda (k v) |
| 229 | (map-do (lambda (k v) | 302 | (push (list (number-to-string k) v) res)))) |
| 230 | (push (list (int-to-string k) v) result)) | 303 | (with-empty-maps-do map |
| 231 | map) | 304 | (should-not (map-do fn map)) |
| 232 | (should (equal result '(("2" 5) ("1" 4) ("0" 3))))))) | 305 | (should-not res)) |
| 306 | (with-maps-do map | ||
| 307 | (setq res nil) | ||
| 308 | (should-not (map-do fn map)) | ||
| 309 | (should (equal res '(("2" 5) ("1" 4) ("0" 3))))))) | ||
| 233 | 310 | ||
| 234 | (ert-deftest test-map-keys-apply () | 311 | (ert-deftest test-map-keys-apply () |
| 235 | (with-maps-do map | 312 | (with-maps-do map |
| 236 | (should (equal (map-keys-apply (lambda (k) (int-to-string k)) | 313 | (should (equal (map-keys-apply #'1+ map) '(1 2 3)))) |
| 237 | map) | 314 | (with-empty-maps-do map |
| 238 | '("0" "1" "2")))) | 315 | (let (ks) |
| 239 | (let ((vec [a b c])) | 316 | (should-not (map-keys-apply (lambda (k) (push k ks)) map)) |
| 240 | (should (equal (map-keys-apply (lambda (k) (1+ k)) | 317 | (should-not ks)))) |
| 241 | vec) | ||
| 242 | '(1 2 3))))) | ||
| 243 | 318 | ||
| 244 | (ert-deftest test-map-values-apply () | 319 | (ert-deftest test-map-values-apply () |
| 245 | (with-maps-do map | 320 | (with-maps-do map |
| 246 | (should (equal (map-values-apply (lambda (v) (1+ v)) | 321 | (should (equal (map-values-apply #'1+ map) '(4 5 6)))) |
| 247 | map) | 322 | (with-empty-maps-do map |
| 248 | '(4 5 6)))) | 323 | (let (vs) |
| 249 | (let ((vec [a b c])) | 324 | (should-not (map-values-apply (lambda (v) (push v vs)) map)) |
| 250 | (should (equal (map-values-apply (lambda (v) (symbol-name v)) | 325 | (should-not vs)))) |
| 251 | vec) | ||
| 252 | '("a" "b" "c"))))) | ||
| 253 | 326 | ||
| 254 | (ert-deftest test-map-filter () | 327 | (ert-deftest test-map-filter () |
| 255 | (with-maps-do map | 328 | (with-maps-do map |
| 256 | (should (equal (map-keys (map-filter (lambda (_k v) | 329 | (should (equal (map-filter (lambda (_k v) (> v 3)) map) |
| 257 | (<= 4 v)) | 330 | '((1 . 4) (2 . 5)))) |
| 258 | map)) | 331 | (should (equal (map-filter #'always map) (map-pairs map))) |
| 259 | '(1 2))) | 332 | (should-not (map-filter #'ignore map))) |
| 260 | (should (null (map-filter (lambda (k _v) | 333 | (with-empty-maps-do map |
| 261 | (eq 'd k)) | 334 | (should-not (map-filter #'always map)) |
| 262 | map)))) | 335 | (should-not (map-filter #'ignore map)))) |
| 263 | (should (null (map-filter (lambda (_k v) | ||
| 264 | (eq 3 v)) | ||
| 265 | [1 2 4 5]))) | ||
| 266 | (should (equal (map-filter (lambda (k _v) | ||
| 267 | (eq 3 k)) | ||
| 268 | [1 2 4 5]) | ||
| 269 | '((3 . 5))))) | ||
| 270 | 336 | ||
| 271 | (ert-deftest test-map-remove () | 337 | (ert-deftest test-map-remove () |
| 272 | (with-maps-do map | 338 | (with-maps-do map |
| 273 | (should (equal (map-keys (map-remove (lambda (_k v) | 339 | (should (equal (map-remove (lambda (_k v) (> v 3)) map) |
| 274 | (>= v 4)) | 340 | '((0 . 3)))) |
| 275 | map)) | 341 | (should (equal (map-remove #'ignore map) (map-pairs map))) |
| 276 | '(0))) | 342 | (should-not (map-remove #'always map))) |
| 277 | (should (equal (map-keys (map-remove (lambda (k _v) | 343 | (with-empty-maps-do map |
| 278 | (eq 'd k)) | 344 | (should-not (map-remove #'always map)) |
| 279 | map)) | 345 | (should-not (map-remove #'ignore map)))) |
| 280 | (map-keys map)))) | ||
| 281 | (should (equal (map-remove (lambda (_k v) | ||
| 282 | (eq 3 v)) | ||
| 283 | [1 2 4 5]) | ||
| 284 | '((0 . 1) | ||
| 285 | (1 . 2) | ||
| 286 | (2 . 4) | ||
| 287 | (3 . 5)))) | ||
| 288 | (should (null (map-remove (lambda (k _v) | ||
| 289 | (>= k 0)) | ||
| 290 | [1 2 4 5])))) | ||
| 291 | 346 | ||
| 292 | (ert-deftest test-map-empty-p () | 347 | (ert-deftest test-map-empty-p () |
| 293 | (should (map-empty-p nil)) | 348 | (with-empty-maps-do map |
| 294 | (should (not (map-empty-p '((a . b) (c . d))))) | 349 | (should (map-empty-p map))) |
| 295 | (should (map-empty-p [])) | 350 | (should (map-empty-p "")) |
| 296 | (should (not (map-empty-p [1 2 3]))) | 351 | (should-not (map-empty-p '((a . b) (c . d)))) |
| 297 | (should (map-empty-p (make-hash-table))) | 352 | (should-not (map-empty-p [1 2 3])) |
| 298 | (should (not (map-empty-p "hello"))) | 353 | (should-not (map-empty-p "hello"))) |
| 299 | (should (map-empty-p ""))) | ||
| 300 | 354 | ||
| 301 | (ert-deftest test-map-contains-key () | 355 | (ert-deftest test-map-contains-key () |
| 302 | (should (map-contains-key '((a . 1) (b . 2)) 'a)) | 356 | (with-empty-maps-do map |
| 303 | (should (not (map-contains-key '((a . 1) (b . 2)) 'c))) | 357 | (should-not (map-contains-key map -1)) |
| 304 | (should (map-contains-key '(("a" . 1)) "a")) | 358 | (should-not (map-contains-key map 0)) |
| 305 | (should (not (map-contains-key '(("a" . 1)) "a" #'eq))) | 359 | (should-not (map-contains-key map 1)) |
| 306 | (should (map-contains-key [a b c] 2)) | 360 | (should-not (map-contains-key map (map-length map)))) |
| 307 | (should (not (map-contains-key [a b c] 3)))) | 361 | (with-maps-do map |
| 362 | (should-not (map-contains-key map -1)) | ||
| 363 | (should (map-contains-key map 0)) | ||
| 364 | (should (map-contains-key map 1)) | ||
| 365 | (should-not (map-contains-key map (map-length map))))) | ||
| 366 | |||
| 367 | (ert-deftest test-map-contains-key-testfn () | ||
| 368 | "Test `map-contains-key' under different equalities." | ||
| 369 | (let ((key (string ?a)) | ||
| 370 | (plist '("a" 1 a 2)) | ||
| 371 | (alist '(("a" . 1) (a . 2)))) | ||
| 372 | (should (map-contains-key alist 'a)) | ||
| 373 | (should (map-contains-key plist 'a)) | ||
| 374 | (should (map-contains-key alist 'a #'eq)) | ||
| 375 | (should (map-contains-key plist 'a #'eq)) | ||
| 376 | (should (map-contains-key alist key)) | ||
| 377 | (should-not (map-contains-key plist key)) | ||
| 378 | (should-not (map-contains-key alist key #'eq)) | ||
| 379 | (should-not (map-contains-key plist key #'eq)))) | ||
| 308 | 380 | ||
| 309 | (ert-deftest test-map-some () | 381 | (ert-deftest test-map-some () |
| 310 | (with-maps-do map | 382 | (with-maps-do map |
| 311 | (should (map-some (lambda (k _v) | 383 | (should (eq (map-some (lambda (k _v) (and (= k 1) 'found)) map) |
| 312 | (eq 1 k)) | 384 | 'found)) |
| 313 | map)) | 385 | (should-not (map-some #'ignore map))) |
| 314 | (should-not (map-some (lambda (k _v) | 386 | (with-empty-maps-do map |
| 315 | (eq 'd k)) | 387 | (should-not (map-some #'always map)) |
| 316 | map))) | 388 | (should-not (map-some #'ignore map)))) |
| 317 | (let ((vec [a b c])) | ||
| 318 | (should (map-some (lambda (k _v) | ||
| 319 | (> k 1)) | ||
| 320 | vec)) | ||
| 321 | (should-not (map-some (lambda (k _v) | ||
| 322 | (> k 3)) | ||
| 323 | vec)))) | ||
| 324 | 389 | ||
| 325 | (ert-deftest test-map-every-p () | 390 | (ert-deftest test-map-every-p () |
| 326 | (with-maps-do map | 391 | (with-maps-do map |
| 327 | (should (map-every-p (lambda (k _v) | 392 | (should (map-every-p #'always map)) |
| 328 | k) | 393 | (should-not (map-every-p #'ignore map)) |
| 329 | map)) | 394 | (should-not (map-every-p (lambda (k _v) (zerop k)) map))) |
| 330 | (should (not (map-every-p (lambda (_k _v) | 395 | (with-empty-maps-do map |
| 331 | nil) | 396 | (should (map-every-p #'always map)) |
| 332 | map)))) | 397 | (should (map-every-p #'ignore map)) |
| 333 | (let ((vec [a b c])) | 398 | (should (map-every-p (lambda (k _v) (zerop k)) map)))) |
| 334 | (should (map-every-p (lambda (k _v) | ||
| 335 | (>= k 0)) | ||
| 336 | vec)) | ||
| 337 | (should (not (map-every-p (lambda (k _v) | ||
| 338 | (> k 3)) | ||
| 339 | vec))))) | ||
| 340 | 399 | ||
| 341 | (ert-deftest test-map-into () | 400 | (ert-deftest test-map-into () |
| 342 | (let* ((alist '((a . 1) (b . 2))) | 401 | (let* ((plist '(a 1 b 2)) |
| 402 | (alist '((a . 1) (b . 2))) | ||
| 343 | (ht (map-into alist 'hash-table)) | 403 | (ht (map-into alist 'hash-table)) |
| 344 | (ht2 (map-into alist '(hash-table :test equal)))) | 404 | (ht2 (map-into alist '(hash-table :test equal)))) |
| 345 | (should (hash-table-p ht)) | 405 | (should (hash-table-p ht)) |
| 346 | (should (equal (map-into (map-into alist 'hash-table) 'list) | 406 | (should (equal (map-into ht 'list) alist)) |
| 347 | alist)) | 407 | (should (equal (map-pairs (map-into (map-into ht 'list) 'hash-table)) |
| 348 | (should (listp (map-into ht 'list))) | 408 | (map-pairs ht))) |
| 349 | (should (equal (map-keys (map-into (map-into ht 'list) 'hash-table)) | ||
| 350 | (map-keys ht))) | ||
| 351 | (should (equal (map-values (map-into (map-into ht 'list) 'hash-table)) | ||
| 352 | (map-values ht))) | ||
| 353 | (should (equal (map-into ht 'alist) (map-into ht2 'alist))) | 409 | (should (equal (map-into ht 'alist) (map-into ht2 'alist))) |
| 354 | (should (eq (hash-table-test ht2) 'equal)) | 410 | (should (equal (map-into alist 'list) alist)) |
| 355 | (should (null (map-into nil 'list))) | 411 | (should (equal (map-into alist 'alist) alist)) |
| 356 | (should (map-empty-p (map-into nil 'hash-table))) | 412 | (should (equal (map-into alist 'plist) plist)) |
| 357 | (should-error (map-into [1 2 3] 'string)))) | 413 | (should (equal (map-into plist 'alist) alist)) |
| 414 | (should (equal (map-into plist 'plist) plist))) | ||
| 415 | (should-error (map-into [1 2 3] 'string) :type 'cl-no-applicable-method)) | ||
| 416 | |||
| 417 | (ert-deftest test-map-into-hash-test () | ||
| 418 | "Test `map-into' with different hash-table test functions." | ||
| 419 | (should (eq (hash-table-test (map-into () 'hash-table)) #'equal)) | ||
| 420 | (should (eq (hash-table-test (map-into () '(hash-table))) #'eql)) | ||
| 421 | (should (eq (hash-table-test (map-into () '(hash-table :test eq))) #'eq)) | ||
| 422 | (should (eq (hash-table-test (map-into () '(hash-table :test eql))) #'eql)) | ||
| 423 | (should (eq (hash-table-test (map-into () '(hash-table :test equal))) | ||
| 424 | #'equal))) | ||
| 425 | |||
| 426 | (ert-deftest test-map-into-empty () | ||
| 427 | "Test `map-into' with empty maps." | ||
| 428 | (with-empty-maps-do map | ||
| 429 | (should-not (map-into map 'list)) | ||
| 430 | (should-not (map-into map 'alist)) | ||
| 431 | (should-not (map-into map 'plist)) | ||
| 432 | (should (map-empty-p (map-into map 'hash-table))))) | ||
| 358 | 433 | ||
| 359 | (ert-deftest test-map-let () | 434 | (ert-deftest test-map-let () |
| 360 | (map-let (foo bar baz) '((foo . 1) (bar . 2)) | 435 | (map-let (foo bar baz) '((foo . 1) (bar . 2)) |
| 361 | (should (= foo 1)) | 436 | (should (= foo 1)) |
| 362 | (should (= bar 2)) | 437 | (should (= bar 2)) |
| 363 | (should (null baz))) | 438 | (should-not baz)) |
| 364 | (map-let (('foo a) | 439 | (map-let (('foo a) |
| 365 | ('bar b) | 440 | ('bar b) |
| 366 | ('baz c)) | 441 | ('baz c)) |
| 367 | '((foo . 1) (bar . 2)) | 442 | '((foo . 1) (bar . 2)) |
| 368 | (should (= a 1)) | 443 | (should (= a 1)) |
| 369 | (should (= b 2)) | 444 | (should (= b 2)) |
| 370 | (should (null c)))) | 445 | (should-not c))) |
| 446 | |||
| 447 | (ert-deftest test-map-merge () | ||
| 448 | "Test `map-merge'." | ||
| 449 | (should (equal (map-merge 'list '(a 1) '((b . 2) (c . 3)) | ||
| 450 | #s(hash-table data (c 4))) | ||
| 451 | '((c . 4) (b . 2) (a . 1))))) | ||
| 371 | 452 | ||
| 372 | (ert-deftest test-map-merge-with () | 453 | (ert-deftest test-map-merge-with () |
| 373 | (should (equal (map-merge-with 'list #'+ | 454 | (should (equal (map-merge-with 'list #'+ |
| @@ -376,6 +457,19 @@ Evaluate BODY for each created map. | |||
| 376 | '((1 . 1) (2 . 5) (3 . 0))) | 457 | '((1 . 1) (2 . 5) (3 . 0))) |
| 377 | '((3 . 0) (2 . 9) (1 . 6))))) | 458 | '((3 . 0) (2 . 9) (1 . 6))))) |
| 378 | 459 | ||
| 460 | (ert-deftest test-map-merge-empty () | ||
| 461 | "Test merging of empty maps." | ||
| 462 | (should-not (map-merge 'list)) | ||
| 463 | (should-not (map-merge 'alist)) | ||
| 464 | (should-not (map-merge 'plist)) | ||
| 465 | (should-not (map-merge-with 'list #'+)) | ||
| 466 | (should-not (map-merge-with 'alist #'+)) | ||
| 467 | (should-not (map-merge-with 'plist #'+)) | ||
| 468 | (should (map-empty-p (map-merge 'hash-table))) | ||
| 469 | (should (map-empty-p (map-merge-with 'hash-table #'+))) | ||
| 470 | (should-error (map-merge 'array) :type 'cl-no-applicable-method) | ||
| 471 | (should-error (map-merge-with 'array #'+) :type 'cl-no-applicable-method)) | ||
| 472 | |||
| 379 | (ert-deftest test-map-plist-pcase () | 473 | (ert-deftest test-map-plist-pcase () |
| 380 | (let ((plist '(:one 1 :two 2))) | 474 | (let ((plist '(:one 1 :two 2))) |
| 381 | (should (equal (pcase-let (((map :one (:two two)) plist)) | 475 | (should (equal (pcase-let (((map :one (:two two)) plist)) |
diff --git a/test/lisp/emacs-lisp/pcase-tests.el b/test/lisp/emacs-lisp/pcase-tests.el index e6f4c097504..2120139ec18 100644 --- a/test/lisp/emacs-lisp/pcase-tests.el +++ b/test/lisp/emacs-lisp/pcase-tests.el | |||
| @@ -75,8 +75,29 @@ | |||
| 75 | (ert-deftest pcase-tests-vectors () | 75 | (ert-deftest pcase-tests-vectors () |
| 76 | (should (equal (pcase [1 2] (`[,x] 1) (`[,x ,y] (+ x y))) 3))) | 76 | (should (equal (pcase [1 2] (`[,x] 1) (`[,x ,y] (+ x y))) 3))) |
| 77 | 77 | ||
| 78 | ;; Local Variables: | 78 | (ert-deftest pcase-tests-bug14773 () |
| 79 | ;; no-byte-compile: t | 79 | (let ((f (lambda (x) |
| 80 | ;; End: | 80 | (pcase 'dummy |
| 81 | ((and (let var x) (guard var)) 'left) | ||
| 82 | ((and (let var (not x)) (guard var)) 'right))))) | ||
| 83 | (should (equal (funcall f t) 'left)) | ||
| 84 | (should (equal (funcall f nil) 'right)))) | ||
| 85 | |||
| 86 | (ert-deftest pcase-tests-bug46786 () | ||
| 87 | (let ((self 'outer)) | ||
| 88 | (ignore self) | ||
| 89 | (should (equal (cl-macrolet ((show-self () `(list 'self self))) | ||
| 90 | (pcase-let ((`(,self ,_self2) '(inner "2"))) | ||
| 91 | (show-self))) | ||
| 92 | '(self inner))))) | ||
| 93 | |||
| 94 | (ert-deftest pcase-tests-or-vars () | ||
| 95 | (let ((f (lambda (v) | ||
| 96 | (pcase v | ||
| 97 | ((or (and 'b1 (let x1 4) (let x2 5)) | ||
| 98 | (and 'b2 (let y1 8) (let y2 9))) | ||
| 99 | (list x1 x2 y1 y2)))))) | ||
| 100 | (should (equal (funcall f 'b1) '(4 5 nil nil))) | ||
| 101 | (should (equal (funcall f 'b2) '(nil nil 8 9))))) | ||
| 81 | 102 | ||
| 82 | ;;; pcase-tests.el ends here. | 103 | ;;; pcase-tests.el ends here. |
diff --git a/test/lisp/emacs-lisp/rx-tests.el b/test/lisp/emacs-lisp/rx-tests.el index fecdcf55aff..2dd1bca22d1 100644 --- a/test/lisp/emacs-lisp/rx-tests.el +++ b/test/lisp/emacs-lisp/rx-tests.el | |||
| @@ -156,6 +156,8 @@ | |||
| 156 | "....."))) | 156 | "....."))) |
| 157 | 157 | ||
| 158 | (ert-deftest rx-pcase () | 158 | (ert-deftest rx-pcase () |
| 159 | (should (equal (pcase "i18n" ((rx (let x (+ digit))) (list 'ok x))) | ||
| 160 | '(ok "18"))) | ||
| 159 | (should (equal (pcase "a 1 2 3 1 1 b" | 161 | (should (equal (pcase "a 1 2 3 1 1 b" |
| 160 | ((rx (let u (+ digit)) space | 162 | ((rx (let u (+ digit)) space |
| 161 | (let v (+ digit)) space | 163 | (let v (+ digit)) space |
| @@ -176,6 +178,12 @@ | |||
| 176 | ((rx nonl) 'wrong) | 178 | ((rx nonl) 'wrong) |
| 177 | (_ 'correct)) | 179 | (_ 'correct)) |
| 178 | 'correct)) | 180 | 'correct)) |
| 181 | (should (equal (pcase "PQR" | ||
| 182 | ((and (rx (let a nonl)) (rx ?z)) | ||
| 183 | (list 'one a)) | ||
| 184 | ((rx (let b ?Q)) | ||
| 185 | (list 'two b))) | ||
| 186 | '(two "Q"))) | ||
| 179 | (should (equal (pcase-let (((rx ?B (let z nonl)) "ABC")) | 187 | (should (equal (pcase-let (((rx ?B (let z nonl)) "ABC")) |
| 180 | (list 'ok z)) | 188 | (list 'ok z)) |
| 181 | '(ok "C"))) | 189 | '(ok "C"))) |
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index 26e14b98e91..d13397274aa 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el | |||
| @@ -23,6 +23,7 @@ | |||
| 23 | 23 | ||
| 24 | (require 'ert) | 24 | (require 'ert) |
| 25 | (require 'erc) | 25 | (require 'erc) |
| 26 | (require 'erc-ring) | ||
| 26 | 27 | ||
| 27 | (ert-deftest erc--read-time-period () | 28 | (ert-deftest erc--read-time-period () |
| 28 | (cl-letf (((symbol-function 'read-string) (lambda (&rest _) ""))) | 29 | (cl-letf (((symbol-function 'read-string) (lambda (&rest _) ""))) |
| @@ -45,3 +46,66 @@ | |||
| 45 | 46 | ||
| 46 | (cl-letf (((symbol-function 'read-string) (lambda (&rest _) "1d"))) | 47 | (cl-letf (((symbol-function 'read-string) (lambda (&rest _) "1d"))) |
| 47 | (should (equal (erc--read-time-period "foo: ") 86400)))) | 48 | (should (equal (erc--read-time-period "foo: ") 86400)))) |
| 49 | |||
| 50 | (ert-deftest erc-ring-previous-command-base-case () | ||
| 51 | (ert-info ("Create ring when nonexistent and do nothing") | ||
| 52 | (let (erc-input-ring | ||
| 53 | erc-input-ring-index) | ||
| 54 | (erc-previous-command) | ||
| 55 | (should (ring-p erc-input-ring)) | ||
| 56 | (should (zerop (ring-length erc-input-ring))) | ||
| 57 | (should-not erc-input-ring-index))) | ||
| 58 | (should-not erc-input-ring)) | ||
| 59 | |||
| 60 | (ert-deftest erc-ring-previous-command () | ||
| 61 | (with-current-buffer (get-buffer-create "*#fake*") | ||
| 62 | (erc-mode) | ||
| 63 | (insert "\n\n") | ||
| 64 | (setq erc-input-marker (make-marker) ; these are all local | ||
| 65 | erc-insert-marker (make-marker) | ||
| 66 | erc-send-completed-hook nil) | ||
| 67 | (set-marker erc-insert-marker (point-max)) | ||
| 68 | (erc-display-prompt) | ||
| 69 | (should (= (point) erc-input-marker)) | ||
| 70 | (add-hook 'erc-pre-send-functions #'erc-add-to-input-ring nil t) | ||
| 71 | ;; | ||
| 72 | (cl-letf (((symbol-function 'erc-process-input-line) | ||
| 73 | (lambda (&rest _) | ||
| 74 | (insert-before-markers | ||
| 75 | (erc-display-message-highlight 'notice "echo: one\n")))) | ||
| 76 | ((symbol-function 'erc-command-no-process-p) | ||
| 77 | (lambda (&rest _) t))) | ||
| 78 | (ert-info ("Create ring, populate, recall") | ||
| 79 | (insert "/one") | ||
| 80 | (erc-send-current-line) | ||
| 81 | (should (ring-p erc-input-ring)) | ||
| 82 | (should (zerop (ring-member erc-input-ring "/one"))) ; equal | ||
| 83 | (should (save-excursion (forward-line -1) (goto-char (point-at-bol)) | ||
| 84 | (looking-at-p "[*]+ echo: one"))) | ||
| 85 | (should-not erc-input-ring-index) | ||
| 86 | (erc-bol) | ||
| 87 | (should (looking-at "$")) | ||
| 88 | (erc-previous-command) | ||
| 89 | (erc-bol) | ||
| 90 | (should (looking-at "/one")) | ||
| 91 | (should (zerop erc-input-ring-index))) | ||
| 92 | (ert-info ("Back to one") | ||
| 93 | (should (= (ring-length erc-input-ring) (1+ erc-input-ring-index))) | ||
| 94 | (erc-previous-command) | ||
| 95 | (should-not erc-input-ring-index) | ||
| 96 | (erc-bol) | ||
| 97 | (should (looking-at "$")) | ||
| 98 | (should (equal (ring-ref erc-input-ring 0) "/one"))) | ||
| 99 | (ert-info ("Swap input after prompt with previous (#bug46339)") | ||
| 100 | (insert "abc") | ||
| 101 | (erc-previous-command) | ||
| 102 | (should (= 1 erc-input-ring-index)) | ||
| 103 | (erc-bol) | ||
| 104 | (should (looking-at "/one")) | ||
| 105 | (should (equal (ring-ref erc-input-ring 0) "abc")) | ||
| 106 | (should (equal (ring-ref erc-input-ring 1) "/one")) | ||
| 107 | (erc-next-command) | ||
| 108 | (erc-bol) | ||
| 109 | (should (looking-at "abc"))))) | ||
| 110 | (when noninteractive | ||
| 111 | (kill-buffer "*#fake*"))) | ||
diff --git a/test/lisp/json-tests.el b/test/lisp/json-tests.el index 9886dc0d457..f400fb064a6 100644 --- a/test/lisp/json-tests.el +++ b/test/lisp/json-tests.el | |||
| @@ -329,13 +329,13 @@ Point is moved to beginning of the buffer." | |||
| 329 | (should (equal (read str) res))))))) | 329 | (should (equal (read str) res))))))) |
| 330 | 330 | ||
| 331 | (ert-deftest test-json-encode-number () | 331 | (ert-deftest test-json-encode-number () |
| 332 | (should (equal (json-encode-number 0) "0")) | 332 | (should (equal (json-encode 0) "0")) |
| 333 | (should (equal (json-encode-number -0) "0")) | 333 | (should (equal (json-encode -0) "0")) |
| 334 | (should (equal (json-encode-number 3) "3")) | 334 | (should (equal (json-encode 3) "3")) |
| 335 | (should (equal (json-encode-number -5) "-5")) | 335 | (should (equal (json-encode -5) "-5")) |
| 336 | (should (equal (json-encode-number 123.456) "123.456")) | 336 | (should (equal (json-encode 123.456) "123.456")) |
| 337 | (let ((bignum (1+ most-positive-fixnum))) | 337 | (let ((bignum (1+ most-positive-fixnum))) |
| 338 | (should (equal (json-encode-number bignum) | 338 | (should (equal (json-encode bignum) |
| 339 | (number-to-string bignum))))) | 339 | (number-to-string bignum))))) |
| 340 | 340 | ||
| 341 | ;;; Strings | 341 | ;;; Strings |
| @@ -404,6 +404,8 @@ Point is moved to beginning of the buffer." | |||
| 404 | (should (equal (json-read-string) "abcαβγ"))) | 404 | (should (equal (json-read-string) "abcαβγ"))) |
| 405 | (json-tests--with-temp-buffer "\"\\nasd\\u0444\\u044b\\u0432fgh\\t\"" | 405 | (json-tests--with-temp-buffer "\"\\nasd\\u0444\\u044b\\u0432fgh\\t\"" |
| 406 | (should (equal (json-read-string) "\nasdфывfgh\t"))) | 406 | (should (equal (json-read-string) "\nasdфывfgh\t"))) |
| 407 | (json-tests--with-temp-buffer "\"abc\uFFFFαβγ𝔸𝐁𝖢\\\"\\\\\"" | ||
| 408 | (should (equal (json-read-string) "abc\uFFFFαβγ𝔸𝐁𝖢\"\\"))) | ||
| 407 | ;; Bug#24784 | 409 | ;; Bug#24784 |
| 408 | (json-tests--with-temp-buffer "\"\\uD834\\uDD1E\"" | 410 | (json-tests--with-temp-buffer "\"\\uD834\\uDD1E\"" |
| 409 | (should (equal (json-read-string) "\U0001D11E"))) | 411 | (should (equal (json-read-string) "\U0001D11E"))) |
| @@ -418,30 +420,37 @@ Point is moved to beginning of the buffer." | |||
| 418 | (should (equal (json-encode-string "foo") "\"foo\"")) | 420 | (should (equal (json-encode-string "foo") "\"foo\"")) |
| 419 | (should (equal (json-encode-string "a\n\fb") "\"a\\n\\fb\"")) | 421 | (should (equal (json-encode-string "a\n\fb") "\"a\\n\\fb\"")) |
| 420 | (should (equal (json-encode-string "\nasdфыв\u001f\u007ffgh\t") | 422 | (should (equal (json-encode-string "\nasdфыв\u001f\u007ffgh\t") |
| 421 | "\"\\nasdфыв\\u001f\u007ffgh\\t\""))) | 423 | "\"\\nasdфыв\\u001f\u007ffgh\\t\"")) |
| 424 | ;; Bug#43549. | ||
| 425 | (should (equal (json-encode-string (propertize "foo" 'read-only t)) | ||
| 426 | "\"foo\"")) | ||
| 427 | (should (equal (json-encode-string "a\0b") "\"a\\u0000b\"")) | ||
| 428 | (should (equal (json-encode-string "abc\uFFFFαβγ𝔸𝐁𝖢\"\\") | ||
| 429 | "\"abc\uFFFFαβγ𝔸𝐁𝖢\\\"\\\\\""))) | ||
| 422 | 430 | ||
| 423 | (ert-deftest test-json-encode-key () | 431 | (ert-deftest test-json-encode-key () |
| 424 | (should (equal (json-encode-key '##) "\"\"")) | 432 | (with-suppressed-warnings ((obsolete json-encode-key)) |
| 425 | (should (equal (json-encode-key :) "\"\"")) | 433 | (should (equal (json-encode-key '##) "\"\"")) |
| 426 | (should (equal (json-encode-key "") "\"\"")) | 434 | (should (equal (json-encode-key :) "\"\"")) |
| 427 | (should (equal (json-encode-key 'a) "\"a\"")) | 435 | (should (equal (json-encode-key "") "\"\"")) |
| 428 | (should (equal (json-encode-key :a) "\"a\"")) | 436 | (should (equal (json-encode-key 'a) "\"a\"")) |
| 429 | (should (equal (json-encode-key "a") "\"a\"")) | 437 | (should (equal (json-encode-key :a) "\"a\"")) |
| 430 | (should (equal (json-encode-key t) "\"t\"")) | 438 | (should (equal (json-encode-key "a") "\"a\"")) |
| 431 | (should (equal (json-encode-key :t) "\"t\"")) | 439 | (should (equal (json-encode-key t) "\"t\"")) |
| 432 | (should (equal (json-encode-key "t") "\"t\"")) | 440 | (should (equal (json-encode-key :t) "\"t\"")) |
| 433 | (should (equal (json-encode-key nil) "\"nil\"")) | 441 | (should (equal (json-encode-key "t") "\"t\"")) |
| 434 | (should (equal (json-encode-key :nil) "\"nil\"")) | 442 | (should (equal (json-encode-key nil) "\"nil\"")) |
| 435 | (should (equal (json-encode-key "nil") "\"nil\"")) | 443 | (should (equal (json-encode-key :nil) "\"nil\"")) |
| 436 | (should (equal (json-encode-key ":a") "\":a\"")) | 444 | (should (equal (json-encode-key "nil") "\"nil\"")) |
| 437 | (should (equal (json-encode-key ":t") "\":t\"")) | 445 | (should (equal (json-encode-key ":a") "\":a\"")) |
| 438 | (should (equal (json-encode-key ":nil") "\":nil\"")) | 446 | (should (equal (json-encode-key ":t") "\":t\"")) |
| 439 | (should (equal (should-error (json-encode-key 5)) | 447 | (should (equal (json-encode-key ":nil") "\":nil\"")) |
| 440 | '(json-key-format 5))) | 448 | (should (equal (should-error (json-encode-key 5)) |
| 441 | (should (equal (should-error (json-encode-key ["foo"])) | 449 | '(json-key-format 5))) |
| 442 | '(json-key-format ["foo"]))) | 450 | (should (equal (should-error (json-encode-key ["foo"])) |
| 443 | (should (equal (should-error (json-encode-key '("foo"))) | 451 | '(json-key-format ["foo"]))) |
| 444 | '(json-key-format ("foo"))))) | 452 | (should (equal (should-error (json-encode-key '("foo"))) |
| 453 | '(json-key-format ("foo")))))) | ||
| 445 | 454 | ||
| 446 | ;;; Objects | 455 | ;;; Objects |
| 447 | 456 | ||
| @@ -578,45 +587,32 @@ Point is moved to beginning of the buffer." | |||
| 578 | (ert-deftest test-json-encode-hash-table () | 587 | (ert-deftest test-json-encode-hash-table () |
| 579 | (let ((json-encoding-object-sort-predicate nil) | 588 | (let ((json-encoding-object-sort-predicate nil) |
| 580 | (json-encoding-pretty-print nil)) | 589 | (json-encoding-pretty-print nil)) |
| 581 | (should (equal (json-encode-hash-table #s(hash-table)) "{}")) | 590 | (should (equal (json-encode #s(hash-table)) "{}")) |
| 582 | (should (equal (json-encode-hash-table #s(hash-table data (a 1))) | 591 | (should (equal (json-encode #s(hash-table data (a 1))) "{\"a\":1}")) |
| 583 | "{\"a\":1}")) | 592 | (should (equal (json-encode #s(hash-table data (t 1))) "{\"t\":1}")) |
| 584 | (should (equal (json-encode-hash-table #s(hash-table data (t 1))) | 593 | (should (equal (json-encode #s(hash-table data (nil 1))) "{\"nil\":1}")) |
| 585 | "{\"t\":1}")) | 594 | (should (equal (json-encode #s(hash-table data (:a 1))) "{\"a\":1}")) |
| 586 | (should (equal (json-encode-hash-table #s(hash-table data (nil 1))) | 595 | (should (equal (json-encode #s(hash-table data (:t 1))) "{\"t\":1}")) |
| 587 | "{\"nil\":1}")) | 596 | (should (equal (json-encode #s(hash-table data (:nil 1))) "{\"nil\":1}")) |
| 588 | (should (equal (json-encode-hash-table #s(hash-table data (:a 1))) | 597 | (should (equal (json-encode #s(hash-table test equal data ("a" 1))) |
| 589 | "{\"a\":1}")) | ||
| 590 | (should (equal (json-encode-hash-table #s(hash-table data (:t 1))) | ||
| 591 | "{\"t\":1}")) | ||
| 592 | (should (equal (json-encode-hash-table #s(hash-table data (:nil 1))) | ||
| 593 | "{\"nil\":1}")) | ||
| 594 | (should (equal (json-encode-hash-table | ||
| 595 | #s(hash-table test equal data ("a" 1))) | ||
| 596 | "{\"a\":1}")) | 598 | "{\"a\":1}")) |
| 597 | (should (equal (json-encode-hash-table | 599 | (should (equal (json-encode #s(hash-table test equal data ("t" 1))) |
| 598 | #s(hash-table test equal data ("t" 1))) | ||
| 599 | "{\"t\":1}")) | 600 | "{\"t\":1}")) |
| 600 | (should (equal (json-encode-hash-table | 601 | (should (equal (json-encode #s(hash-table test equal data ("nil" 1))) |
| 601 | #s(hash-table test equal data ("nil" 1))) | ||
| 602 | "{\"nil\":1}")) | 602 | "{\"nil\":1}")) |
| 603 | (should (equal (json-encode-hash-table | 603 | (should (equal (json-encode #s(hash-table test equal data (":a" 1))) |
| 604 | #s(hash-table test equal data (":a" 1))) | ||
| 605 | "{\":a\":1}")) | 604 | "{\":a\":1}")) |
| 606 | (should (equal (json-encode-hash-table | 605 | (should (equal (json-encode #s(hash-table test equal data (":t" 1))) |
| 607 | #s(hash-table test equal data (":t" 1))) | ||
| 608 | "{\":t\":1}")) | 606 | "{\":t\":1}")) |
| 609 | (should (equal (json-encode-hash-table | 607 | (should (equal (json-encode #s(hash-table test equal data (":nil" 1))) |
| 610 | #s(hash-table test equal data (":nil" 1))) | ||
| 611 | "{\":nil\":1}")) | 608 | "{\":nil\":1}")) |
| 612 | (should (member (json-encode-hash-table #s(hash-table data (t 2 :nil 1))) | 609 | (should (member (json-encode #s(hash-table data (t 2 :nil 1))) |
| 613 | '("{\"nil\":1,\"t\":2}" "{\"t\":2,\"nil\":1}"))) | 610 | '("{\"nil\":1,\"t\":2}" "{\"t\":2,\"nil\":1}"))) |
| 614 | (should (member (json-encode-hash-table | 611 | (should (member (json-encode #s(hash-table test equal data (:t 2 ":t" 1))) |
| 615 | #s(hash-table test equal data (:t 2 ":t" 1))) | ||
| 616 | '("{\":t\":1,\"t\":2}" "{\"t\":2,\":t\":1}"))) | 612 | '("{\":t\":1,\"t\":2}" "{\"t\":2,\":t\":1}"))) |
| 617 | (should (member (json-encode-hash-table #s(hash-table data (b 2 a 1))) | 613 | (should (member (json-encode #s(hash-table data (b 2 a 1))) |
| 618 | '("{\"a\":1,\"b\":2}" "{\"b\":2,\"a\":1}"))) | 614 | '("{\"a\":1,\"b\":2}" "{\"b\":2,\"a\":1}"))) |
| 619 | (should (member (json-encode-hash-table #s(hash-table data (c 3 b 2 a 1))) | 615 | (should (member (json-encode #s(hash-table data (c 3 b 2 a 1))) |
| 620 | '("{\"a\":1,\"b\":2,\"c\":3}" | 616 | '("{\"a\":1,\"b\":2,\"c\":3}" |
| 621 | "{\"a\":1,\"c\":3,\"b\":2}" | 617 | "{\"a\":1,\"c\":3,\"b\":2}" |
| 622 | "{\"b\":2,\"a\":1,\"c\":3}" | 618 | "{\"b\":2,\"a\":1,\"c\":3}" |
| @@ -629,13 +625,12 @@ Point is moved to beginning of the buffer." | |||
| 629 | (json-encoding-pretty-print t) | 625 | (json-encoding-pretty-print t) |
| 630 | (json-encoding-default-indentation " ") | 626 | (json-encoding-default-indentation " ") |
| 631 | (json-encoding-lisp-style-closings nil)) | 627 | (json-encoding-lisp-style-closings nil)) |
| 632 | (should (equal (json-encode-hash-table #s(hash-table)) "{}")) | 628 | (should (equal (json-encode #s(hash-table)) "{}")) |
| 633 | (should (equal (json-encode-hash-table #s(hash-table data (a 1))) | 629 | (should (equal (json-encode #s(hash-table data (a 1))) "{\n \"a\": 1\n}")) |
| 634 | "{\n \"a\": 1\n}")) | 630 | (should (member (json-encode #s(hash-table data (b 2 a 1))) |
| 635 | (should (member (json-encode-hash-table #s(hash-table data (b 2 a 1))) | ||
| 636 | '("{\n \"a\": 1,\n \"b\": 2\n}" | 631 | '("{\n \"a\": 1,\n \"b\": 2\n}" |
| 637 | "{\n \"b\": 2,\n \"a\": 1\n}"))) | 632 | "{\n \"b\": 2,\n \"a\": 1\n}"))) |
| 638 | (should (member (json-encode-hash-table #s(hash-table data (c 3 b 2 a 1))) | 633 | (should (member (json-encode #s(hash-table data (c 3 b 2 a 1))) |
| 639 | '("{\n \"a\": 1,\n \"b\": 2,\n \"c\": 3\n}" | 634 | '("{\n \"a\": 1,\n \"b\": 2,\n \"c\": 3\n}" |
| 640 | "{\n \"a\": 1,\n \"c\": 3,\n \"b\": 2\n}" | 635 | "{\n \"a\": 1,\n \"c\": 3,\n \"b\": 2\n}" |
| 641 | "{\n \"b\": 2,\n \"a\": 1,\n \"c\": 3\n}" | 636 | "{\n \"b\": 2,\n \"a\": 1,\n \"c\": 3\n}" |
| @@ -648,13 +643,12 @@ Point is moved to beginning of the buffer." | |||
| 648 | (json-encoding-pretty-print t) | 643 | (json-encoding-pretty-print t) |
| 649 | (json-encoding-default-indentation " ") | 644 | (json-encoding-default-indentation " ") |
| 650 | (json-encoding-lisp-style-closings t)) | 645 | (json-encoding-lisp-style-closings t)) |
| 651 | (should (equal (json-encode-hash-table #s(hash-table)) "{}")) | 646 | (should (equal (json-encode #s(hash-table)) "{}")) |
| 652 | (should (equal (json-encode-hash-table #s(hash-table data (a 1))) | 647 | (should (equal (json-encode #s(hash-table data (a 1))) "{\n \"a\": 1}")) |
| 653 | "{\n \"a\": 1}")) | 648 | (should (member (json-encode #s(hash-table data (b 2 a 1))) |
| 654 | (should (member (json-encode-hash-table #s(hash-table data (b 2 a 1))) | ||
| 655 | '("{\n \"a\": 1,\n \"b\": 2}" | 649 | '("{\n \"a\": 1,\n \"b\": 2}" |
| 656 | "{\n \"b\": 2,\n \"a\": 1}"))) | 650 | "{\n \"b\": 2,\n \"a\": 1}"))) |
| 657 | (should (member (json-encode-hash-table #s(hash-table data (c 3 b 2 a 1))) | 651 | (should (member (json-encode #s(hash-table data (c 3 b 2 a 1))) |
| 658 | '("{\n \"a\": 1,\n \"b\": 2,\n \"c\": 3}" | 652 | '("{\n \"a\": 1,\n \"b\": 2,\n \"c\": 3}" |
| 659 | "{\n \"a\": 1,\n \"c\": 3,\n \"b\": 2}" | 653 | "{\n \"a\": 1,\n \"c\": 3,\n \"b\": 2}" |
| 660 | "{\n \"b\": 2,\n \"a\": 1,\n \"c\": 3}" | 654 | "{\n \"b\": 2,\n \"a\": 1,\n \"c\": 3}" |
| @@ -672,7 +666,7 @@ Point is moved to beginning of the buffer." | |||
| 672 | (#s(hash-table data (c 3 b 2 a 1)) | 666 | (#s(hash-table data (c 3 b 2 a 1)) |
| 673 | . "{\"a\":1,\"b\":2,\"c\":3}"))) | 667 | . "{\"a\":1,\"b\":2,\"c\":3}"))) |
| 674 | (let ((copy (map-pairs in))) | 668 | (let ((copy (map-pairs in))) |
| 675 | (should (equal (json-encode-hash-table in) out)) | 669 | (should (equal (json-encode in) out)) |
| 676 | ;; Ensure sorting isn't destructive. | 670 | ;; Ensure sorting isn't destructive. |
| 677 | (should (seq-set-equal-p (map-pairs in) copy)))))) | 671 | (should (seq-set-equal-p (map-pairs in) copy)))))) |
| 678 | 672 | ||
| @@ -785,38 +779,42 @@ Point is moved to beginning of the buffer." | |||
| 785 | (should (equal in copy)))))) | 779 | (should (equal in copy)))))) |
| 786 | 780 | ||
| 787 | (ert-deftest test-json-encode-list () | 781 | (ert-deftest test-json-encode-list () |
| 782 | "Test `json-encode-list' or its more moral equivalents." | ||
| 788 | (let ((json-encoding-object-sort-predicate nil) | 783 | (let ((json-encoding-object-sort-predicate nil) |
| 789 | (json-encoding-pretty-print nil)) | 784 | (json-encoding-pretty-print nil)) |
| 790 | (should (equal (json-encode-list ()) "{}")) | 785 | ;; Trick `json-encode' into using `json--print-list'. |
| 791 | (should (equal (json-encode-list '(a)) "[\"a\"]")) | 786 | (let ((json-null (list nil))) |
| 792 | (should (equal (json-encode-list '(:a)) "[\"a\"]")) | 787 | (should (equal (json-encode ()) "{}"))) |
| 793 | (should (equal (json-encode-list '("a")) "[\"a\"]")) | 788 | (should (equal (json-encode '(a)) "[\"a\"]")) |
| 794 | (should (equal (json-encode-list '(a 1)) "[\"a\",1]")) | 789 | (should (equal (json-encode '(:a)) "[\"a\"]")) |
| 795 | (should (equal (json-encode-list '("a" 1)) "[\"a\",1]")) | 790 | (should (equal (json-encode '("a")) "[\"a\"]")) |
| 796 | (should (equal (json-encode-list '(:a 1)) "{\"a\":1}")) | 791 | (should (equal (json-encode '(a 1)) "[\"a\",1]")) |
| 797 | (should (equal (json-encode-list '((a . 1))) "{\"a\":1}")) | 792 | (should (equal (json-encode '("a" 1)) "[\"a\",1]")) |
| 798 | (should (equal (json-encode-list '((:a . 1))) "{\"a\":1}")) | 793 | (should (equal (json-encode '(:a 1)) "{\"a\":1}")) |
| 799 | (should (equal (json-encode-list '(:b 2 :a)) "[\"b\",2,\"a\"]")) | 794 | (should (equal (json-encode '((a . 1))) "{\"a\":1}")) |
| 800 | (should (equal (json-encode-list '(4 3 2 1)) "[4,3,2,1]")) | 795 | (should (equal (json-encode '((:a . 1))) "{\"a\":1}")) |
| 801 | (should (equal (json-encode-list '(b 2 a 1)) "[\"b\",2,\"a\",1]")) | 796 | (should (equal (json-encode '(:b 2 :a)) "[\"b\",2,\"a\"]")) |
| 802 | (should (equal (json-encode-list '(:b 2 :a 1)) "{\"b\":2,\"a\":1}")) | 797 | (should (equal (json-encode '(4 3 2 1)) "[4,3,2,1]")) |
| 803 | (should (equal (json-encode-list '((b . 2) (a . 1))) "{\"b\":2,\"a\":1}")) | 798 | (should (equal (json-encode '(b 2 a 1)) "[\"b\",2,\"a\",1]")) |
| 804 | (should (equal (json-encode-list '((:b . 2) (:a . 1))) | 799 | (should (equal (json-encode '(:b 2 :a 1)) "{\"b\":2,\"a\":1}")) |
| 800 | (should (equal (json-encode '((b . 2) (a . 1))) "{\"b\":2,\"a\":1}")) | ||
| 801 | (should (equal (json-encode '((:b . 2) (:a . 1))) | ||
| 805 | "{\"b\":2,\"a\":1}")) | 802 | "{\"b\":2,\"a\":1}")) |
| 806 | (should (equal (json-encode-list '((a) 1)) "[[\"a\"],1]")) | 803 | (should (equal (json-encode '((a) 1)) "[[\"a\"],1]")) |
| 807 | (should (equal (json-encode-list '((:a) 1)) "[[\"a\"],1]")) | 804 | (should (equal (json-encode '((:a) 1)) "[[\"a\"],1]")) |
| 808 | (should (equal (json-encode-list '(("a") 1)) "[[\"a\"],1]")) | 805 | (should (equal (json-encode '(("a") 1)) "[[\"a\"],1]")) |
| 809 | (should (equal (json-encode-list '((a 1) 2)) "[[\"a\",1],2]")) | 806 | (should (equal (json-encode '((a 1) 2)) "[[\"a\",1],2]")) |
| 810 | (should (equal (json-encode-list '((:a 1) 2)) "[{\"a\":1},2]")) | 807 | (should (equal (json-encode '((:a 1) 2)) "[{\"a\":1},2]")) |
| 811 | (should (equal (json-encode-list '(((a . 1)) 2)) "[{\"a\":1},2]")) | 808 | (should (equal (json-encode '(((a . 1)) 2)) "[{\"a\":1},2]")) |
| 812 | (should (equal (json-encode-list '(:a 1 :b (2))) "{\"a\":1,\"b\":[2]}")) | 809 | (should (equal (json-encode '(:a 1 :b (2))) "{\"a\":1,\"b\":[2]}")) |
| 813 | (should (equal (json-encode-list '((a . 1) (b 2))) "{\"a\":1,\"b\":[2]}")) | 810 | (should (equal (json-encode '((a . 1) (b 2))) "{\"a\":1,\"b\":[2]}")) |
| 814 | (should-error (json-encode-list '(a . 1)) :type 'wrong-type-argument) | 811 | (should-error (json-encode '(a . 1)) :type 'wrong-type-argument) |
| 815 | (should-error (json-encode-list '((a . 1) 2)) :type 'wrong-type-argument) | 812 | (should-error (json-encode '((a . 1) 2)) :type 'wrong-type-argument) |
| 816 | (should (equal (should-error (json-encode-list [])) | 813 | (with-suppressed-warnings ((obsolete json-encode-list)) |
| 817 | '(json-error []))) | 814 | (should (equal (should-error (json-encode-list [])) |
| 818 | (should (equal (should-error (json-encode-list [a])) | 815 | '(json-error []))) |
| 819 | '(json-error [a]))))) | 816 | (should (equal (should-error (json-encode-list [a])) |
| 817 | '(json-error [a])))))) | ||
| 820 | 818 | ||
| 821 | ;;; Arrays | 819 | ;;; Arrays |
| 822 | 820 | ||
diff --git a/test/lisp/minibuffer-tests.el b/test/lisp/minibuffer-tests.el index 7349b191caf..791e51cdcd5 100644 --- a/test/lisp/minibuffer-tests.el +++ b/test/lisp/minibuffer-tests.el | |||
| @@ -125,5 +125,11 @@ | |||
| 125 | '(("completion1" "prefix1" #("suffix1" 0 7 (face shadow))))) | 125 | '(("completion1" "prefix1" #("suffix1" 0 7 (face shadow))))) |
| 126 | (should (equal (get-text-property 19 'face) 'shadow)))) | 126 | (should (equal (get-text-property 19 'face) 'shadow)))) |
| 127 | 127 | ||
| 128 | (ert-deftest completion-pcm--optimize-pattern () | ||
| 129 | (should (equal (completion-pcm--optimize-pattern '("buf" point "f")) | ||
| 130 | '("buf" point "f"))) | ||
| 131 | (should (equal (completion-pcm--optimize-pattern '(any "" any)) | ||
| 132 | '(any)))) | ||
| 133 | |||
| 128 | (provide 'minibuffer-tests) | 134 | (provide 'minibuffer-tests) |
| 129 | ;;; minibuffer-tests.el ends here | 135 | ;;; minibuffer-tests.el ends here |
diff --git a/test/lisp/net/puny-tests.el b/test/lisp/net/puny-tests.el index b37168f5ca7..28c0d49cbee 100644 --- a/test/lisp/net/puny-tests.el +++ b/test/lisp/net/puny-tests.el | |||
| @@ -39,10 +39,12 @@ | |||
| 39 | (should (string= (puny-decode-string "xn--9dbdkw") "חנוך"))) | 39 | (should (string= (puny-decode-string "xn--9dbdkw") "חנוך"))) |
| 40 | 40 | ||
| 41 | (ert-deftest puny-test-encode-domain () | 41 | (ert-deftest puny-test-encode-domain () |
| 42 | (should (string= (puny-encode-domain "åäö.se") "xn--4cab6c.se"))) | 42 | (should (string= (puny-encode-domain "åäö.se") "xn--4cab6c.se")) |
| 43 | (should (string= (puny-encode-domain "яндекс.рф") "xn--d1acpjx3f.xn--p1ai"))) | ||
| 43 | 44 | ||
| 44 | (ert-deftest puny-test-decode-domain () | 45 | (ert-deftest puny-test-decode-domain () |
| 45 | (should (string= (puny-decode-domain "xn--4cab6c.se") "åäö.se"))) | 46 | (should (string= (puny-decode-domain "xn--4cab6c.se") "åäö.se")) |
| 47 | (should (string= (puny-decode-domain "xn--d1acpjx3f.xn--p1ai") "яндекс.рф"))) | ||
| 46 | 48 | ||
| 47 | (ert-deftest puny-highly-restrictive-domain-p () | 49 | (ert-deftest puny-highly-restrictive-domain-p () |
| 48 | (should (puny-highly-restrictive-domain-p "foo.bar.org")) | 50 | (should (puny-highly-restrictive-domain-p "foo.bar.org")) |
diff --git a/test/lisp/cedet/inversion-tests.el b/test/lisp/obsolete/inversion-tests.el index c8b45d67ea1..c8b45d67ea1 100644 --- a/test/lisp/cedet/inversion-tests.el +++ b/test/lisp/obsolete/inversion-tests.el | |||
diff --git a/test/src/keymap-tests.el b/test/src/keymap-tests.el index d4f5fc3f190..a9b0cb502d3 100644 --- a/test/src/keymap-tests.el +++ b/test/src/keymap-tests.el | |||
| @@ -63,10 +63,66 @@ | |||
| 63 | (keymap--get-keyelt object t) | 63 | (keymap--get-keyelt object t) |
| 64 | (should menu-item-filter-ran))) | 64 | (should menu-item-filter-ran))) |
| 65 | 65 | ||
| 66 | (ert-deftest keymap-define-key/undefined () | ||
| 67 | ;; nil (means key is undefined in this keymap), | ||
| 68 | (let ((map (make-keymap))) | ||
| 69 | (define-key map [?a] nil) | ||
| 70 | (should-not (lookup-key map [?a])))) | ||
| 71 | |||
| 72 | (ert-deftest keymap-define-key/keyboard-macro () | ||
| 73 | ;; a string (treated as a keyboard macro), | ||
| 74 | (let ((map (make-keymap))) | ||
| 75 | (define-key map [?a] "abc") | ||
| 76 | (should (equal (lookup-key map [?a]) "abc")))) | ||
| 77 | |||
| 78 | (ert-deftest keymap-define-key/lambda () | ||
| 79 | (let ((map (make-keymap))) | ||
| 80 | (define-key map [?a] (lambda () (interactive) nil)) | ||
| 81 | (should (functionp (lookup-key map [?a]))))) | ||
| 82 | |||
| 83 | (ert-deftest keymap-define-key/keymap () | ||
| 84 | ;; a keymap (to define a prefix key), | ||
| 85 | (let ((map (make-keymap)) | ||
| 86 | (map2 (make-keymap))) | ||
| 87 | (define-key map [?a] map2) | ||
| 88 | (define-key map2 [?b] 'foo) | ||
| 89 | (should (eq (lookup-key map [?a ?b]) 'foo)))) | ||
| 90 | |||
| 91 | (ert-deftest keymap-define-key/menu-item () | ||
| 92 | ;; or an extended menu item definition. | ||
| 93 | ;; (See info node ‘(elisp)Extended Menu Items’.) | ||
| 94 | (let ((map (make-sparse-keymap)) | ||
| 95 | (menu (make-sparse-keymap))) | ||
| 96 | (define-key menu [new-file] | ||
| 97 | '(menu-item "Visit New File..." find-file | ||
| 98 | :enable (menu-bar-non-minibuffer-window-p) | ||
| 99 | :help "Specify a new file's name, to edit the file")) | ||
| 100 | (define-key map [menu-bar file] (cons "File" menu)) | ||
| 101 | (should (eq (lookup-key map [menu-bar file new-file]) 'find-file)))) | ||
| 102 | |||
| 66 | (ert-deftest keymap-lookup-key () | 103 | (ert-deftest keymap-lookup-key () |
| 67 | (let ((map (make-keymap))) | 104 | (let ((map (make-keymap))) |
| 68 | (define-key map [?a] 'foo) | 105 | (define-key map [?a] 'foo) |
| 69 | (should (eq (lookup-key map [?a]) 'foo)))) | 106 | (should (eq (lookup-key map [?a]) 'foo)) |
| 107 | (should-not (lookup-key map [?b])))) | ||
| 108 | |||
| 109 | (ert-deftest keymap-lookup-key/list-of-keymaps () | ||
| 110 | (let ((map1 (make-keymap)) | ||
| 111 | (map2 (make-keymap))) | ||
| 112 | (define-key map1 [?a] 'foo) | ||
| 113 | (define-key map2 [?b] 'bar) | ||
| 114 | (should (eq (lookup-key (list map1 map2) [?a]) 'foo)) | ||
| 115 | (should (eq (lookup-key (list map1 map2) [?b]) 'bar)) | ||
| 116 | (should-not (lookup-key (list map1 map2) [?c])))) | ||
| 117 | |||
| 118 | (ert-deftest keymap-lookup-key/too-long () | ||
| 119 | (let ((map (make-keymap))) | ||
| 120 | (define-key map (kbd "C-c f") 'foo) | ||
| 121 | (should (= (lookup-key map (kbd "C-c f x")) 2)))) | ||
| 122 | |||
| 123 | ;; TODO: Write test for the ACCEPT-DEFAULT argument. | ||
| 124 | ;; (ert-deftest keymap-lookup-key/accept-default () | ||
| 125 | ;; ...) | ||
| 70 | 126 | ||
| 71 | (ert-deftest describe-buffer-bindings/header-in-current-buffer () | 127 | (ert-deftest describe-buffer-bindings/header-in-current-buffer () |
| 72 | "Header should be inserted into the current buffer. | 128 | "Header should be inserted into the current buffer. |