Consistently test alist keys with equal in map.el
* etc/NEWS: Announce new default behavior of map-elt and map-delete on alists. * lisp/emacs-lisp/map.el: Bump to version 3.2. (map-elt): Test alist keys with equal by default. Betray a little bit more information in the docstring on which functions are used for which map types. (Bug#47368) (map-put): Update docstring accordingly. (map--plist-delete): Consistently test plist keys with eq. (map-delete): Consistently test alist keys with equal. * test/lisp/emacs-lisp/map-tests.el (test-map-elt-testfn): Update for new map-elt behavior. (test-map-put!-alist, test-map-delete-alist): New tests.
This commit is contained in:
parent
414fcd7e98
commit
14495e33af
3 changed files with 46 additions and 12 deletions
6
etc/NEWS
6
etc/NEWS
|
@ -3706,6 +3706,12 @@ and well-behaved enough to lose the "internal" marker.
|
|||
|
||||
** map.el
|
||||
|
||||
---
|
||||
*** Alist keys are now consistently compared with 'equal' by default.
|
||||
Until now, 'map-elt' and 'map-delete' compared alist keys with 'eq' by
|
||||
default. They now use 'equal' instead, for consistency with
|
||||
'map-put!' and 'map-contains-key'.
|
||||
|
||||
*** Pcase 'map' pattern added keyword symbols abbreviation.
|
||||
A pattern like '(map :sym)' binds the map's value for ':sym' to 'sym',
|
||||
equivalent to '(map (:sym sym))'.
|
||||
|
|
|
@ -5,7 +5,7 @@
|
|||
;; Author: Nicolas Petton <nicolas@petton.fr>
|
||||
;; Maintainer: emacs-devel@gnu.org
|
||||
;; Keywords: extensions, lisp
|
||||
;; Version: 3.1
|
||||
;; Version: 3.2
|
||||
;; Package-Requires: ((emacs "26"))
|
||||
|
||||
;; This file is part of GNU Emacs.
|
||||
|
@ -103,10 +103,14 @@ Returns the result of evaluating the form associated with MAP-VAR's type."
|
|||
(and (consp list) (atom (car list))))
|
||||
|
||||
(cl-defgeneric map-elt (map key &optional default testfn)
|
||||
"Lookup KEY in MAP and return its associated value.
|
||||
"Look up KEY in MAP and return its associated value.
|
||||
If KEY is not found, return DEFAULT which defaults to nil.
|
||||
|
||||
TESTFN is deprecated. Its default depends on the MAP argument.
|
||||
TESTFN is the function to use for comparing keys. It is
|
||||
deprecated because its default and valid values depend on the MAP
|
||||
argument. Generally, alist keys are compared with `equal', plist
|
||||
keys with `eq', and hash-table keys with the hash-table's test
|
||||
function.
|
||||
|
||||
In the base definition, MAP can be an alist, plist, hash-table,
|
||||
or array."
|
||||
|
@ -136,7 +140,7 @@ or array."
|
|||
:list (if (map--plist-p map)
|
||||
(let ((res (plist-member map key)))
|
||||
(if res (cadr res) default))
|
||||
(alist-get key map default nil testfn))
|
||||
(alist-get key map default nil (or testfn #'equal)))
|
||||
:hash-table (gethash key map default)
|
||||
:array (if (map-contains-key map key)
|
||||
(aref map key)
|
||||
|
@ -147,7 +151,7 @@ or array."
|
|||
If KEY is already present in MAP, replace the associated value
|
||||
with VALUE.
|
||||
When MAP is an alist, test equality with TESTFN if non-nil,
|
||||
otherwise use `eql'.
|
||||
otherwise use `equal'.
|
||||
|
||||
MAP can be an alist, plist, hash-table, or array."
|
||||
(declare (obsolete "use map-put! or (setf (map-elt ...) ...) instead" "27.1"))
|
||||
|
@ -157,7 +161,7 @@ MAP can be an alist, plist, hash-table, or array."
|
|||
(let ((tail map) last)
|
||||
(while (consp tail)
|
||||
(cond
|
||||
((not (equal key (car tail)))
|
||||
((not (eq key (car tail)))
|
||||
(setq last tail)
|
||||
(setq tail (cddr last)))
|
||||
(last
|
||||
|
@ -177,7 +181,7 @@ Keys not present in MAP are ignored.")
|
|||
;; FIXME: Signal map-not-inplace i.s.o returning a different list?
|
||||
(if (map--plist-p map)
|
||||
(map--plist-delete map key)
|
||||
(setf (alist-get key map nil t) nil)
|
||||
(setf (alist-get key map nil t #'equal) nil)
|
||||
map))
|
||||
|
||||
(cl-defmethod map-delete ((map hash-table) key)
|
||||
|
|
|
@ -85,11 +85,13 @@ Evaluate BODY for each created 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-not (map-elt '((a . 1) (b)) 'b 2)))
|
||||
|
@ -129,6 +131,19 @@ Evaluate BODY for each created map."
|
|||
(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 (list (cons 0 'a))))
|
||||
|
@ -197,6 +212,15 @@ Evaluate BODY for each created map."
|
|||
(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]]]))
|
||||
(should (eq (map-nested-elt vec '(2 2 0)) 'e)))
|
||||
|
|
Loading…
Add table
Reference in a new issue