Various map.el improvements
* lisp/emacs-lisp/seq.el (seq-do-indexed): Return nil as per doc. * lisp/emacs-lisp/map.el: Require Emacs >= 26 due to dependence on 5-arg alist-get. Bump package to version 3.0. Fix other headers. (Bug#46754) (map--plist-p): Detect list starting with nil as plist, not alist. (map-elt, map-filter, map-apply, map--make-pcase-bindings) (map--make-pcase-patterns): Simplify. (map-let, map-put, map-nested-elt, mapp): Update docstring for plist support. (map-delete): Fix OBOE on arrays. Split into cl-defmethods. (map-values, map-values-apply): Specialize for arrays. (map-pairs, map-keys-apply, map-put!): Improve docstring. (map-length): Clarify docstring w.r.t. duplicate keys. Split into cl-defmethods. Optimize default implementation. (map-copy): Use copy-alist on alists. Split into cl-defmethods. (map-contains-key): Add plist support. Clarify docstring w.r.t. optional argument. Simplify default implementation. (map-some, map-every-p, map-merge, map-merge-with, map--into-hash): Don't use map-apply for side effects. (map-into): Preserve plist ordering. Improve docstrings. (map-insert): Add hash-table and array support. (map-inplace): Remove unused error symbol. (map-do): Return nil as per doc. * etc/NEWS: Announce new user-visible behavior. * test/lisp/emacs-lisp/map-tests.el: Prefer should-not over (should (not ...)) in general. (with-maps-do): Fix docstring. (with-empty-maps-do): New macro. (test-map-elt-default, test-mapp, test-map-keys, test-map-values) (test-map-pairs, test-map-length, test-map-copy, test-map-apply) (test-map-do, test-map-keys-apply, test-map-values-apply) (test-map-filter, test-map-remove, test-map-empty-p) (test-map-contains-key, test-map-some, test-map-every-p): Use it. (test-map-plist-p, test-map-put!-new-keys, test-map-insert-empty) (test-map-insert, test-map-delete-empty, test-map-copy-alist) (test-map-contains-key-testfn, test-map-into-hash-test) (test-map-into-empty, test-map-merge, test-map-merge-empty): New tests. (test-map-elt): Test array key that is within bounds but not fixnum. (test-map-put!): Use map--plist-p. Remove redundant tests. (test-map-put-alist-new-key): Don't modify list literal. (test-map-put-testfn-alist, test-map-put-return-value): Silence obsoletion warnings. (test-map-delete): Check for OBOE on arrays. (test-map-delete-return-value): Remove test made redundant by test-map-delete. (test-map-nested-elt, test-map-into): Test plists too.
This commit is contained in:
Basil L. Contovounesios
parent
1d43c1854a
commit
d925121b1e
4 changed files with 471 additions and 337 deletions
7
etc/NEWS
7
etc/NEWS
|
|
@ -1160,6 +1160,13 @@ effect.
|
|||
A pattern like '(map :sym)' binds the map's value for ':sym' to 'sym',
|
||||
equivalent to '(map (:sym sym))'.
|
||||
|
||||
---
|
||||
*** The function 'map-copy' now uses 'copy-alist' on alists.
|
||||
This is a slightly deeper copy than the previous 'copy-sequence'.
|
||||
|
||||
---
|
||||
*** The function 'map-contains-key' now supports plists.
|
||||
|
||||
** Package
|
||||
|
||||
+++
|
||||
|
|
|
|||
|
|
@ -3,12 +3,10 @@
|
|||
;; Copyright (C) 2015-2021 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Nicolas Petton <nicolas@petton.fr>
|
||||
;; Keywords: convenience, map, hash-table, alist, array
|
||||
;; Version: 2.1
|
||||
;; Package-Requires: ((emacs "25"))
|
||||
;; Package: map
|
||||
|
||||
;; Maintainer: emacs-devel@gnu.org
|
||||
;; Keywords: extensions, lisp
|
||||
;; Version: 3.0
|
||||
;; Package-Requires: ((emacs "26"))
|
||||
|
||||
;; This file is part of GNU Emacs.
|
||||
|
||||
|
|
@ -27,8 +25,9 @@
|
|||
|
||||
;;; Commentary:
|
||||
|
||||
;; map.el provides map-manipulation functions that work on alists,
|
||||
;; hash-table and arrays. All functions are prefixed with "map-".
|
||||
;; map.el provides generic map-manipulation functions that work on
|
||||
;; alists, plists, hash-tables, and arrays. All functions are
|
||||
;; prefixed with "map-".
|
||||
;;
|
||||
;; Functions taking a predicate or iterating over a map using a
|
||||
;; function take the function as their first argument. All other
|
||||
|
|
@ -54,7 +53,7 @@ ARGS is a list of elements to be matched in the map.
|
|||
Each element of ARGS can be of the form (KEY PAT), in which case KEY is
|
||||
evaluated and searched for in the map. The match fails if for any KEY
|
||||
found in the map, the corresponding PAT doesn't match the value
|
||||
associated to the KEY.
|
||||
associated with the KEY.
|
||||
|
||||
Each element can also be a SYMBOL, which is an abbreviation of
|
||||
a (KEY PAT) tuple of the form (\\='SYMBOL SYMBOL). When SYMBOL
|
||||
|
|
@ -75,7 +74,7 @@ bound to the looked up value in MAP.
|
|||
KEYS can also be a list of (KEY VARNAME) pairs, in which case
|
||||
KEY is an unquoted form.
|
||||
|
||||
MAP can be a list, hash-table or array."
|
||||
MAP can be an alist, plist, hash-table, or array."
|
||||
(declare (indent 2)
|
||||
(debug ((&rest &or symbolp ([form symbolp])) form body)))
|
||||
`(pcase-let ((,(map--make-pcase-patterns keys) ,map))
|
||||
|
|
@ -101,7 +100,7 @@ Returns the result of evaluating the form associated with MAP-VAR's type."
|
|||
(define-error 'map-not-inplace "Cannot modify map in-place")
|
||||
|
||||
(defsubst map--plist-p (list)
|
||||
(and (consp list) (not (listp (car list)))))
|
||||
(and (consp list) (atom (car list))))
|
||||
|
||||
(cl-defgeneric map-elt (map key &optional default testfn)
|
||||
"Lookup KEY in MAP and return its associated value.
|
||||
|
|
@ -109,7 +108,8 @@ If KEY is not found, return DEFAULT which defaults to nil.
|
|||
|
||||
TESTFN is deprecated. Its default depends on the MAP argument.
|
||||
|
||||
In the base definition, MAP can be an alist, hash-table, or array."
|
||||
In the base definition, MAP can be an alist, plist, hash-table,
|
||||
or array."
|
||||
(declare
|
||||
(gv-expander
|
||||
(lambda (do)
|
||||
|
|
@ -127,26 +127,25 @@ In the base definition, MAP can be an alist, hash-table, or array."
|
|||
`(map-insert ,mgetter ,key ,v))))))))))
|
||||
;; `testfn' is deprecated.
|
||||
(advertised-calling-convention (map key &optional default) "27.1"))
|
||||
;; Can't use `cl-defmethod' with `advertised-calling-convention'.
|
||||
(map--dispatch map
|
||||
:list (if (map--plist-p map)
|
||||
(let ((res (plist-get map key)))
|
||||
(if (and default (null res) (not (plist-member map key)))
|
||||
default
|
||||
res))
|
||||
(let ((res (plist-member map key)))
|
||||
(if res (cadr res) default))
|
||||
(alist-get key map default nil testfn))
|
||||
:hash-table (gethash key map default)
|
||||
:array (if (and (>= key 0) (< key (seq-length map)))
|
||||
(seq-elt map key)
|
||||
:array (if (map-contains-key map key)
|
||||
(aref map key)
|
||||
default)))
|
||||
|
||||
(defmacro map-put (map key value &optional testfn)
|
||||
"Associate KEY with VALUE in MAP and return VALUE.
|
||||
If KEY is already present in MAP, replace the associated value
|
||||
with VALUE.
|
||||
When MAP is a list, test equality with TESTFN if non-nil,
|
||||
When MAP is an alist, test equality with TESTFN if non-nil,
|
||||
otherwise use `eql'.
|
||||
|
||||
MAP can be a list, hash-table or array."
|
||||
MAP can be an alist, plist, hash-table, or array."
|
||||
(declare (obsolete "use map-put! or (setf (map-elt ...) ...) instead" "27.1"))
|
||||
`(setf (map-elt ,map ,key nil ,testfn) ,value))
|
||||
|
||||
|
|
@ -168,23 +167,30 @@ MAP can be a list, hash-table or array."
|
|||
|
||||
(cl-defgeneric map-delete (map key)
|
||||
"Delete KEY in-place from MAP and return MAP.
|
||||
No error is signaled if KEY is not a key of MAP.
|
||||
If MAP is an array, store nil at the index KEY."
|
||||
(map--dispatch map
|
||||
;; FIXME: Signal map-not-inplace i.s.o returning a different list?
|
||||
:list (if (map--plist-p map)
|
||||
(setq map (map--plist-delete map key))
|
||||
(setf (alist-get key map nil t) nil))
|
||||
:hash-table (remhash key map)
|
||||
:array (and (>= key 0)
|
||||
(<= key (seq-length map))
|
||||
(aset map key nil)))
|
||||
Keys not present in MAP are ignored.")
|
||||
|
||||
(cl-defmethod map-delete ((map list) key)
|
||||
;; 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)
|
||||
map))
|
||||
|
||||
(cl-defmethod map-delete ((map hash-table) key)
|
||||
(remhash key map)
|
||||
map)
|
||||
|
||||
(cl-defmethod map-delete ((map array) key)
|
||||
"Store nil at index KEY."
|
||||
(when (map-contains-key map key)
|
||||
(aset map key nil))
|
||||
map)
|
||||
|
||||
(defun map-nested-elt (map keys &optional default)
|
||||
"Traverse MAP using KEYS and return the looked up value or DEFAULT if nil.
|
||||
|
||||
Map can be a nested map composed of alists, hash-tables and arrays."
|
||||
MAP can be a nested map composed of alists, plists, hash-tables,
|
||||
and arrays."
|
||||
(or (seq-reduce (lambda (acc key)
|
||||
(when (mapp acc)
|
||||
(map-elt acc key)))
|
||||
|
|
@ -202,30 +208,49 @@ The default implementation delegates to `map-apply'."
|
|||
The default implementation delegates to `map-apply'."
|
||||
(map-apply (lambda (_ value) value) map))
|
||||
|
||||
(cl-defmethod map-values ((map array))
|
||||
"Convert MAP into a list."
|
||||
(append map ()))
|
||||
|
||||
(cl-defgeneric map-pairs (map)
|
||||
"Return the elements of MAP as key/value association lists.
|
||||
"Return the key/value pairs in MAP as an alist.
|
||||
The default implementation delegates to `map-apply'."
|
||||
(map-apply #'cons map))
|
||||
|
||||
(cl-defgeneric map-length (map)
|
||||
;; FIXME: Should we rename this to `map-size'?
|
||||
"Return the number of elements in the map.
|
||||
The default implementation counts `map-keys'."
|
||||
(cond
|
||||
((hash-table-p map) (hash-table-count map))
|
||||
((listp map)
|
||||
;; FIXME: What about repeated/shadowed keys?
|
||||
(if (map--plist-p map) (/ (length map) 2) (length map)))
|
||||
((arrayp map) (length map))
|
||||
(t (length (map-keys map)))))
|
||||
"Return the number of key/value pairs in MAP.
|
||||
Note that this does not always reflect the number of unique keys.
|
||||
The default implementation delegates to `map-do'."
|
||||
(let ((size 0))
|
||||
(map-do (lambda (_k _v) (setq size (1+ size))) map)
|
||||
size))
|
||||
|
||||
(cl-defmethod map-length ((map hash-table))
|
||||
(hash-table-count map))
|
||||
|
||||
(cl-defmethod map-length ((map list))
|
||||
(if (map--plist-p map)
|
||||
(/ (length map) 2)
|
||||
(length map)))
|
||||
|
||||
(cl-defmethod map-length ((map array))
|
||||
(length map))
|
||||
|
||||
(cl-defgeneric map-copy (map)
|
||||
"Return a copy of MAP."
|
||||
;; FIXME: Clarify how deep is the copy!
|
||||
(map--dispatch map
|
||||
:list (seq-copy map) ;FIXME: Probably not deep enough for alists!
|
||||
:hash-table (copy-hash-table map)
|
||||
:array (seq-copy map)))
|
||||
"Return a copy of MAP.")
|
||||
|
||||
(cl-defmethod map-copy ((map list))
|
||||
"Use `copy-alist' on alists and `copy-sequence' on plists."
|
||||
(if (map--plist-p map)
|
||||
(copy-sequence map)
|
||||
(copy-alist map)))
|
||||
|
||||
(cl-defmethod map-copy ((map hash-table))
|
||||
(copy-hash-table map))
|
||||
|
||||
(cl-defmethod map-copy ((map array))
|
||||
(copy-sequence map))
|
||||
|
||||
(cl-defgeneric map-apply (function map)
|
||||
"Apply FUNCTION to each element of MAP and return the result as a list.
|
||||
|
|
@ -243,26 +268,28 @@ FUNCTION is called with two arguments, the key and the value.")
|
|||
(cl-defmethod map-do (function (map hash-table)) (maphash function map))
|
||||
|
||||
(cl-defgeneric map-keys-apply (function map)
|
||||
"Return the result of applying FUNCTION to each key of MAP.
|
||||
"Return the result of applying FUNCTION to each key in MAP.
|
||||
The default implementation delegates to `map-apply'."
|
||||
(map-apply (lambda (key _)
|
||||
(funcall function key))
|
||||
map))
|
||||
|
||||
(cl-defgeneric map-values-apply (function map)
|
||||
"Return the result of applying FUNCTION to each value of MAP.
|
||||
"Return the result of applying FUNCTION to each value in MAP.
|
||||
The default implementation delegates to `map-apply'."
|
||||
(map-apply (lambda (_ val)
|
||||
(funcall function val))
|
||||
map))
|
||||
|
||||
(cl-defmethod map-values-apply (function (map array))
|
||||
(mapcar function map))
|
||||
|
||||
(cl-defgeneric map-filter (pred map)
|
||||
"Return an alist of key/val pairs for which (PRED key val) is non-nil in MAP.
|
||||
The default implementation delegates to `map-apply'."
|
||||
(delq nil (map-apply (lambda (key val)
|
||||
(if (funcall pred key val)
|
||||
(cons key val)
|
||||
nil))
|
||||
(and (funcall pred key val)
|
||||
(cons key val)))
|
||||
map)))
|
||||
|
||||
(cl-defgeneric map-remove (pred map)
|
||||
|
|
@ -272,7 +299,7 @@ The default implementation delegates to `map-filter'."
|
|||
map))
|
||||
|
||||
(cl-defgeneric mapp (map)
|
||||
"Return non-nil if MAP is a map (alist, hash-table, array, ...)."
|
||||
"Return non-nil if MAP is a map (alist/plist, hash-table, array, ...)."
|
||||
(or (listp map)
|
||||
(hash-table-p map)
|
||||
(arrayp map)))
|
||||
|
|
@ -292,56 +319,58 @@ The default implementation delegates to `map-length'."
|
|||
;; test function!
|
||||
"Return non-nil if and only if MAP contains KEY.
|
||||
TESTFN is deprecated. Its default depends on MAP.
|
||||
The default implementation delegates to `map-do'."
|
||||
The default implementation delegates to `map-some'."
|
||||
(unless testfn (setq testfn #'equal))
|
||||
(catch 'map--catch
|
||||
(map-do (lambda (k _v)
|
||||
(if (funcall testfn key k) (throw 'map--catch t)))
|
||||
map)
|
||||
nil))
|
||||
(map-some (lambda (k _v) (funcall testfn key k)) map))
|
||||
|
||||
(cl-defmethod map-contains-key ((map list) key &optional testfn)
|
||||
(let ((v '(nil)))
|
||||
(not (eq v (alist-get key map v nil (or testfn #'equal))))))
|
||||
"Return non-nil if MAP contains KEY.
|
||||
If MAP is an alist, TESTFN defaults to `equal'.
|
||||
If MAP is a plist, `plist-member' is used instead."
|
||||
(if (map--plist-p map)
|
||||
(plist-member map key)
|
||||
(let ((v '(nil)))
|
||||
(not (eq v (alist-get key map v nil (or testfn #'equal)))))))
|
||||
|
||||
(cl-defmethod map-contains-key ((map array) key &optional _testfn)
|
||||
(and (integerp key)
|
||||
(>= key 0)
|
||||
(< key (length map))))
|
||||
"Return non-nil if KEY is an index of MAP, ignoring TESTFN."
|
||||
(and (natnump key) (< key (length map))))
|
||||
|
||||
(cl-defmethod map-contains-key ((map hash-table) key &optional _testfn)
|
||||
"Return non-nil if MAP contains KEY, ignoring TESTFN."
|
||||
(let ((v '(nil)))
|
||||
(not (eq v (gethash key map v)))))
|
||||
|
||||
(cl-defgeneric map-some (pred map)
|
||||
"Return the first non-nil (PRED key val) in MAP.
|
||||
The default implementation delegates to `map-apply'."
|
||||
Return nil if no such element is found.
|
||||
The default implementation delegates to `map-do'."
|
||||
;; FIXME: Not sure if there's much benefit to defining it as defgeneric,
|
||||
;; since as defined, I can't think of a map-type where we could provide an
|
||||
;; algorithmically more efficient algorithm than the default.
|
||||
(catch 'map--break
|
||||
(map-apply (lambda (key value)
|
||||
(let ((result (funcall pred key value)))
|
||||
(when result
|
||||
(throw 'map--break result))))
|
||||
map)
|
||||
(map-do (lambda (key value)
|
||||
(let ((result (funcall pred key value)))
|
||||
(when result
|
||||
(throw 'map--break result))))
|
||||
map)
|
||||
nil))
|
||||
|
||||
(cl-defgeneric map-every-p (pred map)
|
||||
"Return non-nil if (PRED key val) is non-nil for all elements of MAP.
|
||||
The default implementation delegates to `map-apply'."
|
||||
The default implementation delegates to `map-do'."
|
||||
;; FIXME: Not sure if there's much benefit to defining it as defgeneric,
|
||||
;; since as defined, I can't think of a map-type where we could provide an
|
||||
;; algorithmically more efficient algorithm than the default.
|
||||
(catch 'map--break
|
||||
(map-apply (lambda (key value)
|
||||
(map-do (lambda (key value)
|
||||
(or (funcall pred key value)
|
||||
(throw 'map--break nil)))
|
||||
map)
|
||||
t))
|
||||
|
||||
(defun map-merge (type &rest maps)
|
||||
"Merge into a map of type TYPE all the key/value pairs in MAPS.
|
||||
"Merge into a map of TYPE all the key/value pairs in MAPS.
|
||||
See `map-into' for all supported values of TYPE."
|
||||
(let ((result (map-into (pop maps) type)))
|
||||
(while maps
|
||||
|
|
@ -349,48 +378,57 @@ See `map-into' for all supported values of TYPE."
|
|||
;; For small tables, this is fine, but for large tables, we
|
||||
;; should probably use a hash-table internally which we convert
|
||||
;; to an alist in the end.
|
||||
(map-apply (lambda (key value)
|
||||
(setf (map-elt result key) value))
|
||||
(pop maps)))
|
||||
(map-do (lambda (key value)
|
||||
(setf (map-elt result key) value))
|
||||
(pop maps)))
|
||||
result))
|
||||
|
||||
(defun map-merge-with (type function &rest maps)
|
||||
"Merge into a map of type TYPE all the key/value pairs in MAPS.
|
||||
When two maps contain the same key (`eql'), call FUNCTION on the two
|
||||
"Merge into a map of TYPE all the key/value pairs in MAPS.
|
||||
When two maps contain the same (`eql') key, call FUNCTION on the two
|
||||
values and use the value returned by it.
|
||||
MAP can be a list, hash-table or array.
|
||||
Each of MAPS can be an alist, plist, hash-table, or array.
|
||||
See `map-into' for all supported values of TYPE."
|
||||
(let ((result (map-into (pop maps) type))
|
||||
(not-found (cons nil nil)))
|
||||
(not-found (list nil)))
|
||||
(while maps
|
||||
(map-apply (lambda (key value)
|
||||
(cl-callf (lambda (old)
|
||||
(if (eql old not-found)
|
||||
value
|
||||
(funcall function old value)))
|
||||
(map-elt result key not-found)))
|
||||
(pop maps)))
|
||||
(map-do (lambda (key value)
|
||||
(cl-callf (lambda (old)
|
||||
(if (eql old not-found)
|
||||
value
|
||||
(funcall function old value)))
|
||||
(map-elt result key not-found)))
|
||||
(pop maps)))
|
||||
result))
|
||||
|
||||
(cl-defgeneric map-into (map type)
|
||||
"Convert the map MAP into a map of type TYPE.")
|
||||
"Convert MAP into a map of TYPE.")
|
||||
|
||||
;; FIXME: I wish there was a way to avoid this η-redex!
|
||||
(cl-defmethod map-into (map (_type (eql list))) (map-pairs map))
|
||||
(cl-defmethod map-into (map (_type (eql alist))) (map-pairs map))
|
||||
(cl-defmethod map-into (map (_type (eql list)))
|
||||
"Convert MAP into an alist."
|
||||
(map-pairs map))
|
||||
|
||||
(cl-defmethod map-into (map (_type (eql alist)))
|
||||
"Convert MAP into an alist."
|
||||
(map-pairs map))
|
||||
|
||||
(cl-defmethod map-into (map (_type (eql plist)))
|
||||
(let ((plist '()))
|
||||
(map-do (lambda (k v) (setq plist `(,k ,v ,@plist))) map)
|
||||
plist))
|
||||
"Convert MAP into a plist."
|
||||
(let (plist)
|
||||
(map-do (lambda (k v) (setq plist `(,v ,k ,@plist))) map)
|
||||
(nreverse plist)))
|
||||
|
||||
(cl-defgeneric map-put! (map key value &optional testfn)
|
||||
"Associate KEY with VALUE in MAP.
|
||||
If KEY is already present in MAP, replace the associated value
|
||||
with VALUE.
|
||||
This operates by modifying MAP in place.
|
||||
If it cannot do that, it signals the `map-not-inplace' error.
|
||||
If you want to insert an element without modifying MAP, use `map-insert'."
|
||||
If it cannot do that, it signals a `map-not-inplace' error.
|
||||
To insert an element without modifying MAP, use `map-insert'."
|
||||
;; `testfn' only exists for backward compatibility with `map-put'!
|
||||
(declare (advertised-calling-convention (map key value) "27.1"))
|
||||
;; Can't use `cl-defmethod' with `advertised-calling-convention'.
|
||||
(map--dispatch map
|
||||
:list
|
||||
(if (map--plist-p map)
|
||||
|
|
@ -404,18 +442,20 @@ If you want to insert an element without modifying MAP, use `map-insert'."
|
|||
;; and let `map-insert' grow the array?
|
||||
:array (aset map key value)))
|
||||
|
||||
(define-error 'map-inplace "Can only modify map in place")
|
||||
|
||||
(cl-defgeneric map-insert (map key value)
|
||||
"Return a new map like MAP except that it associates KEY with VALUE.
|
||||
This does not modify MAP.
|
||||
If you want to insert an element in place, use `map-put!'."
|
||||
(if (listp map)
|
||||
(if (map--plist-p map)
|
||||
`(,key ,value ,@map)
|
||||
(cons (cons key value) map))
|
||||
;; FIXME: Should we signal an error or use copy+put! ?
|
||||
(signal 'map-inplace (list map))))
|
||||
If you want to insert an element in place, use `map-put!'.
|
||||
The default implementation defaults to `map-copy' and `map-put!'."
|
||||
(let ((copy (map-copy map)))
|
||||
(map-put! copy key value)
|
||||
copy))
|
||||
|
||||
(cl-defmethod map-insert ((map list) key value)
|
||||
"Cons KEY and VALUE to the front of MAP."
|
||||
(if (map--plist-p map)
|
||||
(cons key (cons value map))
|
||||
(cons (cons key value) map)))
|
||||
|
||||
;; There shouldn't be old source code referring to `map--put', yet we do
|
||||
;; need to keep it for backward compatibility with .elc files where the
|
||||
|
|
@ -425,11 +465,9 @@ If you want to insert an element in place, use `map-put!'."
|
|||
(cl-defmethod map-apply (function (map list))
|
||||
(if (map--plist-p map)
|
||||
(cl-call-next-method)
|
||||
(seq-map (lambda (pair)
|
||||
(funcall function
|
||||
(car pair)
|
||||
(cdr pair)))
|
||||
map)))
|
||||
(mapcar (lambda (pair)
|
||||
(funcall function (car pair) (cdr pair)))
|
||||
map)))
|
||||
|
||||
(cl-defmethod map-apply (function (map hash-table))
|
||||
(let (result)
|
||||
|
|
@ -439,46 +477,40 @@ If you want to insert an element in place, use `map-put!'."
|
|||
(nreverse result)))
|
||||
|
||||
(cl-defmethod map-apply (function (map array))
|
||||
(let ((index 0))
|
||||
(seq-map (lambda (elt)
|
||||
(prog1
|
||||
(funcall function index elt)
|
||||
(setq index (1+ index))))
|
||||
map)))
|
||||
(seq-map-indexed (lambda (elt index)
|
||||
(funcall function index elt))
|
||||
map))
|
||||
|
||||
(cl-defmethod map-do (function (map list))
|
||||
"Private function used to iterate over ALIST using FUNCTION."
|
||||
(if (map--plist-p map)
|
||||
(while map
|
||||
(funcall function (pop map) (pop map)))
|
||||
(seq-do (lambda (pair)
|
||||
(funcall function
|
||||
(car pair)
|
||||
(cdr pair)))
|
||||
map)))
|
||||
(mapc (lambda (pair)
|
||||
(funcall function (car pair) (cdr pair)))
|
||||
map)
|
||||
nil))
|
||||
|
||||
(cl-defmethod map-do (function (array array))
|
||||
"Private function used to iterate over ARRAY using FUNCTION."
|
||||
(cl-defmethod map-do (function (map array))
|
||||
(seq-do-indexed (lambda (elt index)
|
||||
(funcall function index elt))
|
||||
array))
|
||||
(funcall function index elt))
|
||||
map))
|
||||
|
||||
(defun map--into-hash (map keyword-args)
|
||||
"Convert MAP into a hash-table.
|
||||
KEYWORD-ARGS are forwarded to `make-hash-table'."
|
||||
(let ((ht (apply #'make-hash-table keyword-args)))
|
||||
(map-apply (lambda (key value)
|
||||
(setf (gethash key ht) value))
|
||||
map)
|
||||
(map-do (lambda (key value)
|
||||
(puthash key value ht))
|
||||
map)
|
||||
ht))
|
||||
|
||||
(cl-defmethod map-into (map (_type (eql hash-table)))
|
||||
"Convert MAP into a hash-table."
|
||||
(map--into-hash map (list :size (map-length map) :test 'equal)))
|
||||
"Convert MAP into a hash-table with keys compared with `equal'."
|
||||
(map--into-hash map (list :size (map-length map) :test #'equal)))
|
||||
|
||||
(cl-defmethod map-into (map (type (head hash-table)))
|
||||
"Convert MAP into a hash-table.
|
||||
TYPE is a list where the car is `hash-table' and the cdr are the
|
||||
TYPE is a list whose car is `hash-table' and cdr a list of
|
||||
keyword-args forwarded to `make-hash-table'.
|
||||
|
||||
Example:
|
||||
|
|
@ -487,23 +519,23 @@ Example:
|
|||
|
||||
(defun map--make-pcase-bindings (args)
|
||||
"Return a list of pcase bindings from ARGS to the elements of a map."
|
||||
(seq-map (lambda (elt)
|
||||
(cond ((consp elt)
|
||||
`(app (pcase--flip map-elt ,(car elt)) ,(cadr elt)))
|
||||
((keywordp elt)
|
||||
(let ((var (intern (substring (symbol-name elt) 1))))
|
||||
`(app (pcase--flip map-elt ,elt) ,var)))
|
||||
(t `(app (pcase--flip map-elt ',elt) ,elt))))
|
||||
args))
|
||||
(mapcar (lambda (elt)
|
||||
(cond ((consp elt)
|
||||
`(app (pcase--flip map-elt ,(car elt)) ,(cadr elt)))
|
||||
((keywordp elt)
|
||||
(let ((var (intern (substring (symbol-name elt) 1))))
|
||||
`(app (pcase--flip map-elt ,elt) ,var)))
|
||||
(t `(app (pcase--flip map-elt ',elt) ,elt))))
|
||||
args))
|
||||
|
||||
(defun map--make-pcase-patterns (args)
|
||||
"Return a list of `(map ...)' pcase patterns built from ARGS."
|
||||
(cons 'map
|
||||
(seq-map (lambda (elt)
|
||||
(if (and (consp elt) (eq 'map (car elt)))
|
||||
(map--make-pcase-patterns elt)
|
||||
elt))
|
||||
args)))
|
||||
(mapcar (lambda (elt)
|
||||
(if (eq (car-safe elt) 'map)
|
||||
(map--make-pcase-patterns elt)
|
||||
elt))
|
||||
args)))
|
||||
|
||||
(provide 'map)
|
||||
;;; map.el ends here
|
||||
|
|
|
|||
|
|
@ -134,9 +134,10 @@ Unlike `seq-map', FUNCTION takes two arguments: the element of
|
|||
the sequence, and its index within the sequence."
|
||||
(let ((index 0))
|
||||
(seq-do (lambda (elt)
|
||||
(funcall function elt index)
|
||||
(setq index (1+ index)))
|
||||
sequence)))
|
||||
(funcall function elt index)
|
||||
(setq index (1+ index)))
|
||||
sequence))
|
||||
nil)
|
||||
|
||||
(cl-defgeneric seqp (object)
|
||||
"Return non-nil if OBJECT is a sequence, nil otherwise."
|
||||
|
|
|
|||
|
|
@ -22,7 +22,7 @@
|
|||
|
||||
;;; Commentary:
|
||||
|
||||
;; Tests for map.el
|
||||
;; Tests for map.el.
|
||||
|
||||
;;; Code:
|
||||
|
||||
|
|
@ -30,12 +30,10 @@
|
|||
(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)"
|
||||
\\='((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"))
|
||||
|
|
@ -53,43 +51,62 @@ Evaluate BODY for each created map.
|
|||
(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))))
|
||||
(should (map-elt map noneq-key nil #'equal))))
|
||||
|
||||
(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! ()
|
||||
(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)))
|
||||
(with-maps-do map
|
||||
(map-put! map 2 'hello)
|
||||
(should (eq (map-elt map 2) 'hello))
|
||||
(if (not (or (hash-table-p map)
|
||||
(and (listp map) (not (listp (car map)))))) ;plist!
|
||||
(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.
|
||||
|
|
@ -97,49 +114,88 @@ Evaluate BODY for each created map.
|
|||
'map-not-inplace
|
||||
'error))
|
||||
(map-put! map 5 'value)
|
||||
(should (eq (map-elt map 5) 'value))))
|
||||
(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))))
|
||||
(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-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 #'eql)
|
||||
(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)))))
|
||||
(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-return-value ()
|
||||
(let ((ht (make-hash-table)))
|
||||
(should (eq (map-delete ht 'a) ht))))
|
||||
(ert-deftest test-map-delete-empty ()
|
||||
(with-empty-maps-do map
|
||||
(should (eq map (map-delete map t)))))
|
||||
|
||||
(ert-deftest test-map-nested-elt ()
|
||||
(let ((vec [a b [c d [e f]]]))
|
||||
|
|
@ -149,8 +205,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))
|
||||
|
|
@ -160,214 +217,238 @@ 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)
|
||||
(push (list (int-to-string k) v) result))
|
||||
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)))
|
||||
(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 (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 (eq (hash-table-test ht2) 'equal))
|
||||
(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 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 (map-merge 'list '(a 1) '((b . 2) (c . 3))
|
||||
#s(hash-table data (c 4)))
|
||||
'((c . 4) (b . 2) (a . 1)))))
|
||||
|
||||
(ert-deftest test-map-merge-with ()
|
||||
(should (equal (map-merge-with 'list #'+
|
||||
|
|
@ -376,6 +457,19 @@ Evaluate BODY for each created map.
|
|||
'((1 . 1) (2 . 5) (3 . 0)))
|
||||
'((3 . 0) (2 . 9) (1 . 6)))))
|
||||
|
||||
(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))
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue