diff options
| author | Nicolas Petton | 2015-06-04 22:30:29 +0200 |
|---|---|---|
| committer | Nicolas Petton | 2015-06-04 22:30:29 +0200 |
| commit | d4aca72ead4c1e53819e6e3249e26400a9879a0e (patch) | |
| tree | b09c942883cac4e13e4ea883974d3ea8c577a8b2 | |
| parent | 015c89a912f2486ec9ea24968705a84fe7d6fd06 (diff) | |
| parent | cfb35800a8765b3458751bd6992a348f97843894 (diff) | |
| download | emacs-d4aca72ead4c1e53819e6e3249e26400a9879a0e.tar.gz emacs-d4aca72ead4c1e53819e6e3249e26400a9879a0e.zip | |
Merge branch 'map'
| -rw-r--r-- | etc/NEWS | 5 | ||||
| -rw-r--r-- | lisp/emacs-lisp/map.el | 371 | ||||
| -rw-r--r-- | test/automated/map-tests.el | 333 |
3 files changed, 709 insertions, 0 deletions
| @@ -487,6 +487,11 @@ The seq library adds sequence manipulation functions and macros that | |||
| 487 | complement basic functions provided by subr.el. All functions are | 487 | complement basic functions provided by subr.el. All functions are |
| 488 | prefixed with `seq-' and work on lists, strings and vectors. | 488 | prefixed with `seq-' and work on lists, strings and vectors. |
| 489 | 489 | ||
| 490 | ** map | ||
| 491 | *** New map library: | ||
| 492 | The map library provides map-manipulation functions that work on alists, | ||
| 493 | hash-table and arrays. All functions are prefixed with "map-". | ||
| 494 | |||
| 490 | ** Calendar and diary | 495 | ** Calendar and diary |
| 491 | 496 | ||
| 492 | +++ | 497 | +++ |
diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el new file mode 100644 index 00000000000..46c795840b0 --- /dev/null +++ b/lisp/emacs-lisp/map.el | |||
| @@ -0,0 +1,371 @@ | |||
| 1 | ;;; map.el --- Map manipulation functions -*- lexical-binding: t; -*- | ||
| 2 | |||
| 3 | ;; Copyright (C) 2015 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Author: Nicolas Petton <nicolas@petton.fr> | ||
| 6 | ;; Keywords: convenience, map, hash-table, alist, array | ||
| 7 | ;; Version: 1.0 | ||
| 8 | ;; Package: map | ||
| 9 | |||
| 10 | ;; Maintainer: emacs-devel@gnu.org | ||
| 11 | |||
| 12 | ;; This file is part of GNU Emacs. | ||
| 13 | |||
| 14 | ;; GNU Emacs is free software: you can redistribute it and/or modify | ||
| 15 | ;; it under the terms of the GNU General Public License as published by | ||
| 16 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 17 | ;; (at your option) any later version. | ||
| 18 | |||
| 19 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 20 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 21 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 22 | ;; GNU General Public License for more details. | ||
| 23 | |||
| 24 | ;; You should have received a copy of the GNU General Public License | ||
| 25 | ;; along with this program. If not, see <http://www.gnu.org/licenses/>. | ||
| 26 | |||
| 27 | ;;; Commentary: | ||
| 28 | |||
| 29 | ;; map.el provides map-manipulation functions that work on alists, | ||
| 30 | ;; hash-table and arrays. All functions are prefixed with "map-". | ||
| 31 | ;; | ||
| 32 | ;; Functions taking a predicate or iterating over a map using a | ||
| 33 | ;; function take the function as their first argument. All other | ||
| 34 | ;; functions take the map as their first argument. | ||
| 35 | |||
| 36 | ;; TODO: | ||
| 37 | ;; - Add support for char-tables | ||
| 38 | ;; - Maybe add support for gv? | ||
| 39 | ;; - See if we can integrate text-properties | ||
| 40 | ;; - A macro similar to let-alist but working on any type of map could | ||
| 41 | ;; be really useful | ||
| 42 | |||
| 43 | ;;; Code: | ||
| 44 | |||
| 45 | (require 'seq) | ||
| 46 | |||
| 47 | (pcase-defmacro map (&rest args) | ||
| 48 | "pcase pattern matching map elements. | ||
| 49 | Matches if the object is a map (list, hash-table or array), and | ||
| 50 | binds values from ARGS to the corresponding element of the map. | ||
| 51 | |||
| 52 | ARGS can be a list elements of the form (KEY . PAT) or elements | ||
| 53 | of the form SYMBOL, which stands for (SYMBOL . SYMBOL)." | ||
| 54 | `(and (pred map-p) | ||
| 55 | ,@(map--make-pcase-bindings args))) | ||
| 56 | |||
| 57 | (defmacro map-let (args map &rest body) | ||
| 58 | "Bind the variables in ARGS to the elements of MAP then evaluate BODY. | ||
| 59 | |||
| 60 | ARGS can be an alist of key/binding pairs or a list of keys. MAP | ||
| 61 | can be a list, hash-table or array." | ||
| 62 | (declare (indent 2) (debug t)) | ||
| 63 | `(pcase-let ((,(map--make-pcase-patterns args) ,map)) | ||
| 64 | ,@body)) | ||
| 65 | |||
| 66 | (defun map-elt (map key &optional default) | ||
| 67 | "Perform a lookup in MAP of KEY and return its associated value. | ||
| 68 | If KEY is not found, return DEFAULT which defaults to nil. | ||
| 69 | |||
| 70 | If MAP is a list, `equal' is used to lookup KEY. | ||
| 71 | |||
| 72 | MAP can be a list, hash-table or array." | ||
| 73 | (map--dispatch map | ||
| 74 | :list (map--elt-list map key default) | ||
| 75 | :hash-table (gethash key map default) | ||
| 76 | :array (map--elt-array map key default))) | ||
| 77 | |||
| 78 | (defmacro map-put (map key value) | ||
| 79 | "In MAP, associate KEY with VALUE and return MAP. | ||
| 80 | If KEY is already present in MAP, replace the associated value | ||
| 81 | with VALUE. | ||
| 82 | |||
| 83 | MAP can be a list, hash-table or array." | ||
| 84 | (declare (debug t)) | ||
| 85 | `(progn | ||
| 86 | (map--dispatch (m ,map m) | ||
| 87 | :list (setq ,map (cons (cons ,key ,value) m)) | ||
| 88 | :hash-table (puthash ,key ,value m) | ||
| 89 | :array (aset m ,key ,value)))) | ||
| 90 | |||
| 91 | (defmacro map-delete (map key) | ||
| 92 | "In MAP, delete the key KEY if present and return MAP. | ||
| 93 | If MAP is an array, store nil at the index KEY. | ||
| 94 | |||
| 95 | MAP can be a list, hash-table or array." | ||
| 96 | (declare (debug t)) | ||
| 97 | `(progn | ||
| 98 | (map--dispatch (m ,map m) | ||
| 99 | :list (setq ,map (map--delete-alist m ,key)) | ||
| 100 | :hash-table (remhash ,key m) | ||
| 101 | :array (map--delete-array m ,key)))) | ||
| 102 | |||
| 103 | (defun map-nested-elt (map keys &optional default) | ||
| 104 | "Traverse MAP using KEYS and return the looked up value or DEFAULT if nil. | ||
| 105 | |||
| 106 | Map can be a nested map composed of alists, hash-tables and arrays." | ||
| 107 | (or (seq-reduce (lambda (acc key) | ||
| 108 | (when (map-p acc) | ||
| 109 | (map-elt acc key))) | ||
| 110 | keys | ||
| 111 | map) | ||
| 112 | default)) | ||
| 113 | |||
| 114 | (defun map-keys (map) | ||
| 115 | "Return the list of keys in MAP. | ||
| 116 | |||
| 117 | MAP can be a list, hash-table or array." | ||
| 118 | (map-apply (lambda (key _) key) map)) | ||
| 119 | |||
| 120 | (defun map-values (map) | ||
| 121 | "Return the list of values in MAP. | ||
| 122 | |||
| 123 | MAP can be a list, hash-table or array." | ||
| 124 | (map-apply (lambda (_ value) value) map)) | ||
| 125 | |||
| 126 | (defun map-pairs (map) | ||
| 127 | "Return the elements of MAP as key/value association lists. | ||
| 128 | |||
| 129 | MAP can be a list, hash-table or array." | ||
| 130 | (map-apply #'cons map)) | ||
| 131 | |||
| 132 | (defun map-length (map) | ||
| 133 | "Return the length of MAP. | ||
| 134 | |||
| 135 | MAP can be a list, hash-table or array." | ||
| 136 | (length (map-keys map))) | ||
| 137 | |||
| 138 | (defun map-copy (map) | ||
| 139 | "Return a copy of MAP. | ||
| 140 | |||
| 141 | MAP can be a list, hash-table or array." | ||
| 142 | (map--dispatch map | ||
| 143 | :list (seq-copy map) | ||
| 144 | :hash-table (copy-hash-table map) | ||
| 145 | :array (seq-copy map))) | ||
| 146 | |||
| 147 | (defun map-apply (function map) | ||
| 148 | "Apply FUNCTION to each element of MAP and return the result as a list. | ||
| 149 | FUNCTION is called with two arguments, the key and the value. | ||
| 150 | |||
| 151 | MAP can be a list, hash-table or array." | ||
| 152 | (funcall (map--dispatch map | ||
| 153 | :list #'map--apply-alist | ||
| 154 | :hash-table #'map--apply-hash-table | ||
| 155 | :array #'map--apply-array) | ||
| 156 | function | ||
| 157 | map)) | ||
| 158 | |||
| 159 | (defun map-keys-apply (function map) | ||
| 160 | "Return the result of applying FUNCTION to each key of MAP. | ||
| 161 | |||
| 162 | MAP can be a list, hash-table or array." | ||
| 163 | (map-apply (lambda (key _) | ||
| 164 | (funcall function key)) | ||
| 165 | map)) | ||
| 166 | |||
| 167 | (defun map-values-apply (function map) | ||
| 168 | "Return the result of applying FUNCTION to each value of MAP. | ||
| 169 | |||
| 170 | MAP can be a list, hash-table or array." | ||
| 171 | (map-apply (lambda (_ val) | ||
| 172 | (funcall function val)) | ||
| 173 | map)) | ||
| 174 | |||
| 175 | (defun map-filter (pred map) | ||
| 176 | "Return an alist of the key/val pairs for which (PRED key val) is non-nil in MAP. | ||
| 177 | |||
| 178 | MAP can be a list, hash-table or array." | ||
| 179 | (delq nil (map-apply (lambda (key val) | ||
| 180 | (if (funcall pred key val) | ||
| 181 | (cons key val) | ||
| 182 | nil)) | ||
| 183 | map))) | ||
| 184 | |||
| 185 | (defun map-remove (pred map) | ||
| 186 | "Return an alist of the key/val pairs for which (PRED key val) is nil in MAP. | ||
| 187 | |||
| 188 | MAP can be a list, hash-table or array." | ||
| 189 | (map-filter (lambda (key val) (not (funcall pred key val))) | ||
| 190 | map)) | ||
| 191 | |||
| 192 | (defun map-p (map) | ||
| 193 | "Return non-nil if MAP is a map (list, hash-table or array)." | ||
| 194 | (or (listp map) | ||
| 195 | (hash-table-p map) | ||
| 196 | (arrayp map))) | ||
| 197 | |||
| 198 | (defun map-empty-p (map) | ||
| 199 | "Return non-nil is MAP is empty. | ||
| 200 | |||
| 201 | MAP can be a list, hash-table or array." | ||
| 202 | (map--dispatch map | ||
| 203 | :list (null map) | ||
| 204 | :array (seq-empty-p map) | ||
| 205 | :hash-table (zerop (hash-table-count map)))) | ||
| 206 | |||
| 207 | (defun map-contains-key-p (map key &optional testfn) | ||
| 208 | "Return non-nil if MAP contain the key KEY, nil otherwise. | ||
| 209 | Equality is defined by TESTFN if non-nil or by `equal' if nil. | ||
| 210 | |||
| 211 | MAP can be a list, hash-table or array." | ||
| 212 | (seq-contains-p (map-keys map) key testfn)) | ||
| 213 | |||
| 214 | (defun map-some-p (pred map) | ||
| 215 | "Return a key/value pair for which (PRED key val) is non-nil in MAP. | ||
| 216 | |||
| 217 | MAP can be a list, hash-table or array." | ||
| 218 | (catch 'map--break | ||
| 219 | (map-apply (lambda (key value) | ||
| 220 | (when (funcall pred key value) | ||
| 221 | (throw 'map--break (cons key value)))) | ||
| 222 | map) | ||
| 223 | nil)) | ||
| 224 | |||
| 225 | (defun map-every-p (pred map) | ||
| 226 | "Return non-nil if (PRED key val) is non-nil for all elements of the map MAP. | ||
| 227 | |||
| 228 | MAP can be a list, hash-table or array." | ||
| 229 | (catch 'map--break | ||
| 230 | (map-apply (lambda (key value) | ||
| 231 | (or (funcall pred key value) | ||
| 232 | (throw 'map--break nil))) | ||
| 233 | map) | ||
| 234 | t)) | ||
| 235 | |||
| 236 | (defun map-merge (type &rest maps) | ||
| 237 | "Merge into a map of type TYPE all the key/value pairs in the maps MAPS. | ||
| 238 | |||
| 239 | MAP can be a list, hash-table or array." | ||
| 240 | (let (result) | ||
| 241 | (while maps | ||
| 242 | (map-apply (lambda (key value) | ||
| 243 | (map-put result key value)) | ||
| 244 | (pop maps))) | ||
| 245 | (map-into result type))) | ||
| 246 | |||
| 247 | (defun map-into (map type) | ||
| 248 | "Convert the map MAP into a map of type TYPE. | ||
| 249 | |||
| 250 | TYPE can be one of the following symbols: list or hash-table. | ||
| 251 | MAP can be a list, hash-table or array." | ||
| 252 | (pcase type | ||
| 253 | (`list (map-pairs map)) | ||
| 254 | (`hash-table (map--into-hash-table map)) | ||
| 255 | (t (error "Not a map type name: %S" type)))) | ||
| 256 | |||
| 257 | (defmacro map--dispatch (spec &rest args) | ||
| 258 | "Evaluate one of the provided forms depending on the type of MAP. | ||
| 259 | |||
| 260 | SPEC can be a map or a list of the form (VAR MAP [RESULT]). | ||
| 261 | ARGS should have the form [TYPE FORM]... | ||
| 262 | |||
| 263 | The following keyword types are meaningful: `:list', | ||
| 264 | `:hash-table' and `array'. | ||
| 265 | |||
| 266 | An error is thrown if MAP is neither a list, hash-table nor array. | ||
| 267 | |||
| 268 | Return RESULT if non-nil or the result of evaluation of the | ||
| 269 | form. | ||
| 270 | |||
| 271 | \(fn (VAR MAP [RESULT]) &rest ARGS)" | ||
| 272 | (declare (debug t) (indent 1)) | ||
| 273 | (unless (listp spec) | ||
| 274 | (setq spec `(,spec ,spec))) | ||
| 275 | (let ((map-var (car spec)) | ||
| 276 | (result-var (make-symbol "result"))) | ||
| 277 | `(let ((,map-var ,(cadr spec)) | ||
| 278 | ,result-var) | ||
| 279 | (setq ,result-var | ||
| 280 | (cond ((listp ,map-var) ,(plist-get args :list)) | ||
| 281 | ((hash-table-p ,map-var) ,(plist-get args :hash-table)) | ||
| 282 | ((arrayp ,map-var) ,(plist-get args :array)) | ||
| 283 | (t (error "Unsupported map: %s" ,map-var)))) | ||
| 284 | ,@(when (cddr spec) | ||
| 285 | `((setq ,result-var ,@(cddr spec)))) | ||
| 286 | ,result-var))) | ||
| 287 | |||
| 288 | (defun map--apply-alist (function map) | ||
| 289 | "Private function used to apply FUNCTION over MAP, MAP being an alist." | ||
| 290 | (seq-map (lambda (pair) | ||
| 291 | (funcall function | ||
| 292 | (car pair) | ||
| 293 | (cdr pair))) | ||
| 294 | map)) | ||
| 295 | |||
| 296 | (defun map--apply-hash-table (function map) | ||
| 297 | "Private function used to apply FUNCTION over MAP, MAP being a hash-table." | ||
| 298 | (let (result) | ||
| 299 | (maphash (lambda (key value) | ||
| 300 | (push (funcall function key value) result)) | ||
| 301 | map) | ||
| 302 | (nreverse result))) | ||
| 303 | |||
| 304 | (defun map--apply-array (function map) | ||
| 305 | "Private function used to apply FUNCTION over MAP, MAP being an array." | ||
| 306 | (let ((index 0)) | ||
| 307 | (seq-map (lambda (elt) | ||
| 308 | (prog1 | ||
| 309 | (funcall function index elt) | ||
| 310 | (setq index (1+ index)))) | ||
| 311 | map))) | ||
| 312 | |||
| 313 | (defun map--elt-list (map key &optional default) | ||
| 314 | "Lookup, in the list MAP, the value associated with KEY and return it. | ||
| 315 | If KEY is not found, return DEFAULT which defaults to nil." | ||
| 316 | (let ((pair (assoc key map))) | ||
| 317 | (if pair | ||
| 318 | (cdr pair) | ||
| 319 | default))) | ||
| 320 | |||
| 321 | (defun map--elt-array (map key &optional default) | ||
| 322 | "Return the element of the array MAP at the index KEY. | ||
| 323 | If KEY is not found, return DEFAULT which defaults to nil." | ||
| 324 | (let ((len (seq-length map))) | ||
| 325 | (or (and (>= key 0) | ||
| 326 | (<= key len) | ||
| 327 | (seq-elt map key)) | ||
| 328 | default))) | ||
| 329 | |||
| 330 | (defun map--delete-alist (map key) | ||
| 331 | "Return MAP with KEY removed." | ||
| 332 | (seq-remove (lambda (pair) | ||
| 333 | (equal key (car pair))) | ||
| 334 | map)) | ||
| 335 | |||
| 336 | (defun map--delete-array (map key) | ||
| 337 | "Set nil in the array MAP at the index KEY if present and return MAP." | ||
| 338 | (let ((len (seq-length map))) | ||
| 339 | (and (>= key 0) | ||
| 340 | (<= key len) | ||
| 341 | (aset m key nil))) | ||
| 342 | map) | ||
| 343 | |||
| 344 | (defun map--into-hash-table (map) | ||
| 345 | "Convert MAP into a hash-table." | ||
| 346 | (let ((ht (make-hash-table :size (map-length map) | ||
| 347 | :test 'equal))) | ||
| 348 | (map-apply (lambda (key value) | ||
| 349 | (map-put ht key value)) | ||
| 350 | map) | ||
| 351 | ht)) | ||
| 352 | |||
| 353 | (defun map--make-pcase-bindings (args) | ||
| 354 | "Return a list of pcase bindings from ARGS to the elements of a map." | ||
| 355 | (seq-map (lambda (elt) | ||
| 356 | (if (consp elt) | ||
| 357 | `(app (pcase--flip map-elt ',(car elt)) ,(cdr elt)) | ||
| 358 | `(app (pcase--flip map-elt ',elt) ,elt))) | ||
| 359 | args)) | ||
| 360 | |||
| 361 | (defun map--make-pcase-patterns (args) | ||
| 362 | "Return a list of `(map ...)' pcase patterns built from ARGS." | ||
| 363 | (cons 'map | ||
| 364 | (seq-map (lambda (elt) | ||
| 365 | (if (and (consp elt) (eq 'map (car elt))) | ||
| 366 | (map--make-pcase-patterns elt) | ||
| 367 | elt)) | ||
| 368 | args))) | ||
| 369 | |||
| 370 | (provide 'map) | ||
| 371 | ;;; map.el ends here | ||
diff --git a/test/automated/map-tests.el b/test/automated/map-tests.el new file mode 100644 index 00000000000..2f7d4eb0572 --- /dev/null +++ b/test/automated/map-tests.el | |||
| @@ -0,0 +1,333 @@ | |||
| 1 | ;;; map-tests.el --- Tests for map.el | ||
| 2 | |||
| 3 | ;; Copyright (C) 2015 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Author: Nicolas Petton <nicolas@petton.fr> | ||
| 6 | ;; Maintainer: emacs-devel@gnu.org | ||
| 7 | |||
| 8 | ;; This file is part of GNU Emacs. | ||
| 9 | |||
| 10 | ;; GNU Emacs is free software: you can redistribute it and/or modify | ||
| 11 | ;; it under the terms of the GNU General Public License as published by | ||
| 12 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 13 | ;; (at your option) any later version. | ||
| 14 | |||
| 15 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 18 | ;; GNU General Public License for more details. | ||
| 19 | |||
| 20 | ;; You should have received a copy of the GNU General Public License | ||
| 21 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | ||
| 22 | |||
| 23 | ;;; Commentary: | ||
| 24 | |||
| 25 | ;; Tests for map.el | ||
| 26 | |||
| 27 | ;;; Code: | ||
| 28 | |||
| 29 | (require 'ert) | ||
| 30 | (require 'map) | ||
| 31 | |||
| 32 | (defmacro with-maps-do (var &rest body) | ||
| 33 | "Successively bind VAR to an alist, vector and hash-table. | ||
| 34 | Each map is built from the following alist data: | ||
| 35 | '((0 . 3) (1 . 4) (2 . 5)). | ||
| 36 | Evaluate BODY for each created map. | ||
| 37 | |||
| 38 | \(fn (var map) body)" | ||
| 39 | (declare (indent 1) (debug t)) | ||
| 40 | (let ((alist (make-symbol "alist")) | ||
| 41 | (vec (make-symbol "vec")) | ||
| 42 | (ht (make-symbol "ht"))) | ||
| 43 | `(let ((,alist '((0 . 3) | ||
| 44 | (1 . 4) | ||
| 45 | (2 . 5))) | ||
| 46 | (,vec (make-vector 3 nil)) | ||
| 47 | (,ht (make-hash-table))) | ||
| 48 | (aset ,vec 0 '3) | ||
| 49 | (aset ,vec 1 '4) | ||
| 50 | (aset ,vec 2 '5) | ||
| 51 | (puthash '0 3 ,ht) | ||
| 52 | (puthash '1 4 ,ht) | ||
| 53 | (puthash '2 5 ,ht) | ||
| 54 | (dolist (,var (list ,alist ,vec ,ht)) | ||
| 55 | ,@body)))) | ||
| 56 | |||
| 57 | (ert-deftest test-map-elt () | ||
| 58 | (with-maps-do map | ||
| 59 | (assert (= 3 (map-elt map 0))) | ||
| 60 | (assert (= 4 (map-elt map 1))) | ||
| 61 | (assert (= 5 (map-elt map 2))) | ||
| 62 | (assert (null (map-elt map -1))) | ||
| 63 | (assert (null (map-elt map 4))))) | ||
| 64 | |||
| 65 | (ert-deftest test-map-elt-default () | ||
| 66 | (with-maps-do map | ||
| 67 | (assert (= 5 (map-elt map 7 5))))) | ||
| 68 | |||
| 69 | (ert-deftest test-map-elt-with-nil-value () | ||
| 70 | (assert (null (map-elt '((a . 1) | ||
| 71 | (b)) | ||
| 72 | 'b | ||
| 73 | '2)))) | ||
| 74 | |||
| 75 | (ert-deftest test-map-put () | ||
| 76 | (with-maps-do map | ||
| 77 | (map-put map 2 'hello) | ||
| 78 | (assert (eq (map-elt map 2) 'hello))) | ||
| 79 | (let ((ht (make-hash-table))) | ||
| 80 | (map-put ht 2 'a) | ||
| 81 | (assert (eq (map-elt ht 2) | ||
| 82 | 'a))) | ||
| 83 | (let ((alist '((0 . a) (1 . b) (2 . c)))) | ||
| 84 | (map-put alist 2 'a) | ||
| 85 | (assert (eq (map-elt alist 2) | ||
| 86 | 'a))) | ||
| 87 | (let ((vec [3 4 5])) | ||
| 88 | (should-error (map-put vec 3 6)))) | ||
| 89 | |||
| 90 | (ert-deftest test-map-put-literal () | ||
| 91 | (assert (= (map-elt (map-put [1 2 3] 1 4) 1) | ||
| 92 | 4)) | ||
| 93 | (assert (= (map-elt (map-put (make-hash-table) 'a 2) 'a) | ||
| 94 | 2)) | ||
| 95 | (should-error (map-put '((a . 1)) 'b 2)) | ||
| 96 | (should-error (map-put '() 'a 1))) | ||
| 97 | |||
| 98 | (ert-deftest test-map-put-return-value () | ||
| 99 | (let ((ht (make-hash-table))) | ||
| 100 | (assert (eq (map-put ht 'a 'hello) ht)))) | ||
| 101 | |||
| 102 | (ert-deftest test-map-delete () | ||
| 103 | (with-maps-do map | ||
| 104 | (map-delete map 1) | ||
| 105 | (assert (null (map-elt map 1)))) | ||
| 106 | (with-maps-do map | ||
| 107 | (map-delete map -2) | ||
| 108 | (assert (null (map-elt map -2))))) | ||
| 109 | |||
| 110 | (ert-deftest test-map-delete-return-value () | ||
| 111 | (let ((ht (make-hash-table))) | ||
| 112 | (assert (eq (map-delete ht 'a) ht)))) | ||
| 113 | |||
| 114 | (ert-deftest test-map-nested-elt () | ||
| 115 | (let ((vec [a b [c d [e f]]])) | ||
| 116 | (assert (eq (map-nested-elt vec '(2 2 0)) 'e))) | ||
| 117 | (let ((alist '((a . 1) | ||
| 118 | (b . ((c . 2) | ||
| 119 | (d . 3) | ||
| 120 | (e . ((f . 4) | ||
| 121 | (g . 5)))))))) | ||
| 122 | (assert (eq (map-nested-elt alist '(b e f)) | ||
| 123 | 4))) | ||
| 124 | (let ((ht (make-hash-table))) | ||
| 125 | (map-put ht 'a 1) | ||
| 126 | (map-put ht 'b (make-hash-table)) | ||
| 127 | (map-put (map-elt ht 'b) 'c 2) | ||
| 128 | (assert (eq (map-nested-elt ht '(b c)) | ||
| 129 | 2)))) | ||
| 130 | |||
| 131 | (ert-deftest test-map-nested-elt-default () | ||
| 132 | (let ((vec [a b [c d]])) | ||
| 133 | (assert (null (map-nested-elt vec '(2 3)))) | ||
| 134 | (assert (null (map-nested-elt vec '(2 1 1)))) | ||
| 135 | (assert (= 4 (map-nested-elt vec '(2 1 1) 4))))) | ||
| 136 | |||
| 137 | (ert-deftest test-map-p () | ||
| 138 | (assert (map-p nil)) | ||
| 139 | (assert (map-p '((a . b) (c . d)))) | ||
| 140 | (assert (map-p '(a b c d))) | ||
| 141 | (assert (map-p [])) | ||
| 142 | (assert (map-p [1 2 3])) | ||
| 143 | (assert (map-p (make-hash-table))) | ||
| 144 | (assert (map-p "hello")) | ||
| 145 | (assert (not (map-p 1))) | ||
| 146 | (assert (not (map-p 'hello)))) | ||
| 147 | |||
| 148 | (ert-deftest test-map-keys () | ||
| 149 | (with-maps-do map | ||
| 150 | (assert (equal (map-keys map) '(0 1 2)))) | ||
| 151 | (assert (null (map-keys nil))) | ||
| 152 | (assert (null (map-keys [])))) | ||
| 153 | |||
| 154 | (ert-deftest test-map-values () | ||
| 155 | (with-maps-do map | ||
| 156 | (assert (equal (map-values map) '(3 4 5))))) | ||
| 157 | |||
| 158 | (ert-deftest test-map-pairs () | ||
| 159 | (with-maps-do map | ||
| 160 | (assert (equal (map-pairs map) '((0 . 3) | ||
| 161 | (1 . 4) | ||
| 162 | (2 . 5)))))) | ||
| 163 | |||
| 164 | (ert-deftest test-map-length () | ||
| 165 | (let ((ht (make-hash-table))) | ||
| 166 | (puthash 'a 1 ht) | ||
| 167 | (puthash 'b 2 ht) | ||
| 168 | (puthash 'c 3 ht) | ||
| 169 | (puthash 'd 4 ht) | ||
| 170 | (assert (= 0 (map-length nil))) | ||
| 171 | (assert (= 0 (map-length []))) | ||
| 172 | (assert (= 0 (map-length (make-hash-table)))) | ||
| 173 | (assert (= 5 (map-length [0 1 2 3 4]))) | ||
| 174 | (assert (= 2 (map-length '((a . 1) (b . 2))))) | ||
| 175 | (assert (= 4 (map-length ht))))) | ||
| 176 | |||
| 177 | (ert-deftest test-map-copy () | ||
| 178 | (with-maps-do map | ||
| 179 | (let ((copy (map-copy map))) | ||
| 180 | (assert (equal (map-keys map) (map-keys copy))) | ||
| 181 | (assert (equal (map-values map) (map-values copy))) | ||
| 182 | (assert (not (eq map copy)))))) | ||
| 183 | |||
| 184 | (ert-deftest test-map-apply () | ||
| 185 | (with-maps-do map | ||
| 186 | (assert (equal (map-apply (lambda (k v) (cons (int-to-string k) v)) | ||
| 187 | map) | ||
| 188 | '(("0" . 3) ("1" . 4) ("2" . 5))))) | ||
| 189 | (let ((vec [a b c])) | ||
| 190 | (assert (equal (map-apply (lambda (k v) (cons (1+ k) v)) | ||
| 191 | vec) | ||
| 192 | '((1 . a) | ||
| 193 | (2 . b) | ||
| 194 | (3 . c)))))) | ||
| 195 | |||
| 196 | (ert-deftest test-map-keys-apply () | ||
| 197 | (with-maps-do map | ||
| 198 | (assert (equal (map-keys-apply (lambda (k) (int-to-string k)) | ||
| 199 | map) | ||
| 200 | '("0" "1" "2")))) | ||
| 201 | (let ((vec [a b c])) | ||
| 202 | (assert (equal (map-keys-apply (lambda (k) (1+ k)) | ||
| 203 | vec) | ||
| 204 | '(1 2 3))))) | ||
| 205 | |||
| 206 | (ert-deftest test-map-values-apply () | ||
| 207 | (with-maps-do map | ||
| 208 | (assert (equal (map-values-apply (lambda (v) (1+ v)) | ||
| 209 | map) | ||
| 210 | '(4 5 6)))) | ||
| 211 | (let ((vec [a b c])) | ||
| 212 | (assert (equal (map-values-apply (lambda (v) (symbol-name v)) | ||
| 213 | vec) | ||
| 214 | '("a" "b" "c"))))) | ||
| 215 | |||
| 216 | (ert-deftest test-map-filter () | ||
| 217 | (with-maps-do map | ||
| 218 | (assert (equal (map-keys (map-filter (lambda (k v) | ||
| 219 | (<= 4 v)) | ||
| 220 | map)) | ||
| 221 | '(1 2))) | ||
| 222 | (assert (null (map-filter (lambda (k v) | ||
| 223 | (eq 'd k)) | ||
| 224 | map)))) | ||
| 225 | (assert (null (map-filter (lambda (k v) | ||
| 226 | (eq 3 v)) | ||
| 227 | [1 2 4 5]))) | ||
| 228 | (assert (equal (map-filter (lambda (k v) | ||
| 229 | (eq 3 k)) | ||
| 230 | [1 2 4 5]) | ||
| 231 | '((3 . 5))))) | ||
| 232 | |||
| 233 | (ert-deftest test-map-remove () | ||
| 234 | (with-maps-do map | ||
| 235 | (assert (equal (map-keys (map-remove (lambda (k v) | ||
| 236 | (>= v 4)) | ||
| 237 | map)) | ||
| 238 | '(0))) | ||
| 239 | (assert (equal (map-keys (map-remove (lambda (k v) | ||
| 240 | (eq 'd k)) | ||
| 241 | map)) | ||
| 242 | (map-keys map)))) | ||
| 243 | (assert (equal (map-remove (lambda (k v) | ||
| 244 | (eq 3 v)) | ||
| 245 | [1 2 4 5]) | ||
| 246 | '((0 . 1) | ||
| 247 | (1 . 2) | ||
| 248 | (2 . 4) | ||
| 249 | (3 . 5)))) | ||
| 250 | (assert (null (map-remove (lambda (k v) | ||
| 251 | (>= k 0)) | ||
| 252 | [1 2 4 5])))) | ||
| 253 | |||
| 254 | (ert-deftest test-map-empty-p () | ||
| 255 | (assert (map-empty-p nil)) | ||
| 256 | (assert (not (map-empty-p '((a . b) (c . d))))) | ||
| 257 | (assert (map-empty-p [])) | ||
| 258 | (assert (not (map-empty-p [1 2 3]))) | ||
| 259 | (assert (map-empty-p (make-hash-table))) | ||
| 260 | (assert (not (map-empty-p "hello"))) | ||
| 261 | (assert (map-empty-p ""))) | ||
| 262 | |||
| 263 | (ert-deftest test-map-contains-key-p () | ||
| 264 | (assert (map-contains-key-p '((a . 1) (b . 2)) 'a)) | ||
| 265 | (assert (not (map-contains-key-p '((a . 1) (b . 2)) 'c))) | ||
| 266 | (assert (map-contains-key-p '(("a" . 1)) "a")) | ||
| 267 | (assert (not (map-contains-key-p '(("a" . 1)) "a" #'eq))) | ||
| 268 | (assert (map-contains-key-p [a b c] 2)) | ||
| 269 | (assert (not (map-contains-key-p [a b c] 3)))) | ||
| 270 | |||
| 271 | (ert-deftest test-map-some-p () | ||
| 272 | (with-maps-do map | ||
| 273 | (assert (equal (map-some-p (lambda (k v) | ||
| 274 | (eq 1 k)) | ||
| 275 | map) | ||
| 276 | (cons 1 4))) | ||
| 277 | (assert (not (map-some-p (lambda (k v) | ||
| 278 | (eq 'd k)) | ||
| 279 | map)))) | ||
| 280 | (let ((vec [a b c])) | ||
| 281 | (assert (equal (map-some-p (lambda (k v) | ||
| 282 | (> k 1)) | ||
| 283 | vec) | ||
| 284 | (cons 2 'c))) | ||
| 285 | (assert (not (map-some-p (lambda (k v) | ||
| 286 | (> k 3)) | ||
| 287 | vec))))) | ||
| 288 | |||
| 289 | (ert-deftest test-map-every-p () | ||
| 290 | (with-maps-do map | ||
| 291 | (assert (map-every-p (lambda (k v) | ||
| 292 | k) | ||
| 293 | map)) | ||
| 294 | (assert (not (map-every-p (lambda (k v) | ||
| 295 | nil) | ||
| 296 | map)))) | ||
| 297 | (let ((vec [a b c])) | ||
| 298 | (assert (map-every-p (lambda (k v) | ||
| 299 | (>= k 0)) | ||
| 300 | vec)) | ||
| 301 | (assert (not (map-every-p (lambda (k v) | ||
| 302 | (> k 3)) | ||
| 303 | vec))))) | ||
| 304 | |||
| 305 | (ert-deftest test-map-into () | ||
| 306 | (let* ((alist '((a . 1) (b . 2))) | ||
| 307 | (ht (map-into alist 'hash-table))) | ||
| 308 | (assert (hash-table-p ht)) | ||
| 309 | (assert (equal (map-into (map-into alist 'hash-table) 'list) | ||
| 310 | alist)) | ||
| 311 | (assert (listp (map-into ht 'list))) | ||
| 312 | (assert (equal (map-keys (map-into (map-into ht 'list) 'hash-table)) | ||
| 313 | (map-keys ht))) | ||
| 314 | (assert (equal (map-values (map-into (map-into ht 'list) 'hash-table)) | ||
| 315 | (map-values ht))) | ||
| 316 | (assert (null (map-into nil 'list))) | ||
| 317 | (assert (map-empty-p (map-into nil 'hash-table))) | ||
| 318 | (should-error (map-into [1 2 3] 'string)))) | ||
| 319 | |||
| 320 | (ert-deftest test-map-let () | ||
| 321 | (map-let (foo bar baz) '((foo . 1) (bar . 2)) | ||
| 322 | (assert (= foo 1)) | ||
| 323 | (assert (= bar 2)) | ||
| 324 | (assert (null baz))) | ||
| 325 | (map-let ((foo . a) | ||
| 326 | (bar . b) | ||
| 327 | (baz . c)) '((foo . 1) (bar . 2)) | ||
| 328 | (assert (= a 1)) | ||
| 329 | (assert (= b 2)) | ||
| 330 | (assert (null c)))) | ||
| 331 | |||
| 332 | (provide 'map-tests) | ||
| 333 | ;;; map-tests.el ends here | ||