diff options
author | Stefan Monnier <monnier@iro.umontreal.ca> | 2022-09-25 16:15:16 -0400 |
---|---|---|
committer | Stefan Monnier <monnier@iro.umontreal.ca> | 2022-09-25 16:15:16 -0400 |
commit | 650c20f1ca4e07591a727e1cfcc74b3363d15985 (patch) | |
tree | 85d11f6437cde22f410c25e0e5f71a3131ebd07d /test/lisp/emacs-lisp/map-tests.el | |
parent | 8869332684c2302b5ba1ead4568bbc7ba1c0183e (diff) | |
parent | 4b85ae6a24380fb67a3315eaec9233f17a872473 (diff) | |
download | emacs-650c20f1ca4e07591a727e1cfcc74b3363d15985.tar.gz emacs-650c20f1ca4e07591a727e1cfcc74b3363d15985.tar.bz2 emacs-650c20f1ca4e07591a727e1cfcc74b3363d15985.zip |
Merge 'master' into noverlay
Diffstat (limited to 'test/lisp/emacs-lisp/map-tests.el')
-rw-r--r-- | test/lisp/emacs-lisp/map-tests.el | 600 |
1 files changed, 398 insertions, 202 deletions
diff --git a/test/lisp/emacs-lisp/map-tests.el b/test/lisp/emacs-lisp/map-tests.el index 0a888d88b72..314a1c9e302 100644 --- a/test/lisp/emacs-lisp/map-tests.el +++ b/test/lisp/emacs-lisp/map-tests.el @@ -1,6 +1,6 @@ ;;; map-tests.el --- Tests for map.el -*- lexical-binding:t -*- -;; Copyright (C) 2015-2017 Free Software Foundation, Inc. +;; Copyright (C) 2015-2022 Free Software Foundation, Inc. ;; Author: Nicolas Petton <nicolas@petton.fr> ;; Maintainer: emacs-devel@gnu.org @@ -22,7 +22,7 @@ ;;; Commentary: -;; Tests for map.el +;; Tests for map.el. ;;; Code: @@ -30,101 +30,196 @@ (require 'map) (defmacro with-maps-do (var &rest body) - "Successively bind VAR to an alist, vector and hash-table. + "Successively bind VAR to an alist, plist, vector, and hash-table. Each map is built from the following alist data: -'((0 . 3) (1 . 4) (2 . 5)). -Evaluate BODY for each created map. - -\(fn (var map) body)" - (declare (indent 1) (debug t)) + \\='((0 . 3) (1 . 4) (2 . 5)). +Evaluate BODY for each created map." + (declare (indent 1) (debug (symbolp body))) (let ((alist (make-symbol "alist")) + (plist (make-symbol "plist")) (vec (make-symbol "vec")) (ht (make-symbol "ht"))) `(let ((,alist (list (cons 0 3) (cons 1 4) (cons 2 5))) + (,plist (list 0 3 1 4 2 5)) (,vec (vector 3 4 5)) (,ht (make-hash-table))) (puthash 0 3 ,ht) (puthash 1 4 ,ht) (puthash 2 5 ,ht) - (dolist (,var (list ,alist ,vec ,ht)) + (dolist (,var (list ,alist ,plist ,vec ,ht)) ,@body)))) +(defmacro with-empty-maps-do (var &rest body) + "Like `with-maps-do', but with empty maps." + (declare (indent 1) (debug (symbolp body))) + `(dolist (,var (list (list) (vector) (make-hash-table))) + ,@body)) + +(ert-deftest test-map-plist-p () + "Test `map--plist-p'." + (with-empty-maps-do map + (should-not (map--plist-p map))) + (should-not (map--plist-p "")) + (should-not (map--plist-p '((())))) + (should (map--plist-p '(:a))) + (should (map--plist-p '(a))) + (should (map--plist-p '(nil))) + (should (map--plist-p '("")))) + (ert-deftest test-map-elt () (with-maps-do map (should (= 3 (map-elt map 0))) (should (= 4 (map-elt map 1))) (should (= 5 (map-elt map 2))) - (should (null (map-elt map -1))) - (should (null (map-elt map 4))))) + (should-not (map-elt map -1)) + (should-not (map-elt map 4)) + (should-not (map-elt map 0.1)))) (ert-deftest test-map-elt-default () (with-maps-do map - (should (= 5 (map-elt map 7 5))))) + (should (= 5 (map-elt map 7 5))) + (should (= 5 (map-elt map 0.1 5)))) + (with-empty-maps-do map + (should (= 5 (map-elt map 0 5))))) (ert-deftest test-map-elt-testfn () - (let ((map (list (cons "a" 1) (cons "b" 2))) - ;; Make sure to use a non-eq "a", even when compiled. - (noneq-key (string ?a))) - (should-not (map-elt map noneq-key)) - (should (map-elt map noneq-key nil 'equal)))) + (let* ((a (string ?a)) + (map `((,a . 0) (,(string ?b) . 1)))) + (should (= (map-elt map a) 0)) + (should (= (map-elt map "a") 0)) + (should (= (map-elt map (string ?a)) 0)) + (should (= (map-elt map "b") 1)) + (should (= (map-elt map (string ?b)) 1)))) (ert-deftest test-map-elt-with-nil-value () - (should (null (map-elt '((a . 1) - (b)) - 'b - '2)))) + (should-not (map-elt '((a . 1) (b)) 'b 2))) -(ert-deftest test-map-put () +(ert-deftest test-map-put! () (with-maps-do map (setf (map-elt map 2) 'hello) (should (eq (map-elt map 2) 'hello))) (with-maps-do map - (map-put map 2 'hello) + (with-suppressed-warnings ((obsolete map-put)) + (map-put map 2 'hello)) (should (eq (map-elt map 2) 'hello))) - (let ((ht (make-hash-table))) - (setf (map-elt ht 2) 'a) - (should (eq (map-elt ht 2) - 'a))) - (let ((alist '((0 . a) (1 . b) (2 . c)))) - (setf (map-elt alist 2) 'a) - (should (eq (map-elt alist 2) - 'a))) - (let ((vec [3 4 5])) - (should-error (setf (map-elt vec 3) 6)))) + (with-maps-do map + (map-put! map 2 'hello) + (should (eq (map-elt map 2) 'hello)) + (if (not (or (hash-table-p map) + (map--plist-p map))) + (should-error (map-put! map 5 'value) + ;; For vectors, it could arguably signal + ;; map-not-inplace as well, but it currently doesn't. + :type (if (listp map) + 'map-not-inplace + 'error)) + (map-put! map 5 'value) + (should (eq (map-elt map 5) 'value))))) + +(ert-deftest test-map-put!-new-keys () + "Test `map-put!' with new keys." + (with-maps-do map + (let ((size (map-length map))) + (if (arrayp map) + (progn + (should-error (setf (map-elt map 'k) 'v)) + (should-error (setf (map-elt map size) 'v))) + (setf (map-elt map 'k) 'v) + (should (eq (map-elt map 'k) 'v)) + (setf (map-elt map size) 'v) + (should (eq (map-elt map size) 'v)))))) + +(ert-deftest test-map-put!-alist () + "Test `map-put!' test function on alists." + (let ((key (string ?a)) + (val 0) + map) + (should-error (map-put! map key val) :type 'map-not-inplace) + (setq map (list (cons key val))) + (map-put! map key (1- val)) + (should (equal map '(("a" . -1)))) + (map-put! map (string ?a) (1+ val)) + (should (equal map '(("a" . 1)))) + (should-error (map-put! map (string ?a) val #'eq) :type 'map-not-inplace))) (ert-deftest test-map-put-alist-new-key () "Regression test for Bug#23105." - (let ((alist '((0 . a)))) - (map-put alist 2 'b) - (should (eq (map-elt alist 2) - 'b)))) + (let ((alist (list (cons 0 'a)))) + (with-suppressed-warnings ((obsolete map-put)) + (map-put alist 2 'b)) + (should (eq (map-elt alist 2) 'b)))) (ert-deftest test-map-put-testfn-alist () (let ((alist (list (cons "a" 1) (cons "b" 2))) ;; Make sure to use a non-eq "a", even when compiled. (noneq-key (string ?a))) - (map-put alist noneq-key 3 'equal) - (should-not (cddr alist)) - (map-put alist noneq-key 9) - (should (cddr alist)))) + (with-suppressed-warnings ((obsolete map-put)) + (map-put alist noneq-key 3 #'equal) + (should-not (cddr alist)) + (map-put alist noneq-key 9 #'eql) + (should (cddr alist))))) (ert-deftest test-map-put-return-value () (let ((ht (make-hash-table))) - (should (eq (map-put ht 'a 'hello) 'hello)))) + (with-suppressed-warnings ((obsolete map-put)) + (should (eq (map-put ht 'a 'hello) 'hello))))) + +(ert-deftest test-map-insert-empty () + "Test `map-insert' on empty maps." + (with-empty-maps-do map + (if (arrayp map) + (should-error (map-insert map 0 6)) + (let ((new (map-insert map 0 6))) + (should-not (eq map new)) + (should-not (map-pairs map)) + (should (= (map-elt new 0) 6)))))) + +(ert-deftest test-map-insert () + "Test `map-insert'." + (with-maps-do map + (let ((pairs (map-pairs map)) + (size (map-length map)) + (new (map-insert map 0 6))) + (should-not (eq map new)) + (should (equal (map-pairs map) pairs)) + (should (= (map-elt new 0) 6)) + (if (arrayp map) + (should-error (map-insert map size 7)) + (setq new (map-insert map size 7)) + (should-not (eq map new)) + (should (equal (map-pairs map) pairs)) + (should (= (map-elt new size) 7)))))) (ert-deftest test-map-delete () (with-maps-do map - (map-delete map 1) - (should (null (map-elt map 1)))) + (should (map-elt map 1)) + (should (eq map (map-delete map 1))) + (should-not (map-elt map 1))) (with-maps-do map - (map-delete map -2) - (should (null (map-elt map -2))))) - -(ert-deftest test-map-delete-return-value () - (let ((ht (make-hash-table))) - (should (eq (map-delete ht 'a) ht)))) + (should-not (map-elt map -2)) + (should (eq map (map-delete map -2))) + (should-not (map-elt map -2))) + (with-maps-do map + ;; Check for OBOE. + (let ((key (map-length map))) + (should-not (map-elt map key)) + (should (eq map (map-delete map key))) + (should-not (map-elt map key))))) + +(ert-deftest test-map-delete-empty () + (with-empty-maps-do map + (should (eq map (map-delete map t))))) + +(ert-deftest test-map-delete-alist () + "Test `map-delete' test function on alists." + (let* ((a (string ?a)) + (map `((,a) (,(string ?b))))) + (setq map (map-delete map a)) + (should (equal map '(("b")))) + (setq map (map-delete map (string ?b))) + (should-not map))) (ert-deftest test-map-nested-elt () (let ((vec [a b [c d [e f]]])) @@ -134,8 +229,9 @@ Evaluate BODY for each created map. (d . 3) (e . ((f . 4) (g . 5)))))))) - (should (eq (map-nested-elt alist '(b e f)) - 4))) + (should (eq (map-nested-elt alist '(b e f)) 4))) + (let ((plist '(a 1 b (c 2 d 3 e (f 4 g 5))))) + (should (eq (map-nested-elt plist '(b e f)) 4))) (let ((ht (make-hash-table))) (setf (map-elt ht 'a) 1) (setf (map-elt ht 'b) (make-hash-table)) @@ -145,218 +241,318 @@ Evaluate BODY for each created map. (ert-deftest test-map-nested-elt-default () (let ((vec [a b [c d]])) - (should (null (map-nested-elt vec '(2 3)))) - (should (null (map-nested-elt vec '(2 1 1)))) + (should-not (map-nested-elt vec '(2 3))) + (should-not (map-nested-elt vec '(2 1 1))) (should (= 4 (map-nested-elt vec '(2 1 1) 4))))) (ert-deftest test-mapp () - (should (mapp nil)) - (should (mapp '((a . b) (c . d)))) - (should (mapp '(a b c d))) - (should (mapp [])) - (should (mapp [1 2 3])) - (should (mapp (make-hash-table))) + (with-empty-maps-do map + (should (mapp map))) + (with-maps-do map + (should (mapp map))) + (should (mapp "")) (should (mapp "hello")) - (should (not (mapp 1))) - (should (not (mapp 'hello)))) + (should-not (mapp 1)) + (should-not (mapp 'hello))) (ert-deftest test-map-keys () (with-maps-do map (should (equal (map-keys map) '(0 1 2)))) - (should (null (map-keys nil))) - (should (null (map-keys [])))) + (with-empty-maps-do map + (should-not (map-keys map)))) (ert-deftest test-map-values () (with-maps-do map - (should (equal (map-values map) '(3 4 5))))) + (should (equal (map-values map) '(3 4 5)))) + (with-empty-maps-do map + (should-not (map-values map)))) (ert-deftest test-map-pairs () (with-maps-do map - (should (equal (map-pairs map) '((0 . 3) - (1 . 4) - (2 . 5)))))) + (should (equal (map-pairs map) + '((0 . 3) + (1 . 4) + (2 . 5))))) + (with-empty-maps-do map + (should-not (map-pairs map)))) (ert-deftest test-map-length () - (let ((ht (make-hash-table))) - (puthash 'a 1 ht) - (puthash 'b 2 ht) - (puthash 'c 3 ht) - (puthash 'd 4 ht) - (should (= 0 (map-length nil))) - (should (= 0 (map-length []))) - (should (= 0 (map-length (make-hash-table)))) - (should (= 5 (map-length [0 1 2 3 4]))) - (should (= 2 (map-length '((a . 1) (b . 2))))) - (should (= 4 (map-length ht))))) + (with-empty-maps-do map + (should (zerop (map-length map)))) + (with-maps-do map + (should (= 3 (map-length map)))) + (should (= 1 (map-length '(nil 1)))) + (should (= 2 (map-length '(nil 1 t 2)))) + (should (= 2 (map-length '((a . 1) (b . 2))))) + (should (= 5 (map-length [0 1 2 3 4]))) + (should (= 4 (map-length #s(hash-table data (a 1 b 2 c 3 d 4)))))) (ert-deftest test-map-copy () (with-maps-do map (let ((copy (map-copy map))) - (should (equal (map-keys map) (map-keys copy))) - (should (equal (map-values map) (map-values copy))) - (should (not (eq map copy)))))) + (should (equal (map-pairs map) (map-pairs copy))) + (should-not (eq map copy)) + (map-put! map 0 0) + (should-not (equal (map-pairs map) (map-pairs copy))))) + (with-empty-maps-do map + (should-not (map-pairs (map-copy map))))) + +(ert-deftest test-map-copy-alist () + "Test use of `copy-alist' for alists." + (let* ((cons (list 'a 1 2)) + (alist (list cons)) + (copy (map-copy alist))) + (setcar cons 'b) + (should (equal alist '((b 1 2)))) + (should (equal copy '((a 1 2)))) + (setcar (cdr cons) 0) + (should (equal alist '((b 0 2)))) + (should (equal copy '((a 0 2)))) + (setcdr cons 3) + (should (equal alist '((b . 3)))) + (should (equal copy '((a 0 2)))))) (ert-deftest test-map-apply () - (with-maps-do map - (should (equal (map-apply (lambda (k v) (cons (int-to-string k) v)) - map) - '(("0" . 3) ("1" . 4) ("2" . 5))))) - (let ((vec [a b c])) - (should (equal (map-apply (lambda (k v) (cons (1+ k) v)) - vec) - '((1 . a) - (2 . b) - (3 . c)))))) + (let ((fn (lambda (k v) (cons (number-to-string k) v)))) + (with-maps-do map + (should (equal (map-apply fn map) + '(("0" . 3) ("1" . 4) ("2" . 5))))) + (with-empty-maps-do map + (should-not (map-apply fn map))))) (ert-deftest test-map-do () - (with-maps-do map - (let ((result nil)) - (map-do (lambda (k v) - (add-to-list 'result (list (int-to-string k) v))) - map) - (should (equal result '(("2" 5) ("1" 4) ("0" 3))))))) + (let* (res + (fn (lambda (k v) + (push (list (number-to-string k) v) res)))) + (with-empty-maps-do map + (should-not (map-do fn map)) + (should-not res)) + (with-maps-do map + (setq res nil) + (should-not (map-do fn map)) + (should (equal res '(("2" 5) ("1" 4) ("0" 3))))))) (ert-deftest test-map-keys-apply () (with-maps-do map - (should (equal (map-keys-apply (lambda (k) (int-to-string k)) - map) - '("0" "1" "2")))) - (let ((vec [a b c])) - (should (equal (map-keys-apply (lambda (k) (1+ k)) - vec) - '(1 2 3))))) + (should (equal (map-keys-apply #'1+ map) '(1 2 3)))) + (with-empty-maps-do map + (let (ks) + (should-not (map-keys-apply (lambda (k) (push k ks)) map)) + (should-not ks)))) (ert-deftest test-map-values-apply () (with-maps-do map - (should (equal (map-values-apply (lambda (v) (1+ v)) - map) - '(4 5 6)))) - (let ((vec [a b c])) - (should (equal (map-values-apply (lambda (v) (symbol-name v)) - vec) - '("a" "b" "c"))))) + (should (equal (map-values-apply #'1+ map) '(4 5 6)))) + (with-empty-maps-do map + (let (vs) + (should-not (map-values-apply (lambda (v) (push v vs)) map)) + (should-not vs)))) (ert-deftest test-map-filter () (with-maps-do map - (should (equal (map-keys (map-filter (lambda (_k v) - (<= 4 v)) - map)) - '(1 2))) - (should (null (map-filter (lambda (k _v) - (eq 'd k)) - map)))) - (should (null (map-filter (lambda (_k v) - (eq 3 v)) - [1 2 4 5]))) - (should (equal (map-filter (lambda (k _v) - (eq 3 k)) - [1 2 4 5]) - '((3 . 5))))) + (should (equal (map-filter (lambda (_k v) (> v 3)) map) + '((1 . 4) (2 . 5)))) + (should (equal (map-filter #'always map) (map-pairs map))) + (should-not (map-filter #'ignore map))) + (with-empty-maps-do map + (should-not (map-filter #'always map)) + (should-not (map-filter #'ignore map)))) (ert-deftest test-map-remove () (with-maps-do map - (should (equal (map-keys (map-remove (lambda (_k v) - (>= v 4)) - map)) - '(0))) - (should (equal (map-keys (map-remove (lambda (k _v) - (eq 'd k)) - map)) - (map-keys map)))) - (should (equal (map-remove (lambda (_k v) - (eq 3 v)) - [1 2 4 5]) - '((0 . 1) - (1 . 2) - (2 . 4) - (3 . 5)))) - (should (null (map-remove (lambda (k _v) - (>= k 0)) - [1 2 4 5])))) + (should (equal (map-remove (lambda (_k v) (> v 3)) map) + '((0 . 3)))) + (should (equal (map-remove #'ignore map) (map-pairs map))) + (should-not (map-remove #'always map))) + (with-empty-maps-do map + (should-not (map-remove #'always map)) + (should-not (map-remove #'ignore map)))) (ert-deftest test-map-empty-p () - (should (map-empty-p nil)) - (should (not (map-empty-p '((a . b) (c . d))))) - (should (map-empty-p [])) - (should (not (map-empty-p [1 2 3]))) - (should (map-empty-p (make-hash-table))) - (should (not (map-empty-p "hello"))) - (should (map-empty-p ""))) + (with-empty-maps-do map + (should (map-empty-p map))) + (should (map-empty-p "")) + (should-not (map-empty-p '((a . b) (c . d)))) + (should-not (map-empty-p [1 2 3])) + (should-not (map-empty-p "hello"))) (ert-deftest test-map-contains-key () - (should (map-contains-key '((a . 1) (b . 2)) 'a)) - (should (not (map-contains-key '((a . 1) (b . 2)) 'c))) - (should (map-contains-key '(("a" . 1)) "a")) - (should (not (map-contains-key '(("a" . 1)) "a" #'eq))) - (should (map-contains-key [a b c] 2)) - (should (not (map-contains-key [a b c] 3)))) + (with-empty-maps-do map + (should-not (map-contains-key map -1)) + (should-not (map-contains-key map 0)) + (should-not (map-contains-key map 1)) + (should-not (map-contains-key map (map-length map)))) + (with-maps-do map + (should-not (map-contains-key map -1)) + (should (map-contains-key map 0)) + (should (map-contains-key map 1)) + (should-not (map-contains-key map (map-length map))))) + +(ert-deftest test-map-contains-key-testfn () + "Test `map-contains-key' under different equalities." + (let ((key (string ?a)) + (plist '("a" 1 a 2)) + (alist '(("a" . 1) (a . 2)))) + (should (map-contains-key alist 'a)) + (should (map-contains-key plist 'a)) + (should (map-contains-key alist 'a #'eq)) + (should (map-contains-key plist 'a #'eq)) + (should (map-contains-key alist key)) + (should-not (map-contains-key plist key)) + (should-not (map-contains-key alist key #'eq)) + (should-not (map-contains-key plist key #'eq)))) (ert-deftest test-map-some () (with-maps-do map - (should (map-some (lambda (k _v) - (eq 1 k)) - map)) - (should-not (map-some (lambda (k _v) - (eq 'd k)) - map))) - (let ((vec [a b c])) - (should (map-some (lambda (k _v) - (> k 1)) - vec)) - (should-not (map-some (lambda (k _v) - (> k 3)) - vec)))) + (should (eq (map-some (lambda (k _v) (and (= k 1) 'found)) map) + 'found)) + (should-not (map-some #'ignore map))) + (with-empty-maps-do map + (should-not (map-some #'always map)) + (should-not (map-some #'ignore map)))) (ert-deftest test-map-every-p () (with-maps-do map - (should (map-every-p (lambda (k _v) - k) - map)) - (should (not (map-every-p (lambda (_k _v) - nil) - map)))) - (let ((vec [a b c])) - (should (map-every-p (lambda (k _v) - (>= k 0)) - vec)) - (should (not (map-every-p (lambda (k _v) - (> k 3)) - vec))))) + (should (map-every-p #'always map)) + (should-not (map-every-p #'ignore map)) + (should-not (map-every-p (lambda (k _v) (zerop k)) map))) + (with-empty-maps-do map + (should (map-every-p #'always map)) + (should (map-every-p #'ignore map)) + (should (map-every-p (lambda (k _v) (zerop k)) map)))) (ert-deftest test-map-into () - (let* ((alist '((a . 1) (b . 2))) - (ht (map-into alist 'hash-table))) + (let* ((plist '(a 1 b 2)) + (alist '((a . 1) (b . 2))) + (ht (map-into alist 'hash-table)) + (ht2 (map-into alist '(hash-table :test equal)))) (should (hash-table-p ht)) - (should (equal (map-into (map-into alist 'hash-table) 'list) - alist)) - (should (listp (map-into ht 'list))) - (should (equal (map-keys (map-into (map-into ht 'list) 'hash-table)) - (map-keys ht))) - (should (equal (map-values (map-into (map-into ht 'list) 'hash-table)) - (map-values ht))) - (should (null (map-into nil 'list))) - (should (map-empty-p (map-into nil 'hash-table))) - (should-error (map-into [1 2 3] 'string)))) + (should (equal (map-into ht 'list) alist)) + (should (equal (map-pairs (map-into (map-into ht 'list) 'hash-table)) + (map-pairs ht))) + (should (equal (map-into ht 'alist) (map-into ht2 'alist))) + (should (equal (map-into alist 'list) alist)) + (should (equal (map-into alist 'alist) alist)) + (should (equal (map-into alist 'plist) plist)) + (should (equal (map-into plist 'alist) alist)) + (should (equal (map-into plist 'plist) plist))) + (should-error (map-into [1 2 3] 'string) :type 'cl-no-applicable-method)) + +(ert-deftest test-map-into-hash-test () + "Test `map-into' with different hash-table test functions." + (should (eq (hash-table-test (map-into () 'hash-table)) #'equal)) + (should (eq (hash-table-test (map-into () '(hash-table))) #'eql)) + (should (eq (hash-table-test (map-into () '(hash-table :test eq))) #'eq)) + (should (eq (hash-table-test (map-into () '(hash-table :test eql))) #'eql)) + (should (eq (hash-table-test (map-into () '(hash-table :test equal))) + #'equal))) + +(ert-deftest test-map-into-empty () + "Test `map-into' with empty maps." + (with-empty-maps-do map + (should-not (map-into map 'list)) + (should-not (map-into map 'alist)) + (should-not (map-into map 'plist)) + (should (map-empty-p (map-into map 'hash-table))))) (ert-deftest test-map-let () (map-let (foo bar baz) '((foo . 1) (bar . 2)) (should (= foo 1)) (should (= bar 2)) - (should (null baz))) + (should-not baz)) (map-let (('foo a) ('bar b) ('baz c)) '((foo . 1) (bar . 2)) (should (= a 1)) (should (= b 2)) - (should (null c)))) + (should-not c))) + +(ert-deftest test-map-merge () + "Test `map-merge'." + (should (equal (sort (map-merge 'list '(a 1) '((b . 2) (c . 3)) + #s(hash-table data (c 4))) + (lambda (x y) (string< (car x) (car y)))) + '((a . 1) (b . 2) (c . 4)))) + (should (equal (map-merge 'list () '(:a 1)) '((:a . 1)))) + (should (equal (map-merge 'alist () '(:a 1)) '((:a . 1)))) + (should (equal (map-merge 'plist () '(:a 1)) '(:a 1)))) (ert-deftest test-map-merge-with () - (should (equal (map-merge-with 'list #'+ - '((1 . 2)) - '((1 . 3) (2 . 4)) - '((1 . 1) (2 . 5) (3 . 0))) - '((3 . 0) (2 . 9) (1 . 6))))) + (should (equal (sort (map-merge-with 'list #'+ + '((1 . 2)) + '((1 . 3) (2 . 4)) + '((1 . 1) (2 . 5) (3 . 0))) + #'car-less-than-car) + '((1 . 6) (2 . 9) (3 . 0)))) + (should (equal (map-merge-with 'list #'+ () '(:a 1)) '((:a . 1)))) + (should (equal (map-merge-with 'alist #'+ () '(:a 1)) '((:a . 1)))) + (should (equal (map-merge-with 'plist #'+ () '(:a 1)) '(:a 1)))) + +(ert-deftest test-map-merge-empty () + "Test merging of empty maps." + (should-not (map-merge 'list)) + (should-not (map-merge 'alist)) + (should-not (map-merge 'plist)) + (should-not (map-merge-with 'list #'+)) + (should-not (map-merge-with 'alist #'+)) + (should-not (map-merge-with 'plist #'+)) + (should (map-empty-p (map-merge 'hash-table))) + (should (map-empty-p (map-merge-with 'hash-table #'+))) + (should-error (map-merge 'array) :type 'cl-no-applicable-method) + (should-error (map-merge-with 'array #'+) :type 'cl-no-applicable-method)) + +(ert-deftest test-map-plist-pcase () + (let ((plist '(:one 1 :two 2))) + (should (equal (pcase-let (((map :one (:two two)) plist)) + (list one two)) + '(1 2))))) + +(ert-deftest test-map-setf-alist-insert-key () + (let ((alist)) + (should (equal (setf (map-elt alist 'key) 'value) + 'value)) + (should (equal alist '((key . value)))))) + +(ert-deftest test-map-setf-alist-overwrite-key () + (let ((alist '((key . value1)))) + (should (equal (setf (map-elt alist 'key) 'value2) + 'value2)) + (should (equal alist '((key . value2)))))) + +(ert-deftest test-map-setf-plist-insert-key () + (let ((plist '(key value))) + (should (equal (setf (map-elt plist 'key2) 'value2) + 'value2)) + (should (equal plist '(key value key2 value2))))) + +(ert-deftest test-map-setf-plist-overwrite-key () + (let ((plist '(key value))) + (should (equal (setf (map-elt plist 'key) 'value2) + 'value2)) + (should (equal plist '(key value2))))) + +(ert-deftest test-hash-table-setf-insert-key () + (let ((ht (make-hash-table))) + (should (equal (setf (map-elt ht 'key) 'value) + 'value)) + (should (equal (map-elt ht 'key) 'value)))) + +(ert-deftest test-hash-table-setf-overwrite-key () + (let ((ht (make-hash-table))) + (puthash 'key 'value1 ht) + (should (equal (setf (map-elt ht 'key) 'value2) + 'value2)) + (should (equal (map-elt ht 'key) 'value2)))) + +(ert-deftest test-setf-map-with-function () + (let ((num 0) + (map nil)) + (setf (map-elt map 'foo) + (funcall (lambda () + (cl-incf num)))) + ;; Check that the function is only called once. + (should (= num 1)))) (provide 'map-tests) ;;; map-tests.el ends here |