Merge branch 'map'
This commit is contained in:
commit
d4aca72ead
3 changed files with 709 additions and 0 deletions
5
etc/NEWS
5
etc/NEWS
|
@ -487,6 +487,11 @@ The seq library adds sequence manipulation functions and macros that
|
|||
complement basic functions provided by subr.el. All functions are
|
||||
prefixed with `seq-' and work on lists, strings and vectors.
|
||||
|
||||
** map
|
||||
*** New map library:
|
||||
The map library provides map-manipulation functions that work on alists,
|
||||
hash-table and arrays. All functions are prefixed with "map-".
|
||||
|
||||
** Calendar and diary
|
||||
|
||||
+++
|
||||
|
|
371
lisp/emacs-lisp/map.el
Normal file
371
lisp/emacs-lisp/map.el
Normal file
|
@ -0,0 +1,371 @@
|
|||
;;; map.el --- Map manipulation functions -*- lexical-binding: t; -*-
|
||||
|
||||
;; Copyright (C) 2015 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Nicolas Petton <nicolas@petton.fr>
|
||||
;; Keywords: convenience, map, hash-table, alist, array
|
||||
;; Version: 1.0
|
||||
;; Package: map
|
||||
|
||||
;; Maintainer: emacs-devel@gnu.org
|
||||
|
||||
;; This file is part of GNU Emacs.
|
||||
|
||||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; map.el provides map-manipulation functions that work on alists,
|
||||
;; hash-table 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
|
||||
;; functions take the map as their first argument.
|
||||
|
||||
;; TODO:
|
||||
;; - Add support for char-tables
|
||||
;; - Maybe add support for gv?
|
||||
;; - See if we can integrate text-properties
|
||||
;; - A macro similar to let-alist but working on any type of map could
|
||||
;; be really useful
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'seq)
|
||||
|
||||
(pcase-defmacro map (&rest args)
|
||||
"pcase pattern matching map elements.
|
||||
Matches if the object is a map (list, hash-table or array), and
|
||||
binds values from ARGS to the corresponding element of the map.
|
||||
|
||||
ARGS can be a list elements of the form (KEY . PAT) or elements
|
||||
of the form SYMBOL, which stands for (SYMBOL . SYMBOL)."
|
||||
`(and (pred map-p)
|
||||
,@(map--make-pcase-bindings args)))
|
||||
|
||||
(defmacro map-let (args map &rest body)
|
||||
"Bind the variables in ARGS to the elements of MAP then evaluate BODY.
|
||||
|
||||
ARGS can be an alist of key/binding pairs or a list of keys. MAP
|
||||
can be a list, hash-table or array."
|
||||
(declare (indent 2) (debug t))
|
||||
`(pcase-let ((,(map--make-pcase-patterns args) ,map))
|
||||
,@body))
|
||||
|
||||
(defun map-elt (map key &optional default)
|
||||
"Perform a lookup in MAP of KEY and return its associated value.
|
||||
If KEY is not found, return DEFAULT which defaults to nil.
|
||||
|
||||
If MAP is a list, `equal' is used to lookup KEY.
|
||||
|
||||
MAP can be a list, hash-table or array."
|
||||
(map--dispatch map
|
||||
:list (map--elt-list map key default)
|
||||
:hash-table (gethash key map default)
|
||||
:array (map--elt-array map key default)))
|
||||
|
||||
(defmacro map-put (map key value)
|
||||
"In MAP, associate KEY with VALUE and return MAP.
|
||||
If KEY is already present in MAP, replace the associated value
|
||||
with VALUE.
|
||||
|
||||
MAP can be a list, hash-table or array."
|
||||
(declare (debug t))
|
||||
`(progn
|
||||
(map--dispatch (m ,map m)
|
||||
:list (setq ,map (cons (cons ,key ,value) m))
|
||||
:hash-table (puthash ,key ,value m)
|
||||
:array (aset m ,key ,value))))
|
||||
|
||||
(defmacro map-delete (map key)
|
||||
"In MAP, delete the key KEY if present and return MAP.
|
||||
If MAP is an array, store nil at the index KEY.
|
||||
|
||||
MAP can be a list, hash-table or array."
|
||||
(declare (debug t))
|
||||
`(progn
|
||||
(map--dispatch (m ,map m)
|
||||
:list (setq ,map (map--delete-alist m ,key))
|
||||
:hash-table (remhash ,key m)
|
||||
:array (map--delete-array m ,key))))
|
||||
|
||||
(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."
|
||||
(or (seq-reduce (lambda (acc key)
|
||||
(when (map-p acc)
|
||||
(map-elt acc key)))
|
||||
keys
|
||||
map)
|
||||
default))
|
||||
|
||||
(defun map-keys (map)
|
||||
"Return the list of keys in MAP.
|
||||
|
||||
MAP can be a list, hash-table or array."
|
||||
(map-apply (lambda (key _) key) map))
|
||||
|
||||
(defun map-values (map)
|
||||
"Return the list of values in MAP.
|
||||
|
||||
MAP can be a list, hash-table or array."
|
||||
(map-apply (lambda (_ value) value) map))
|
||||
|
||||
(defun map-pairs (map)
|
||||
"Return the elements of MAP as key/value association lists.
|
||||
|
||||
MAP can be a list, hash-table or array."
|
||||
(map-apply #'cons map))
|
||||
|
||||
(defun map-length (map)
|
||||
"Return the length of MAP.
|
||||
|
||||
MAP can be a list, hash-table or array."
|
||||
(length (map-keys map)))
|
||||
|
||||
(defun map-copy (map)
|
||||
"Return a copy of MAP.
|
||||
|
||||
MAP can be a list, hash-table or array."
|
||||
(map--dispatch map
|
||||
:list (seq-copy map)
|
||||
:hash-table (copy-hash-table map)
|
||||
:array (seq-copy map)))
|
||||
|
||||
(defun map-apply (function map)
|
||||
"Apply FUNCTION to each element of MAP and return the result as a list.
|
||||
FUNCTION is called with two arguments, the key and the value.
|
||||
|
||||
MAP can be a list, hash-table or array."
|
||||
(funcall (map--dispatch map
|
||||
:list #'map--apply-alist
|
||||
:hash-table #'map--apply-hash-table
|
||||
:array #'map--apply-array)
|
||||
function
|
||||
map))
|
||||
|
||||
(defun map-keys-apply (function map)
|
||||
"Return the result of applying FUNCTION to each key of MAP.
|
||||
|
||||
MAP can be a list, hash-table or array."
|
||||
(map-apply (lambda (key _)
|
||||
(funcall function key))
|
||||
map))
|
||||
|
||||
(defun map-values-apply (function map)
|
||||
"Return the result of applying FUNCTION to each value of MAP.
|
||||
|
||||
MAP can be a list, hash-table or array."
|
||||
(map-apply (lambda (_ val)
|
||||
(funcall function val))
|
||||
map))
|
||||
|
||||
(defun map-filter (pred map)
|
||||
"Return an alist of the key/val pairs for which (PRED key val) is non-nil in MAP.
|
||||
|
||||
MAP can be a list, hash-table or array."
|
||||
(delq nil (map-apply (lambda (key val)
|
||||
(if (funcall pred key val)
|
||||
(cons key val)
|
||||
nil))
|
||||
map)))
|
||||
|
||||
(defun map-remove (pred map)
|
||||
"Return an alist of the key/val pairs for which (PRED key val) is nil in MAP.
|
||||
|
||||
MAP can be a list, hash-table or array."
|
||||
(map-filter (lambda (key val) (not (funcall pred key val)))
|
||||
map))
|
||||
|
||||
(defun map-p (map)
|
||||
"Return non-nil if MAP is a map (list, hash-table or array)."
|
||||
(or (listp map)
|
||||
(hash-table-p map)
|
||||
(arrayp map)))
|
||||
|
||||
(defun map-empty-p (map)
|
||||
"Return non-nil is MAP is empty.
|
||||
|
||||
MAP can be a list, hash-table or array."
|
||||
(map--dispatch map
|
||||
:list (null map)
|
||||
:array (seq-empty-p map)
|
||||
:hash-table (zerop (hash-table-count map))))
|
||||
|
||||
(defun map-contains-key-p (map key &optional testfn)
|
||||
"Return non-nil if MAP contain the key KEY, nil otherwise.
|
||||
Equality is defined by TESTFN if non-nil or by `equal' if nil.
|
||||
|
||||
MAP can be a list, hash-table or array."
|
||||
(seq-contains-p (map-keys map) key testfn))
|
||||
|
||||
(defun map-some-p (pred map)
|
||||
"Return a key/value pair for which (PRED key val) is non-nil in MAP.
|
||||
|
||||
MAP can be a list, hash-table or array."
|
||||
(catch 'map--break
|
||||
(map-apply (lambda (key value)
|
||||
(when (funcall pred key value)
|
||||
(throw 'map--break (cons key value))))
|
||||
map)
|
||||
nil))
|
||||
|
||||
(defun map-every-p (pred map)
|
||||
"Return non-nil if (PRED key val) is non-nil for all elements of the map MAP.
|
||||
|
||||
MAP can be a list, hash-table or array."
|
||||
(catch 'map--break
|
||||
(map-apply (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 the maps MAPS.
|
||||
|
||||
MAP can be a list, hash-table or array."
|
||||
(let (result)
|
||||
(while maps
|
||||
(map-apply (lambda (key value)
|
||||
(map-put result key value))
|
||||
(pop maps)))
|
||||
(map-into result type)))
|
||||
|
||||
(defun map-into (map type)
|
||||
"Convert the map MAP into a map of type TYPE.
|
||||
|
||||
TYPE can be one of the following symbols: list or hash-table.
|
||||
MAP can be a list, hash-table or array."
|
||||
(pcase type
|
||||
(`list (map-pairs map))
|
||||
(`hash-table (map--into-hash-table map))
|
||||
(t (error "Not a map type name: %S" type))))
|
||||
|
||||
(defmacro map--dispatch (spec &rest args)
|
||||
"Evaluate one of the provided forms depending on the type of MAP.
|
||||
|
||||
SPEC can be a map or a list of the form (VAR MAP [RESULT]).
|
||||
ARGS should have the form [TYPE FORM]...
|
||||
|
||||
The following keyword types are meaningful: `:list',
|
||||
`:hash-table' and `array'.
|
||||
|
||||
An error is thrown if MAP is neither a list, hash-table nor array.
|
||||
|
||||
Return RESULT if non-nil or the result of evaluation of the
|
||||
form.
|
||||
|
||||
\(fn (VAR MAP [RESULT]) &rest ARGS)"
|
||||
(declare (debug t) (indent 1))
|
||||
(unless (listp spec)
|
||||
(setq spec `(,spec ,spec)))
|
||||
(let ((map-var (car spec))
|
||||
(result-var (make-symbol "result")))
|
||||
`(let ((,map-var ,(cadr spec))
|
||||
,result-var)
|
||||
(setq ,result-var
|
||||
(cond ((listp ,map-var) ,(plist-get args :list))
|
||||
((hash-table-p ,map-var) ,(plist-get args :hash-table))
|
||||
((arrayp ,map-var) ,(plist-get args :array))
|
||||
(t (error "Unsupported map: %s" ,map-var))))
|
||||
,@(when (cddr spec)
|
||||
`((setq ,result-var ,@(cddr spec))))
|
||||
,result-var)))
|
||||
|
||||
(defun map--apply-alist (function map)
|
||||
"Private function used to apply FUNCTION over MAP, MAP being an alist."
|
||||
(seq-map (lambda (pair)
|
||||
(funcall function
|
||||
(car pair)
|
||||
(cdr pair)))
|
||||
map))
|
||||
|
||||
(defun map--apply-hash-table (function map)
|
||||
"Private function used to apply FUNCTION over MAP, MAP being a hash-table."
|
||||
(let (result)
|
||||
(maphash (lambda (key value)
|
||||
(push (funcall function key value) result))
|
||||
map)
|
||||
(nreverse result)))
|
||||
|
||||
(defun map--apply-array (function map)
|
||||
"Private function used to apply FUNCTION over MAP, MAP being an array."
|
||||
(let ((index 0))
|
||||
(seq-map (lambda (elt)
|
||||
(prog1
|
||||
(funcall function index elt)
|
||||
(setq index (1+ index))))
|
||||
map)))
|
||||
|
||||
(defun map--elt-list (map key &optional default)
|
||||
"Lookup, in the list MAP, the value associated with KEY and return it.
|
||||
If KEY is not found, return DEFAULT which defaults to nil."
|
||||
(let ((pair (assoc key map)))
|
||||
(if pair
|
||||
(cdr pair)
|
||||
default)))
|
||||
|
||||
(defun map--elt-array (map key &optional default)
|
||||
"Return the element of the array MAP at the index KEY.
|
||||
If KEY is not found, return DEFAULT which defaults to nil."
|
||||
(let ((len (seq-length map)))
|
||||
(or (and (>= key 0)
|
||||
(<= key len)
|
||||
(seq-elt map key))
|
||||
default)))
|
||||
|
||||
(defun map--delete-alist (map key)
|
||||
"Return MAP with KEY removed."
|
||||
(seq-remove (lambda (pair)
|
||||
(equal key (car pair)))
|
||||
map))
|
||||
|
||||
(defun map--delete-array (map key)
|
||||
"Set nil in the array MAP at the index KEY if present and return MAP."
|
||||
(let ((len (seq-length map)))
|
||||
(and (>= key 0)
|
||||
(<= key len)
|
||||
(aset m key nil)))
|
||||
map)
|
||||
|
||||
(defun map--into-hash-table (map)
|
||||
"Convert MAP into a hash-table."
|
||||
(let ((ht (make-hash-table :size (map-length map)
|
||||
:test 'equal)))
|
||||
(map-apply (lambda (key value)
|
||||
(map-put ht key value))
|
||||
map)
|
||||
ht))
|
||||
|
||||
(defun map--make-pcase-bindings (args)
|
||||
"Return a list of pcase bindings from ARGS to the elements of a map."
|
||||
(seq-map (lambda (elt)
|
||||
(if (consp elt)
|
||||
`(app (pcase--flip map-elt ',(car elt)) ,(cdr elt))
|
||||
`(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)))
|
||||
|
||||
(provide 'map)
|
||||
;;; map.el ends here
|
333
test/automated/map-tests.el
Normal file
333
test/automated/map-tests.el
Normal file
|
@ -0,0 +1,333 @@
|
|||
;;; map-tests.el --- Tests for map.el
|
||||
|
||||
;; Copyright (C) 2015 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Nicolas Petton <nicolas@petton.fr>
|
||||
;; Maintainer: emacs-devel@gnu.org
|
||||
|
||||
;; This file is part of GNU Emacs.
|
||||
|
||||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; Tests for map.el
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'ert)
|
||||
(require 'map)
|
||||
|
||||
(defmacro with-maps-do (var &rest body)
|
||||
"Successively bind VAR to an alist, 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))
|
||||
(let ((alist (make-symbol "alist"))
|
||||
(vec (make-symbol "vec"))
|
||||
(ht (make-symbol "ht")))
|
||||
`(let ((,alist '((0 . 3)
|
||||
(1 . 4)
|
||||
(2 . 5)))
|
||||
(,vec (make-vector 3 nil))
|
||||
(,ht (make-hash-table)))
|
||||
(aset ,vec 0 '3)
|
||||
(aset ,vec 1 '4)
|
||||
(aset ,vec 2 '5)
|
||||
(puthash '0 3 ,ht)
|
||||
(puthash '1 4 ,ht)
|
||||
(puthash '2 5 ,ht)
|
||||
(dolist (,var (list ,alist ,vec ,ht))
|
||||
,@body))))
|
||||
|
||||
(ert-deftest test-map-elt ()
|
||||
(with-maps-do map
|
||||
(assert (= 3 (map-elt map 0)))
|
||||
(assert (= 4 (map-elt map 1)))
|
||||
(assert (= 5 (map-elt map 2)))
|
||||
(assert (null (map-elt map -1)))
|
||||
(assert (null (map-elt map 4)))))
|
||||
|
||||
(ert-deftest test-map-elt-default ()
|
||||
(with-maps-do map
|
||||
(assert (= 5 (map-elt map 7 5)))))
|
||||
|
||||
(ert-deftest test-map-elt-with-nil-value ()
|
||||
(assert (null (map-elt '((a . 1)
|
||||
(b))
|
||||
'b
|
||||
'2))))
|
||||
|
||||
(ert-deftest test-map-put ()
|
||||
(with-maps-do map
|
||||
(map-put map 2 'hello)
|
||||
(assert (eq (map-elt map 2) 'hello)))
|
||||
(let ((ht (make-hash-table)))
|
||||
(map-put ht 2 'a)
|
||||
(assert (eq (map-elt ht 2)
|
||||
'a)))
|
||||
(let ((alist '((0 . a) (1 . b) (2 . c))))
|
||||
(map-put alist 2 'a)
|
||||
(assert (eq (map-elt alist 2)
|
||||
'a)))
|
||||
(let ((vec [3 4 5]))
|
||||
(should-error (map-put vec 3 6))))
|
||||
|
||||
(ert-deftest test-map-put-literal ()
|
||||
(assert (= (map-elt (map-put [1 2 3] 1 4) 1)
|
||||
4))
|
||||
(assert (= (map-elt (map-put (make-hash-table) 'a 2) 'a)
|
||||
2))
|
||||
(should-error (map-put '((a . 1)) 'b 2))
|
||||
(should-error (map-put '() 'a 1)))
|
||||
|
||||
(ert-deftest test-map-put-return-value ()
|
||||
(let ((ht (make-hash-table)))
|
||||
(assert (eq (map-put ht 'a 'hello) ht))))
|
||||
|
||||
(ert-deftest test-map-delete ()
|
||||
(with-maps-do map
|
||||
(map-delete map 1)
|
||||
(assert (null (map-elt map 1))))
|
||||
(with-maps-do map
|
||||
(map-delete map -2)
|
||||
(assert (null (map-elt map -2)))))
|
||||
|
||||
(ert-deftest test-map-delete-return-value ()
|
||||
(let ((ht (make-hash-table)))
|
||||
(assert (eq (map-delete ht 'a) ht))))
|
||||
|
||||
(ert-deftest test-map-nested-elt ()
|
||||
(let ((vec [a b [c d [e f]]]))
|
||||
(assert (eq (map-nested-elt vec '(2 2 0)) 'e)))
|
||||
(let ((alist '((a . 1)
|
||||
(b . ((c . 2)
|
||||
(d . 3)
|
||||
(e . ((f . 4)
|
||||
(g . 5))))))))
|
||||
(assert (eq (map-nested-elt alist '(b e f))
|
||||
4)))
|
||||
(let ((ht (make-hash-table)))
|
||||
(map-put ht 'a 1)
|
||||
(map-put ht 'b (make-hash-table))
|
||||
(map-put (map-elt ht 'b) 'c 2)
|
||||
(assert (eq (map-nested-elt ht '(b c))
|
||||
2))))
|
||||
|
||||
(ert-deftest test-map-nested-elt-default ()
|
||||
(let ((vec [a b [c d]]))
|
||||
(assert (null (map-nested-elt vec '(2 3))))
|
||||
(assert (null (map-nested-elt vec '(2 1 1))))
|
||||
(assert (= 4 (map-nested-elt vec '(2 1 1) 4)))))
|
||||
|
||||
(ert-deftest test-map-p ()
|
||||
(assert (map-p nil))
|
||||
(assert (map-p '((a . b) (c . d))))
|
||||
(assert (map-p '(a b c d)))
|
||||
(assert (map-p []))
|
||||
(assert (map-p [1 2 3]))
|
||||
(assert (map-p (make-hash-table)))
|
||||
(assert (map-p "hello"))
|
||||
(assert (not (map-p 1)))
|
||||
(assert (not (map-p 'hello))))
|
||||
|
||||
(ert-deftest test-map-keys ()
|
||||
(with-maps-do map
|
||||
(assert (equal (map-keys map) '(0 1 2))))
|
||||
(assert (null (map-keys nil)))
|
||||
(assert (null (map-keys []))))
|
||||
|
||||
(ert-deftest test-map-values ()
|
||||
(with-maps-do map
|
||||
(assert (equal (map-values map) '(3 4 5)))))
|
||||
|
||||
(ert-deftest test-map-pairs ()
|
||||
(with-maps-do map
|
||||
(assert (equal (map-pairs map) '((0 . 3)
|
||||
(1 . 4)
|
||||
(2 . 5))))))
|
||||
|
||||
(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)
|
||||
(assert (= 0 (map-length nil)))
|
||||
(assert (= 0 (map-length [])))
|
||||
(assert (= 0 (map-length (make-hash-table))))
|
||||
(assert (= 5 (map-length [0 1 2 3 4])))
|
||||
(assert (= 2 (map-length '((a . 1) (b . 2)))))
|
||||
(assert (= 4 (map-length ht)))))
|
||||
|
||||
(ert-deftest test-map-copy ()
|
||||
(with-maps-do map
|
||||
(let ((copy (map-copy map)))
|
||||
(assert (equal (map-keys map) (map-keys copy)))
|
||||
(assert (equal (map-values map) (map-values copy)))
|
||||
(assert (not (eq map copy))))))
|
||||
|
||||
(ert-deftest test-map-apply ()
|
||||
(with-maps-do map
|
||||
(assert (equal (map-apply (lambda (k v) (cons (int-to-string k) v))
|
||||
map)
|
||||
'(("0" . 3) ("1" . 4) ("2" . 5)))))
|
||||
(let ((vec [a b c]))
|
||||
(assert (equal (map-apply (lambda (k v) (cons (1+ k) v))
|
||||
vec)
|
||||
'((1 . a)
|
||||
(2 . b)
|
||||
(3 . c))))))
|
||||
|
||||
(ert-deftest test-map-keys-apply ()
|
||||
(with-maps-do map
|
||||
(assert (equal (map-keys-apply (lambda (k) (int-to-string k))
|
||||
map)
|
||||
'("0" "1" "2"))))
|
||||
(let ((vec [a b c]))
|
||||
(assert (equal (map-keys-apply (lambda (k) (1+ k))
|
||||
vec)
|
||||
'(1 2 3)))))
|
||||
|
||||
(ert-deftest test-map-values-apply ()
|
||||
(with-maps-do map
|
||||
(assert (equal (map-values-apply (lambda (v) (1+ v))
|
||||
map)
|
||||
'(4 5 6))))
|
||||
(let ((vec [a b c]))
|
||||
(assert (equal (map-values-apply (lambda (v) (symbol-name v))
|
||||
vec)
|
||||
'("a" "b" "c")))))
|
||||
|
||||
(ert-deftest test-map-filter ()
|
||||
(with-maps-do map
|
||||
(assert (equal (map-keys (map-filter (lambda (k v)
|
||||
(<= 4 v))
|
||||
map))
|
||||
'(1 2)))
|
||||
(assert (null (map-filter (lambda (k v)
|
||||
(eq 'd k))
|
||||
map))))
|
||||
(assert (null (map-filter (lambda (k v)
|
||||
(eq 3 v))
|
||||
[1 2 4 5])))
|
||||
(assert (equal (map-filter (lambda (k v)
|
||||
(eq 3 k))
|
||||
[1 2 4 5])
|
||||
'((3 . 5)))))
|
||||
|
||||
(ert-deftest test-map-remove ()
|
||||
(with-maps-do map
|
||||
(assert (equal (map-keys (map-remove (lambda (k v)
|
||||
(>= v 4))
|
||||
map))
|
||||
'(0)))
|
||||
(assert (equal (map-keys (map-remove (lambda (k v)
|
||||
(eq 'd k))
|
||||
map))
|
||||
(map-keys map))))
|
||||
(assert (equal (map-remove (lambda (k v)
|
||||
(eq 3 v))
|
||||
[1 2 4 5])
|
||||
'((0 . 1)
|
||||
(1 . 2)
|
||||
(2 . 4)
|
||||
(3 . 5))))
|
||||
(assert (null (map-remove (lambda (k v)
|
||||
(>= k 0))
|
||||
[1 2 4 5]))))
|
||||
|
||||
(ert-deftest test-map-empty-p ()
|
||||
(assert (map-empty-p nil))
|
||||
(assert (not (map-empty-p '((a . b) (c . d)))))
|
||||
(assert (map-empty-p []))
|
||||
(assert (not (map-empty-p [1 2 3])))
|
||||
(assert (map-empty-p (make-hash-table)))
|
||||
(assert (not (map-empty-p "hello")))
|
||||
(assert (map-empty-p "")))
|
||||
|
||||
(ert-deftest test-map-contains-key-p ()
|
||||
(assert (map-contains-key-p '((a . 1) (b . 2)) 'a))
|
||||
(assert (not (map-contains-key-p '((a . 1) (b . 2)) 'c)))
|
||||
(assert (map-contains-key-p '(("a" . 1)) "a"))
|
||||
(assert (not (map-contains-key-p '(("a" . 1)) "a" #'eq)))
|
||||
(assert (map-contains-key-p [a b c] 2))
|
||||
(assert (not (map-contains-key-p [a b c] 3))))
|
||||
|
||||
(ert-deftest test-map-some-p ()
|
||||
(with-maps-do map
|
||||
(assert (equal (map-some-p (lambda (k v)
|
||||
(eq 1 k))
|
||||
map)
|
||||
(cons 1 4)))
|
||||
(assert (not (map-some-p (lambda (k v)
|
||||
(eq 'd k))
|
||||
map))))
|
||||
(let ((vec [a b c]))
|
||||
(assert (equal (map-some-p (lambda (k v)
|
||||
(> k 1))
|
||||
vec)
|
||||
(cons 2 'c)))
|
||||
(assert (not (map-some-p (lambda (k v)
|
||||
(> k 3))
|
||||
vec)))))
|
||||
|
||||
(ert-deftest test-map-every-p ()
|
||||
(with-maps-do map
|
||||
(assert (map-every-p (lambda (k v)
|
||||
k)
|
||||
map))
|
||||
(assert (not (map-every-p (lambda (k v)
|
||||
nil)
|
||||
map))))
|
||||
(let ((vec [a b c]))
|
||||
(assert (map-every-p (lambda (k v)
|
||||
(>= k 0))
|
||||
vec))
|
||||
(assert (not (map-every-p (lambda (k v)
|
||||
(> k 3))
|
||||
vec)))))
|
||||
|
||||
(ert-deftest test-map-into ()
|
||||
(let* ((alist '((a . 1) (b . 2)))
|
||||
(ht (map-into alist 'hash-table)))
|
||||
(assert (hash-table-p ht))
|
||||
(assert (equal (map-into (map-into alist 'hash-table) 'list)
|
||||
alist))
|
||||
(assert (listp (map-into ht 'list)))
|
||||
(assert (equal (map-keys (map-into (map-into ht 'list) 'hash-table))
|
||||
(map-keys ht)))
|
||||
(assert (equal (map-values (map-into (map-into ht 'list) 'hash-table))
|
||||
(map-values ht)))
|
||||
(assert (null (map-into nil 'list)))
|
||||
(assert (map-empty-p (map-into nil 'hash-table)))
|
||||
(should-error (map-into [1 2 3] 'string))))
|
||||
|
||||
(ert-deftest test-map-let ()
|
||||
(map-let (foo bar baz) '((foo . 1) (bar . 2))
|
||||
(assert (= foo 1))
|
||||
(assert (= bar 2))
|
||||
(assert (null baz)))
|
||||
(map-let ((foo . a)
|
||||
(bar . b)
|
||||
(baz . c)) '((foo . 1) (bar . 2))
|
||||
(assert (= a 1))
|
||||
(assert (= b 2))
|
||||
(assert (null c))))
|
||||
|
||||
(provide 'map-tests)
|
||||
;;; map-tests.el ends here
|
Loading…
Add table
Reference in a new issue